	.TITLE	GRSUBS - SUPPORT FOR GRPACK
	.SBTTL	COPYRIGHT
;
; COPYRIGHT (C)   1976
; DIGITAL EQUIPMENT CORPORATION,  MAYNARD,   MASS.
;
; THIS SOFTWARE  IS FURNISHED  UNDER A LICENSE  FOR USE ONLY ON A
; SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
; OF THE ABOVE  COPYRIGHT  NOTICE.  THIS  SOFTWARE, OR  ANY OTHER
; COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
; TO ANY OTHER PERSON  EXCEPT  FOR USE ON SUCH SYSTEM  AND TO ONE
; WHO AGREES  TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP  OF
; THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
;
; THE  INFORMATION  IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
; NOTICE  AND  SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
; EQUIPMENT CORPORATION.
;
; DEC  ASSUMES NO  RESPONSIBILITY  FOR  THE  USE  OR  RELIABILITY
; OF  ITS  SOFTWARE ON  EQUIPMENT WHICH  IS  NOT SUPPLIED BY DEC.
;
	.SBTTL	DEFINITIONS
	.NLIST	CND
;
;	GLOBALS
;
	.GLOBL	UNMAKV,UNMKSV,MPNT,CSTORE,NWDS,NWDS0,ARG,IADD
	.GLOBL	MVECT,IADRS,IOPTV,NOPTS,IAND,ITOA,OTOA,VERSON
	.GLOBL	TTW,KBS,WAIT
	.IF EQ	HO$AT&<1-$ATEL>
	.GLOBL	KBG
	.ENDC			;HO$AT&<1-$ATEL>
	.IF NE	LK$11
	.GLOBL	BTL,LTB
	.ENDC			;LK$11
	.IF NE	$ATEL!<1-HO$AT>
	.GLOBL	TRAP0,LINK,UNLINK,STOP,CONT,EREXIT
	.IF NE	LK$11
	.GLOBL	PBREAD,PBWRIT
	.ENDC			;LK$11
	.IF EQ	$ATEL
	.GLOBL	GRWAIT
	.ENDC			;-$ATEL
	.ENDC			;$ATEL!<1-HO$AT>
	.IF NE	HO$AT
	.IF NE	$ATEL
	.GLOBL	TOHOST,FRHOST,DHOST,INTEGR
	.IF NE	LOC$AV
	.GLOBL	DX,CSI
	.ENDC			;LOC$AV
	.IF EQ	INT$
	.GLOBL	REEL
	.ENDC			;INT$
	.GLOBL	$OTI,$$SAT,$$SATR
	.GLOBL	BAH$,EXIT$,FOO$,PSE$,STP$,$EXIT
	.IFF			;$ATEL
	.GLOBL	TOSAT,TOOSAT,FRSAT
	.ENDC			;$ATEL
	.ENDC			;HO$AT
	.IF NE	RT$11
	.GLOBL	$AOTS
	.IFF			;RT$11
	.GLOBL	$OTSVA,$SEQC,$NAMC
	.ENDC			;RT$11
;
;	MACRO LIBRARY CALLS
;
	.IF NE	RT$11
	.MCALL	..V2..,.EXIT,.TTYOU,.TTYIN,.INTENT,.PROTECT,.DEVICE
	.MCALL	.TTINR
	..V2..
	.IFF			;RT$11
	.MCALL	QIO$S,CLEF$S,EXIT$S,ASTX$S,WTSE$S,DECL$S,SETF$S
	.MCALL	WTLO$S,MRKT$S,CMKT$S
	.ENDC			;RT$11
;
;	MACRO DEFINITIONS
;
	.MACRO	CALL SUBR
	JSR	PC,SUBR
	.ENDM
	.MACRO	ERROR N
	TRAP+N
	.ENDM
	.MACRO	SPL N,?A
	MOV	#N*40,-(SP)
	MOV	#A,-(SP)
	RTI
A:
	.ENDM
	.IF EQ	F4PLU$
;
;	F4 DEFINITIONS
;
	.IF NE	RT$11
	ENMLNK=14.		;FOTS STACK FRAME OF LOWEST CALLEE
	.IFF			;RT$11
	ENMLNK=2		;FOTS STACK FRAME OF LOWEST CALLEE
	$AOTSM=52		;F4 OTS DIRTY POINTER FOR M
	.IF NE	R$X11M
	$AOTS=$AOTSM		;ONLY ONE $AOTS FOR M
	.IFF			;R$X11M
	$AOTS=4			;F4 OTS POINTER FOR D
	.ENDC			;R$X11M
	.ENDC			;RT$11
	CAL$CT=14.		;FOTS DISP FROM STACK FRAME TO ARG COUNT
	.ENDC			;-F4PLU$
	.IF NE	RT$11
;
;	RT11 DEFINITIONS
;
	RMON=54			;ADDRESS OF POINTER TO RESIDENT
	DISP=300		;DISP FROM RMON TO CONFIG WORD
	GOTVT=4			;VT11/VS60 PRESENT BIT
	VTLINK=400		;VT11/VS60 LINKED BIT
	SCLINK=10		;DISPACEMENT FROM SCROLLER TO LINK
	.ENDC			;RT$11
	.IF NE	R$X11M&<1-HO$AT>
;
;	RSX11M EFN AND LUN DEFINITIONS
;
	LUNV=1			;LUN FOR GR0: (ASG IN TKB FILE)
	LPEF=11.		;LIGHT PEN TRIGGER EVENT FLAG
	LUNS=2			;LUN FOR SAV/RSTR (FORTRAN ONLY)
	.IF NE	LK$11
	LUNPB=3			;LUN FOR LK11 DRIVER
	PBEF=12.		;LK11 EVENT FLAG
	.ENDC			;LK$11
	.ENDC			;R$X11M&<1-HO$AT>
	.IF NE	R$X11M!R$X11D!IA$&<1-$ATEL>
;
;	RSX11M/D DEFINITIONS
;
	LUNTT=5			;LUN FOR TI: (DEFAULT)
	TTEF=10.		;TT EVENT FLAG NUMBER
	TTUF=9.			;TT UTILITY EFN
	GTT=0			;GROUP NUMBER FOR TTEF AND TTUF
	TTMSK=1400		;MASK FOR TTUF AND TTEF
	TTWAIT=30.		;WAIT TIME FOR KBC (TICKS)
	.ENDC			;R$X11M!R$X11D!IA$&<1-$ATEL>
	.IF NE	HO$AT
;
;	HOST/SATELLITE COMMUNICATIONS DEFINITIONS
;
	TIMF=17.		;EF FOR TIMEOUTS IN HOST/SAT
	MSGF=18.		;EF FOR MESSAGE IN H/S
	KILLF=19.		;EF FOR KILL IO REQUESTS
	TFMF=3			;MASK FOR TIMF .OR. MSG1F
	GTFMF=1			;GROUP NUMBER OF TIMF, MSG1F, MSG2F
	TRIES=10.		;RETRY COUNT
	TWAIT=10.		;RETRY WAIT TIME (SECONDS)
	SYNCT=2			;SYNC COUNT IN MESSAGE HEADER
	HSIZE=SYNCT+4		;TOTAL HEADER BYTE COUNT (INCL HDR CRC)
	DLECRC=66000		;CRC FOR DLE ALONE
	MAXR=80.		;MAXIMUM TT DRIVER RECORD SIZE
	.IF NE	R$X11D!IA$
	MAXMSG=<MAXR+3>/4*3-HSIZE-3 ;MAXIMUM MESSAGE SIZE
	.IFF			;R$X11D!IA$
	MAXMSG=MAXR-HSIZE-3	;MAXIMUM MESSAGE SIZE
	.ENDC			;R$X11D!IA$
	DLE=220			;DLE CHAR
	SYN=377			;SYN CHAR
	POLY=120001		;CRC POLYNOMIAL
	ASKCOD=10		;ASK CODE
	ACKCOD=20		;ACKNOWLEDGE CODE
	DATCOD=30		;DATA CODE
	DLYCOD=40		;DELAY CODE
	NOCOD=50		;FREE CODE
	RPTCOD=60		;REPEAT CODE (ASK FAILED)
	MSGNF=7			;MESSAGE NUMBER FIELD MASK
	CODEF=370		;CODE FIELD MASK
	.ENDC			;HO$AT
;
;	TABLE OF HUS VALUES  (LOOP COUNT FOR 100 USEC DELAY)
;
;	CPU		COUNT
;	---		-----
;	11/40		38.
;	11/34		19.
;	11/10		19.
;
	HUS=19.
	.IF NE	$ATEL
;
;	TABLE OF CWAIT VALUES (IN HUNDREDS OF MICRO SECONDS)
;
;	SYSTEM		HOST CPU	BAUD RATE	DELAY TIME
;	------		--------	---------	----------
;	RSX11D/V6B	11/40		9600		20.
;	RSX11M/BL12	11/40		9600		13.
;	<ANY>		<ANY>		2400		0.
;
	CWAIT=0			;CHARACTER DELAY TIME
;
;	SATELLITE HARDWARE DEFINITIONS
;
	DLICSR=175610		;DL11 INPUT CSR (175610)
	DLIBUF=DLICSR+2		;DL11 INPUT BUFFER
	DLOCSR=DLIBUF+2		;DL11 OUTPUT CSR
	DLOBUF=DLOCSR+2		;DL11 OUTPUT BUFFER
	DLVEC=300		;DL11 VECTOR (300)
	KBCSR=177560		;KEYBOARD CSR
	KBBUF=KBCSR+2		;KEYBOARD BUFFER
	TTCSR=KBBUF+2		;TELEPRINTER CSR
	TTBUF=TTCSR+2		;TELEPRINTER BUFFER
	KBVEC=60		;KEYBOARD VECTOR
;
;	SATELLITE SOFTWARE DEFINITIONS
;
	STACK=1000		;STACK POINTER FOR SATELLITE
	SCLSIZ=800.		;SCROLL BUFFER SIZE (MULT. OF 2 BYTES)
	BOOT=166000		;ADDRESS OF ROM BOOT
	.ENDC			;$ATEL
;
;	VT11/VS60 HARDWARE DEFINITIONS
;
	GRVEC=320		;VT11/VS60 VECTORS
	DPC=172000		;DISPLAY PC
	DSR=DPC+2		;DISPLAY STATUS REG.
	.IF NE	V$60
	DSRX=DPC+12		;EXTENDED STATUS REGISTER (VS60)
	DNR=DPC+20		;NAME SEARCH REGISTER (VS60)
	CSTAT=DPC+22		;CONSOLE STATUS REG. (VS60)
	DSTACK=DPC+26		;STACK READ REGISTER (VS60)
	DSP=DPC+32		;STACK POINTER (VS60)
	DOS=DPC+36		;OFFSET SIGN WORD (VS60)
	.IFF			;V$60
	PMAX=1777		;MAXIMUM VALUE OF A POINT
	.IFT			;V$60
	PMAX=7777		;MAXIMUM VALUE OF A POINT (VS60)
	.IFTF			;V$60
	VMAX=1777		;MAX LONG VECTOR
	VSIGN=20000		;LONG VECTOR SIGN
	SVMAX=77		;SHORT VECTOR MAX
	SVSIGN=100		;SHORT VECTOR SIGN
	INTEN=40000		;INTENSIFY BIT
	SVMASK=177600		;SHORT VECTOR MASK
	XYMASK=176000		;X-Y COORDINATE MASK
	LVMASK=176000		;LONG VECTOR MASK
	SSCRN=768.		;SMALL SCREEN SIZE (VR14)
	BSCRN=1024.		;BIG SCREEN SIZE (VR17)
	CHRHT=24.		;CHARACTER HEIGHT
	EDGEF=40		;EDGE FLAG
	.IFT			;V$60
	EXTSTP=200		;EXTERNAL STOP BIT (VS60)
	OFFSET=10000		;OFFSET MODE BIT (VS60)
	OFMASK=170000		;OFFSET MASK (VS60)
	LP0=40000		;LIGHT PEN 0 FLAG (VS60)
	LP1=400			;LIGHT PEN 1 FLAG (VS60)
	TON0=20000		;TIP SWITCH 0 ON FLAG (VS60)
	TOFF0=10000		;TIP SWITCH 0 OFF FLAG (VS60)
	TON1=200		;TIP SWITCH 1 ON FLAG (VS60)
	TOFF1=100		;TIP SWITCH 1 OFF FLAG (VS60)
	DJMPR=161000		;DISPLAY JUMP RELATIVE (VS60)
	SRESET=40		;STACK RESET BIT (VS60)
	.ENDC			;V$60
	.IF NE	<RT$11!$ATEL>&LK$11
	PBCSR=160060		;LK11 CSR
	PBIBUF=PBCSR+2		;LK11 PUSH BUTTON INPUT REGISTER
	PBOBUF=PBIBUF+2		;LK11 LIGHT OUTPUT REGISTER
	PBVEC=360		;LK11 VECTOR
	.ENDC			;<RT$11!$ATEL>&LK$11
	.IF NE	LOC$AV
	RXCS=177170		;RX CSR
	RXVEC=264		;RX VECTOR
	CSGO=1			;INITIATE FUNCTION
	CSFBUF=0*2		;FILL SILO (PRE-WRITE)
	CSEBUF=1*2		;EMPTY SILO (POST-READ)
	CSWRT=2*2		;WRITE SECTOR
	CSRD=3*2		;READ SECTOR
	CSUNIT=20		;UNIT BIT
	CSINT=100		;INTERUPT ENABLE
	CSINIT=40000		;RX11 INITIALIZE
	RETRY=8.		;RETRY COUNT
	.ENDC			;LOC$AV
	.IF NE	$ATEL!<1-HO$AT>
;
;	DPU DRIVER DEFINITIONS
;
	NAMSIZ=18.		;SIZE OF NAME LIST
	BFHDR=52.		;BUFFER HEADER SIZE
	TOHDR=14.		;DISP. FROM BUFFER TO TRACK OBJ #1 X,Y
	TOHDR2=74.		;DISP. FROM BUFFER TO TRACK OBJ #2 X,Y
	.IF EQ	SCOPE$
	ALSIZE=41.		;SIZE OF ATTACH LIST
	.IFF			;SCOPE$
	ALSIZE=83.		;SIZE OF ATTACH LIST
	.ENDC			;SCOPE$
	GRDSZ1=97.		;SIZE OF /GRDAT/ ENTRIES BEFORE IATT
	.IF EQ	INT$
	GRDSZ2=8.		;SIZE OF /GRDAT/ ENTRIES AFTER IATT
	.IFF			;INT$
	GRDSZ2=0.		;SIZE OF /GRDAT/ ENTRIES AFTER IATT
	.ENDC			;INT$
	T1=12.			;DISP. FROM XSR TO TIP1 FLAG IN /DFILE/
	T2=14.			;DISP. FROM XSR TO TIP2 FLAG IN /DFILE/
	LPE=16.			;DISP. FROM XSR TO LPFLAG IN /DFILE/
	.ENDC			;$ATEL!<1-HO$AT>
;
;	CHARACTER DEFINITIONS
;
	TAB=11
	LF=12
	CR=15
	SPACE=40
	ZERO=60
	MINUS=55
	BELL=7
	PROMPT='>
	RUBOUT=177
	UARROW='^
	CTL=100
	BACKSP=10
	CTLB=2
	CTLC=3
	CTLH=10
	CTLU=25
	BOX=37
	SHFTIN=17
	SHFTOU=16
;
;	REGISTER DEFINITIONS
;
	R0=%0
	R1=%1
	R2=%2
	R3=%3
	R4=%4
	R5=%5
	SP=%6
	PC=%7
	PSW=177776
;
;	DEBUG DEFINITIONS
;
	DEBUG=0			;DEBUG MODE (REPORT COMM. PROBLEMS)
	.SBTTL	BIT FIDDLERS
;
;	BUILD A LONG VECTOR
;
MVECT:	MOV	#VMAX,R2	;MAX LONG VECT DISPLACEMENT
	TST	(R5)+		;SKIP ARG COUNT
	MOV	@(R5)+,R0	;GET SIGNED VECTOR DISPLACEMENT
	BMI	20$		;NEGATIVE, GO FIDDLE IT
	CMP	R0,R2		;IS IT TOO BIG ?
	BLOS	10$		;NO, SMALL ENOUGH
	MOV	R2,R0		;TOO BIG, SET TO MAX
10$:	MOV	R0,@(R5)+	;RETURN MAGNITUDE
	CLR	@(R5)+		;RETURN SIGN
	RTS	PC		;RETURN CONTROL
20$:	NEG	R0		;MAKE MAG POSITIVE
	CMP	R0,R2		;IS IT TOO BIG ?
	BLOS	30$		;BRANCH IF OK
	MOV	R2,R0		;TOO BIG, SUBSTITUTE MAX
30$:	MOV	R0,@(R5)+	;RETURN MAGNITUDE
	MOV	#VSIGN,@(R5)+	;SET SIGN
EREXIT:	RTS	PC
;
;	BUILD AN ABSOLUTE POINT
;
MPNT:	MOV	#PMAX,R2	;MAX VALUE FOR A POINT
	CLR	R0		;CLEAR RESULT REG
	TST	(R5)+		;SKIP ARG COUNT
	MOV	@(R5)+,R1	;GET VALUE
	BPL	10$		;POSITIVE ?
	.IF EQ	V$60
	CLR	R1		;NO, MAKE IT ZERO
	.IFF			;-V$60
	BIS	#VSIGN,R0	;NO, SET SIGN BIT
	NEG	R1		;MAKE IT POS.
	.ENDC			;-V$60
10$:	CMP	R1,R2		;BIGGER THAN MAX ?
	BLOS	20$		;NO
	MOV	R2,R1		;YES, SUBSTITUTE MAX
20$:	BIS	R1,R0		;PUT IN VALUE
	MOV	R0,@(R5)+	;AND RETURN IT
	RTS	PC
;
;	UNMAKE A LONG VECTOR COMPONENT
;
UNMAKV:	TST	(R5)+		;SKIP ARG COUNT
	MOV	@(R5)+,R0	;GET THE VECTOR COMPONENT
	.IF NE	V$60
	BIC	#INTEN+OFFSET,R0 ;CLEAR INTENSIFY AND OFFSET BITS
	.IFF			;V$60
	BIC	#INTEN,R0	;CLEAR INTENSIFY BIT
	.ENDC			;V$60
	BIT	#VSIGN,R0	;NEGATIVE ?
	BEQ	10$		;NO
	BIC	#VSIGN,R0	;YES, CLEAR OUT SIGN
	NEG	R0		;MAKE IT 2'S COMPLEMENT NEGATIVE
10$:	MOV	R0,@(R5)+	;RETURN VALUE
	RTS	PC
;
;	UNMAKE A SHORT VECTOR
;
UNMKSV:	TST	(R5)+		;SKIP ARG COUNT
	MOV	@(R5)+,R0	;GET THE VECTOR
	MOV	R0,R1		;COPY IT
	ASL	R1		;PUT X PART INTO HI BYTE
	SWAB	R1		;NO PUT IT INTO LOW BYTE
	JSR	PC,10$		;GO DO X PART
	MOV	R0,R1		;PUT Y PART INTO LOW BYTE AND DO IT
10$:	BIC	#SVMASK,R1	;CLEAR UNWANTED BITS
	BIT	#SVSIGN,R1	;NEGATIVE ?
	BEQ	20$		;NO
	BIC	#SVSIGN,R1	;TURN SIGN OFF
	NEG	R1		;MAKE IT 2'S COMPLEMENT
20$:	MOV	R1,@(R5)+	;STORE VALUE
	RTS	PC		;DONE
;
;	RETURN ADDRESS OF ARGUMENT
;
IADRS:	MOV	2(R5),R0	;FORTRAN DOES ALL THE WORK
	RTS	PC		;YUP, THAT'S IT
;
;	RETURN VALUE OF AN OPTIONAL ARG OR 0 IF MISSING
;
IOPTV:	MOV	2(R5),R2	;GET THE RASCAL'S ADDRESS
	CMP	R2,#-1		;IS HE THERE ?
	BNE	10$		;BRANCH IF YES
	CLR	R0		;NOT HOME, RETURN A 0
	RTS	PC
10$:	MOV	(R2)+,R0	;OK GET THE RASCAL HIMSELF
	RTS	PC
;
;	RETURN THE NUMBER OF ARGS THE CALLER WAS CALLED WITH
;
NOPTS:
	.IF EQ	F4PLU$
	MOV	@#$AOTS,R0	;FORTRAN OTS 'DIRTY' POINTER
	MOV	ENMLNK(R0),R0	;STACK FRAME OF OUR CALLER
	MOVB	CAL$CT(R0),R0	;ARG COUNT OUR CALLER WAS CALLED WITH
	.IFF			;-F4PLU$
	MOVB	@2(SP),R0	;GET OLD ARG COUNT (ASSUME CALLER JUST SAVED R5)
	.ENDC			;-F4PLU$
	SUB	@2(R5),R0	;MINUS THE COUNT OF MANDATORY ARGS
	BPL	10$		;OK IF >= 0
	JSR	PC,EREXIT	;CALL USER'S ERROR HANDLER
	TRAP	128.+80.	;TRAP=INCORRECT NUMBER OF ARGS
10$:	RTS	PC
;
;	LOGICAL AND OF TWO 16 BIT NUMBERS
;
IAND:	TST	(R5)+		;SKIP OVER ARG COUNT
	MOV	@(R5)+,R1	;GET FIRST ARG
	COM	R1		;COMPLEMENT IT
	MOV	@(R5)+,R0	;GET THE SECOND
	BIC	R1,R0		;DO THE AND
	RTS	PC
;
;	ADD AND IGNORE INTEGER OVERFLOW
;
IADD:	MOVB	(R5)+,R4	;NUMBER OF ARGS
	INC	R5
	MOV	(R5)+,R3	;DESTINATION ADDRESS
10$:	DEC	R4		;ANY MORE ?
	BLE	20$		;NO
	ADD	@(R5)+,(R3)	;ADD TO DESTINATION
	BR	10$		;LOOP
20$:	RTS	PC
;
;	STORE ARG 2 INTO ARG 1 IF ARG 1 ISN'T NULL
;
CSTORE:	TST	(R5)+		;SKIP ARG COUNT
	MOV	(R5)+,R0	;GET ARG1 ADDRESS
	CMP	R0,#-1		;MISSING ARG ?
	BEQ	10$		;YES, DON'T STORE
	MOV	(R5)+,R1	;GET DESTINATION ADDRESS
	MOV	@(R5)+,R2	;AND WORD COUNT
1$:	MOV	(R1)+,(R0)+	;MOVE A WORD
	DEC	R2		;DECREMENT COUNT
	BNE	1$		;LOOP
10$:	RTS	PC
;
;	RETURN VALUE OF INDEFINITE ARG STRING
;
ARG:	TST	(R5)+		;SKIP COUNT
	MOV	(R5)+,R0	;POINTER TO RETURN VALUE
	MOV	@(R5)+,R1	;ARG NUMBER
	MOV	@(R5)+,R2	;BYTE NUMBER WITHIN ARG
	MOV	@(R5)+,R3	;BYTE COUNT
	ASL	R1		;MAKE ARG NUMBER USABLE AS INDEX
	ADD	R1,R5		;POINT AT CORRECT ARG POINTER (+2)
	MOV	-(R5),R1	;GET POINTER TO CORRECT ARG
	ADD	R2,R1		;POINT AT CORRECT BYTE (+1)
	DEC	R1		;NOW ITS CORRECT
10$:	MOVB	(R1)+,(R0)+	;COPY IN DESIRED BYTE STRING
	DEC	R3		;MORE ?
	BNE	10$		;YES
	BIT	#1,R0		;ODD NUMBER RETURNED ?
	BEQ	20$		;NO
	CLRB	(R0)+		;YES, ZERO ONE MORE
20$:	RTS	PC
;
;	RETURN ADDRESS OF ARG. AS A NUMBER OF WORDS
;
NWDS0:	MOV	2(R5),R0	;GET ARG. ADDRESS
	CLC			;GET A ZERO
	ROR	R0		;SHIFT IT IN (UNSIGNED DIVIDE BY TWO)
	RTS	PC
;
;	RETURN VALUE OF ARG. (AN ADDRESS) AS A NUMBER OF WORDS
;
NWDS:	MOV	@2(R5),R0	;GET ARG. VALUE
	CLC			;DO UNSIGNED DIVIDE BY 2
	ROR	R0
	RTS	PC
;
;	CONVERT INTEGER / OCTAL TO ASCII
;
OTOA:	MOV	#8.,-(SP)	;PUSH RADIX
	BR	IOCON		;ENTER COMMON CODE
ITOA:	MOV	#10.,-(SP)	;PUSH RADIX
IOCON:	MOVB	(R5)+,R4	;NUMBER OF ARGS
	INC	R5
10$:	MOV	#SPACE,R0	;SHOVE A BLANK INTO R0
	MOV	@(R5)+,R2	;NUMBER TO BE CONVERTED
	BPL	20$		;OK, ITS POSITIVE
	CMP	(SP),#8.	;IS THIS OCTAL CONVERSION ?
	BEQ	20$		;YES, NO SIGN
	MOV	#MINUS,R0	;MAKE THE FIRST NON-DIGIT A MINUS
	NEG	R2		;MAKE NUMBER POSITIVE
20$:	MOV	@(R5)+,R3	;SIZE OF BUFFER
	ADD	(R5)+,R3	;ADDRESS OF END OF BUFFER + 1
25$:	CLR	R1		;QUOTIENT WILL GO HERE
30$:	SUB	(SP),R2		;SUB RADIX
	BCS	40$		;WHUPS, DIDN'T FIT
	INC	R1		;BUMP QUOTIENT
	BR	30$		;DIVIDE SOME MORE
40$:	ADD	#ZERO,R2	;MAKE THE REMAINDER AN ASCII CHAR
	ADD	(SP),R2
50$:	CMP	R3,-2(R5)	;ROOM IN BUFFER ?
	BLOS	60$		;NO, FORGET THIS CHAR
	MOVB	R2,-(R3)	;OK, SHOVE IN THE CHARACTER
	MOV	R1,R2		;PUT QUOTIENT IN AS NEW DIVIDEND
	BNE	25$		;IF IT WEREN'T ZERO, DIVIDE BY RADIX AGAIN
	MOV	R0,R2		;NOW PUT OUT BLANK OR MINUS
	MOV	#SPACE,R0	;NEXT TIME MAKE SURE ITS BLANK
	BR	50$		;GO BACK AND FILL IN THE BUFFER
60$:	SUB	#3,R4		;ANOTHER SET OF ARGS ?
	BGT	10$		;YES, GO PROCESS THEM
	TST	(SP)+		;CLEAN STACK
	RTS	PC		;NO, EXIT
	.IF NE	LK$11
;
;	CONVERT BITS TO LOGICAL*1 ARRAY
;
BTL:				;NOTE: BITS 0 - 15  -->  ARRAY(1) - ARRAY(16)
	TST	(R5)+		;SKIP COUNT
	MOV	@(R5)+,R2	;GET 16 BITS
	MOV	(R5),R4		;GET LOGICAL*1 ARRAY ADDRESS
	MOV	#16.,R1		;BIT COUNT
10$:	CLR	R3		;LOGICAL VALUE WILL GO HERE
	ROR	R2		;GET NEXT BIT
	BCC	20$		;ZERO
	COM	R3		;ONE
20$:	MOVB	R3,(R4)+	;LOGICAL VALUE INTO ARRAY
	DEC	R1		;MORE BITS ?
	BNE	10$		;YES
	RTS	PC		;NO
;
;	CONVERT LOGICAL*1 ARRAY TO BITS
;
LTB:				;NOTE:  ARRAY(1) - ARRAY(16)  -->  BITS 0 - 15
	TST	(R5)+		;SKIP ARG COUNT
	MOV	(R5)+,R4	;POINTER TO LOGICAL*1 ARRAY
	MOV	#16.,R1		;BIT COUNT
	CLR	R2		;BUILD RESULT HERE
10$:	TSTB	(R4)+		;.TRUE. ?
	BEQ	20$		;NO, .FALSE.
	SEC			;YES, SET CARRY
20$:	ROR	R2		;SHIFT IN THE BIT
	DEC	R1		;MORE ?
	BNE	10$		;YES
	MOV	R2,@(R5)+	;RETURN BITS
	RTS	PC
	.ENDC			;LK$11
	.IF NE	$ATEL
;
;	CONVERT BYTE STRING TO A WORD
;
INTEGR:	MOV	2(R5),R4	;ADDRESS OF BYTE STRING
	CLR	R0		;CLEAR RESULT REG.
	BISB	1(R4),R0	;PUT IN HIGH ORDER BYTE
	SWAB	R0		;SWAB IT INTO POSITION
	BISB	(R4),R0		;NOW PUT IN LOWER BYTE
	RTS	PC		;NOW ITS ON A NICE EVEN BOUNDARY
	.IF EQ	INT$
;
;	CONVERT A BYTE STRING TO A DOUBLE WORD
;
REEL:	MOV	2(R5),R4	;ADDRESS OF BYTE STRING
	ADD	#3,R4		;POINT AT END OF STRING
	CLR	R1		;CLEAR SECOND WORD OF RESULT
	BISB	(R4),R1		;PUT IN 4TH BYTE
	SWAB	R1		;SWAB INTO HI POSITION
	BISB	-(R4),R1	;NOW PUT IN 3RD (THATS THE SECOND WORD)
	CLR	R0		;CLEAR FIRST WORD OF RESULT
	BISB	-(R4),R0	;PUT IN 2ND BYTE
	SWAB	R0		;SWAB IT
	BISB	-(R4),R0	;NOW FIRST BYTE (THATS FIRST WORD)
	RTS	PC
	.ENDC			;-INT$
	.ENDC			;$ATEL
;
;	WAIT ROUTINE (COUNT IN HUNDREDS OF MICROSECONDS)
;
WAIT:	MOV	@2(R5),R1	;GET COUNT FROM FORTRAN ARG LIST
WAITX:	MOV	R1,-(SP)	;PUSH 100 US COUNT
10$:	MOV	#HUS,R1		;LOOP COUNT FOR 100 US
20$:	DEC	R1		;COUNT DOWN
	BGT	20$		;KEEP GOING
	DEC	(SP)		;MORE LOOPS ?
	BGT	10$		;YES
	TST	(SP)+		;CLEAN STACK
	RTS	PC
	.IF NE	LOC$AV
;
;	DECODE ASCII FILE NAME STRING INTO RAD 50
;
CSI:	TST	(R5)+		;SKIP ARG COUNT
	MOV	(R5)+,R0	;POINTER TO ASCII FILE STRING
	MOV	(R5)+,R1	;POINT TO DEVICE NAME
	MOV	(R5),R2		;POINT TO RAD 50 OUTPUT
	CLR	(R1)		;CLEAR DEVICE NAME WORD
60$:	CLR	(R2)		;CLEAR R50 RESULT WORD
	CLR	R3		;CLEAR R50 CHAR COUNTER
100$:	MOVB	(R0),R4		;END OF FILE STRING ?
	BEQ	350$		;YES, FILL OUT 3 WORDS
	CMPB	R4,#':		;COLON ?
	BNE	200$		;NO
	TST	-(R2)		;BACK UP  OUTPUT POINTER
	CMP	R2,(R5)		;BACK TO THE START ?
	BNE	500$		;NO, DEVICE NAME WAS TOO LONG
				;(OR TOO SHORT)
	TST	R3		;FIRST CHAR OF SECOND WORD ?
	BNE	500$		;NO, DEVICE NAME TOO LONG
				;(OR TOO SHORT)
	TST	(R1)		;PREVIOUS DEVICE NAME ?
	BNE	500$		;YES, THATS AN ERROR
	MOV	(R2),(R1)	;OK, USE FIRST WORD AS DEVICE NAME
	INC	R0		;SKIP COLON
	BR	60$		;RESTART
200$:	CMPB	R4,#'.		;POINT ?
	BNE	300$		;NO, NOT EXIT
	CLR	R4		;ZERO TO END OF FILE NAME
	MOV	(R5),-(SP)	;GET ADDRESS OF RAD50 OUTPUT
	ADD	#4,(SP)		;MAKE IT ADDRESS OF EXT WORD
	CMP	R2,(SP)+	;ARE WE THERE YET ?
	BLO	350$		;NO, FILL IT OUT SOME MORE
	INC	R0		;YES, SKIP OVER POINT
	TST	R3		;FIRST CHAR OF THE EXT ?
	BLE	100$		;YES, GO START EXT
	BR	500$		;NO, ERROR
300$:	BIC	#177700,R4	;ISOLATE LOWER 6 BITS
	MOVB	R50TAB(R4),R4	;CONVERT CHAR TO R50
	BEQ	500$		;ILLEGAL FILE NAME CHAR
	INC	R0		;BUMP FILE STRING POINTER
350$:	ASL	(R2)		;MULTIPLY OLD BY 50(8)
	ASL	(R2)
	ASL	(R2)
	ADD	(R2),R4		;OLD*8.+CHAR
	ASL	(R2)
	ASL	(R2)		;OLD*32.
	ADD	R4,(R2)		;OLD*40.+CHAR = OLD*50(8)+CHAR
	INC	R3
	CMP	R3,#3		;THREE CHARS IN THIS WORD ?
	BLT	100$		;NO, NOT YET
	TST	(R2)+		;BUMP OUTPUT POINTER
	MOV	(R5),-(SP)	;POINT AT R50 BUFFER
	ADD	#4,(SP)		;POINT AT WHERE EXT WILL GO
	CMP	R2,(SP)+	;THERE YET ?
	BLO	60$		;NO, ITS COOL
	BHI	600$		;PAST IT, MUST BE DONE
400$:	TSTB	(R0)		;IS NEXT ONE A NULL ?
	BEQ	60$		;YES, THAT WILL FILL US OUT
	CMPB	(R0),#'.	;IS IT A PONT ?
	BEQ	60$		;YES, THAT WILL DO ALSO
500$:	MOV	#-2,@2(R5)	;BAD FILE STRING
	RTS	PC
600$:	MOV	#1,@2(R5)	;GOOD FILE STRING
	TST	(R1)		;ANY DEVICE NAME ?
	BNE	650$		;YES
	MOV	(PC)+,(R1)	;NO, USE DEFAULT NAME
	.RAD50	/DK0/
650$:	RTS	PC
	.ENDC			;LOC$AV
;
;	RETURN CURRENT VERSION NUMBER
;
VERSON:	MOV	#V$$,@2(R5)	;RETURN VERSION NUMBER
	RTS	PC
	.IF NE	HO$AT&$ATEL
	.SBTTL	MESSAGE FROM/TO HOST
;
;	RECIEVE MESSAGE FROM HOST
;
FRHOST:
1$:	TST	MIMOD		;READ DONE YET ?
	BEQ	5$		;YES, MOVE MESSAGE INTO BUFFER
	CMPB	(R5),#1		;TWO ARGS ?
	BLE	1$		;NO, WAIT
	CLR	@4(R5)		;YES, CLEAR FLAG AND RETURN
	RTS	PC
5$:	MOV	#DLIMSG,R4	;POINT AT THE MESSAGE
	MOVB	(R4),R0		;GET THE CODE BYTE
	BICB	#MSGNF,R0	;ELIMINATE THE MESSAGE NUMBER
	CMPB	R0,#DATCOD	;IS IT A DATA MESSAGE ?
	BNE	40$		;NO, IGNORE IT
	BICB	#CODEF,(R4)	;ISOLATE MESSAGE NUMBER
	MOV	R5,-(SP)	;SAVE ARG LIST POINTER
	MOV	#ACKMSG,R5	;SEND THE ACKNOWLEDGMENT
	CALL	SNDMSG
	MOV	(SP)+,R5	;RESTORE ARG LIST POINTER
	MOV	2(R5),R3	;POINT AT DESTINATION
	CMPB	(R4),LASTMN	;IS THIS A REPEAT OF THE LAST MESSAGE ?
	BEQ	40$		;YES, MAYBE THIS ACK WILL GET THROUGH
	MOVB	(R4)+,LASTMN	;NO, SAVE NEW MESSAGE NUMBER
	SUB	#2,DLIPTR	;DON'T MOVE CRC
20$:	MOVB	(R4)+,(R3)+	;MOVE IN MESSAGE
	CMP	R4,DLIPTR	;REACHED THE END YET ?
	BLO	20$		;NO, KEEP GOING
	CMPB	(R5),#1		;TWO ARGS ?
	BLE	40$		;NO, NO FLAG TO SET
	MOV	SP,@4(R5)	;YES, SET FLAG
40$:	CALL	RECMSG		;INITIATE ANOTHER READ
50$:	RTS	PC
;
;	SEND MESSAGE TO HOST AND WAIT FOR NEXT MESSAGE
;
TOHOST:	MOV	R5,-(SP)	;SAVE ARG LIST POINTER
1$:	TST	MIMOD		;IS THE READ DONE YET ?
	BNE	1$		;NO, HANG
2$:
	.IF NE	DEBUG
	MOV	#DLIMSG,R0	;POINT AT MESSAGE JUST READ
	MOVB	(R0),R1		;GET THE CODE
	CMPB	R1,#ASKCOD	;IS THIS AN ASK MESSAGE ?
	BEQ	5$		;YES, PROCEED
	BICB	#MSGNF,R1	;ELIMINATE MSG NUM FROM CODE
	CMPB	R1,#DATCOD	;WAS IT A DATA MESSAGE ?
	BNE	3$		;NO, NOTHING ELSE ACCEPTABLE
	BICB	#CODEF,(R0)	;ISOLATE MSG NUMBER OF DAT MSG
	CMPB	(R0),LASTMN	;WAS IT THE LAST ONE RECIEVED ?
	BEQ	4$		;YES, ACK IT AGAIN
3$:	ERROR	1		;NO, SOMETHING IS VERY WRONG
4$:
	.IFF			;DEBUG
	CMPB	DLIMSG,#ASKCOD	;IS IT AN ASK ?
	BEQ	5$		;YES
				;NO, ASSUME DAT AND ACK IT
	.ENDC			;DEBUG
	MOV	#ACKMSG,R5	;POINT AT ACK MESSAGE
	CALL	SNDMSG		;SEND IT
	CALL	RECMSG		;INITIATE ANOTHER READ
	BR	1$		;SEE IF ITS AN ASK
5$:	MOV	#DLOTMP+2,R0	;BUILD MESSAGE INTO DLO TEMP BUF
	MOV	R0,R4		;COPY POINTER
	MOVB	#DATCOD,(R0)+	;FIRST STICK IN THE DATA CODE
	MOV	(SP),R5		;RESTORE ARG LIST POINTER
	MOVB	(R5)+,R1	;GET ARG COUNT
	INC	R5		;SKIP UNUSED BYTE
10$:	MOV	@(R5)+,R2	;NUMBER OF BYTES IN ARG
	MOV	(R5)+,R3	;POINTER TO ARG
20$:	MOVB	(R3)+,(R0)+	;MOVE ARG (ONE BYTE AT A TIME)
	DEC	R2		;MORE ?
	BGT	20$		;YES
	SUB	#2,R1		;MORE ARGS ?
	BGT	10$		;YUP
30$:	SUB	R4,R0		;GET SIZE OF DATA MESSAGE (INCLUDING DATCOD)
	MOV	R0,-(R4)	;PUT IN BYTE COUNT
	MOV	R4,R5		;POINT AT MESSAGE (COUNT,DATA)
	CALL	SNDMSG		;SEND IT
	CALL	RECMSG		;READ THE NEXT MESSAGE
40$:	TST	(R0)		;DONE YET ?
	BNE	40$		;NO, WAIT
	CMPB	DLIMSG,#RPTCOD	;REPEAT IT ?
	BEQ	5$		;YES, RETRANSMIT IT
	TST	(SP)+		;FIXUP STACK
	CLR	DLYMOD		;CLEAR DELAY MODE FLAG
	RTS	PC		;IF NOT A REPEAT, ASSUME IT GOT THERE
;
;	DELAY HOST
;
DHOST:
10$:	TST	MIMOD		;MESSAGE RECIEVED ?
	BNE	10$		;NO, WAIT
	CMPB	DLIMSG,#ASKCOD	;WAS MESSAGE AN ASK ?
	BNE	20$		;NO, ASSUME DAT
	INC	DLYMOD		;SET DELAY MODE FLAG
	MOV	@2(R5),R4	;GET SIZE OF MESSAGE TO BE DELAYED
				;SIZE OF MESSAGE MUST MATCH READ IN HOST
	MOV	#DLYMSG,R5	;YES, POINT AT DELAY MESSAGE
	INC	R4		;ADD A BYTE FOR CODE
	MOV	R4,(R5)		;SIZE INTO MESSAGE HEADER
	CALL	SNDMSG		;SEND IT
	JMP	RECMSG		;RECIEVE NEXT MESSAGE AND RETURN
20$:
	.IF NE	DEBUG
	BICB	#CODEF,DLIMSG	;THROW AWAY CODE FIELD
	CMPB	DLIMSG,LASTMN	;IS MESSAGE NUMBER SAME AS LAST ?
	BEQ	30$		;YES, THATS OK
	ERROR	3		;NO, ERROR
30$:
	.ENDC			;DEBUG
	MOV	#ACKMSG,R5	;ASSUME A DAT MESSAGE
	CALL	SNDMSG		;SEND ACK
	CALL	RECMSG		;INITIATE NEXT READ
	BR	DHOST		;WAIT FOR ASK
	RTS	PC
;
;	RECIEVE A MESSAGE
;
RECMSG:
	.IF NE	DEBUG
	TST	MIMOD		;RECIEVE STILL PENDING ?
	BEQ	10$		;NO
	ERROR	4		;YES, LOGIC ERROR
10$:
	.ENDC			;DEBUG
	MOV	#DLIPTR,R0	;POINT AT INPUT BUFFER POINTER
	MOV	R0,R3		;COPY IT
	CMP	(R3)+,(R3)+	;POINT AT BUFFER START
	MOV	R3,(R0)		;SAVE BUFFER POINTER
	MOV	#SYNCT-HSIZE-1,-(R3) ;PUT IN HEADER COUNT
	CLR	-(R0)		;CLEAR CRC
	MOV	#1,-(R0)	;ENTER MESSAGE INPUT MODE
	RTS	PC
;
;	SEND A MESSAGE
;
SNDMSG:
	.IF NE	R$X11D!IA$
	TST	MOMOD		;SEND STILL PENDING ?
	BNE	SNDMSG		;NO
	.IFF			;R$X11D!IA$
	.IF NE	DEBUG
	TST	MOMOD		;SEND STILL PENDING ?
	BEQ	10$		;NO
	ERROR	5		;YES, LOGIC ERROR
10$:
	.ENDC			;DEBUG
	.ENDC			;R$X11D!IA$
	MOV	#DLOCNT,R2	;POINT AT CHAR COUNT
	MOV	R2,R0		;COPY IT
	MOV	#HSIZE,(R2)+	;START WITH STANDARD HEADER
	MOV	R2,-(R0)	;SET BUFFER POINTER
	MOV	R0,R3		;COPY POINTER ADDRESS
	MOV	#DLECRC,-(R3)	;INITIAL CRC
	CLR	-(R3)		;CLEAR COMPLETION FLAG
	CLR	-(R3)		;CLEAR NO-WAIT FLAG
	MOVB	#SYN,(R2)	;FIRST SYN
	.REPT	SYNCT-2
	MOVB	(R2)+,(R2)	;REST OF THE SYNS
	.ENDR
	MOVB	(R2)+,(R2)+	;LAST SYN
	MOVB	#DLE,(R2)+	;HEADER DLE
	MOV	(R5),R1		;MESSAGE SIZE
	CALL	STORE		;STORE A BYTE AND DO CRC
	CALL	SENDMS		;SEND HEADER
	MOV	R0,R2		;POINTER TO BUFFER POINTER
	TST	(R2)+		;POINTER TO COUNT
	MOV	(R5),(R2)	;SETUP DATA COUNT
	ADD	#2,(R2)+	;+2 FOR CRC
	MOV	R2,(R0)		;RESET BUFFER POINTER
	MOV	R0,R3		;COPY R0
	CLR	-(R3)		;CLEAR CRC
	MOV	SP,-(R3)	;SET NO-WAIT FLAG
	MOV	(R5)+,R3	;GET BYTE COUNT AGAIN
20$:	MOVB	(R5)+,R1	;GET NEXT BYTE
	CALL	STORE		;STORE AND DO CRC
	DEC	R3
	BGT	20$		;LOOP
SENDMS:	TST	-(R0)		;POINT TO CRC
	MOVB	(R0)+,(R2)+	;STORE CRC LOW
	MOVB	(R0)+,(R2)+	;AND CRC HIGH
	MOV	#1,MOMOD	;ENTER MESSAGE OUTPUT MODE
	.IF NE	R$X11D!IA$
	CLR	FORWAY		;CLEAR FOUR WAY BRANCH COUNT
	.ENDC			;R$X11D!IA$
	BIS	#100,@#DLOCSR	;ENABLE INTERRUPTS
	TST	DLONWF		;WAIT ?
	BNE	30$		;NO, DON'T WAIT
10$:	TST	MOMOD		;DONE ?
	BNE	10$		;NO, WAIT
30$:	RTS	PC
;
;	STORE A BYTE AND DO CRC
;
STORE:	MOVB	R1,(R2)+	;BYTE INTO BUFFER
;
;	CALCULATE CRC FOR THIS BYTE
;
CRC:	MOV	#8.,-(SP)	;8 BITS PER BYTE
20$:	CLC			;EMPTY THE CARRY BIT
	ROR	-2(R0)		;SHIFT OLD PARTIAL
	ROR	R1		;SHIFT CHAR
	BVC	30$		;XOR POLYNOMIAL
	MOV	#POLY,-(SP)	;POLY TO STACK
	BIC	-(R0),(SP)	;.NOT.PARTIAL.AND.POLYNOMIAL
	BIC	#POLY,(R0)	;.NOT.POLYNOMIAL.AND.PARTIAL
	BIS	(SP)+,(R0)+	;POLYNOMIAL.XOR.PARTIAL
30$:	DEC	(SP)		;MORE BITS ?
	BGT	20$		;YES
	TST	(SP)+		;REMOVE BIT COUNT
	RTS	PC		;NO, RETURN
	.ENDC			;HO$AT&$ATEL
	.IF NE	$ATEL
	.SBTTL	COM LINE AND KEYBOARD INTERRUPT SERVICE
;
;	COM LINE INPUT INTERRUPT SERVICE
;
DLIINT:
	.IF NE	DEBUG
	INC	D$DLI		;SET IN DLINT FLAG
	.IFTF			;DEBUG
	MOV	R0,-(SP)	;SAVE SOME REGS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	#DLIPTR,R0	;POINT AT BUFFER POINTER
	MOVB	@#DLIBUF,R1	;SAVE THE CHAR
	MOVB	R1,@(R0)+	;INTO THE BUFFER
	MOV	#MIMOD,R2	;POINT AT INPUT MODE FLAG
	TST	(R2)		;IN MESSAGE INPUT MODE ?
	BNE	5$		;YES
1$:	TSTB	-(R2)		;CURRENTLY EXECUTING IN SCROLLER ?
	BEQ	4$		;NO, OK TO CALL IT
	MOVB	R1,-(R2)	;YES, SAVE CHAR. AND EXIT
	BR	58$
4$:	CALL	SCROLL		;SCROLL THE CHARACTER
	BR	58$		;EXIT FROM INTERRUPT
5$:	CMP	(R0),#SYNCT-HSIZE-1 ;ANYTHING READ IN YET ?
	BGT	10$		;YES
	CMPB	R1,#SYN		;NO, IS THIS A SYN ?
	BEQ	8$		;YES
	TST	(R2)		;NO SYN, ARE WE RETRYING AFTER ERROR ?
	.IFT			;DEBUG
	BPL	1$		;NO, ECHO IT
	MOVB	R1,@JUNK	;SAVE THE JUNK CHAR
	INC	JUNK		;MOVE THE POINTER
	CMP	(PC),@#JUNK	;OUT OF JUNK ROOM ?
	BHI	58$		;NO
	ERROR	6		;YES, ERROR
	.IFF			;DEBUG
	BMI	58$		;YES, FLUSH THE CHAR
	BR	1$		;NO, ECHO IT
	.IFTF			;DEBUG
8$:	MOV	#-1,(R2)	;YES, MESSAGE STARTED
	BR	50$		;GO COUNT THE CHAR
10$:	CMP	(R0),#SYNCT-HSIZE  ;DLE READ IN YET ?
	BNE	20$		;YES, GOOD BYTE SO SAVE IT
	CMPB	R1,#SYN		;NO, IS THIS ANOTHER SYN ?
	BEQ	58$		;YES, IGNORE LEADING SYNCS
	TST	-(R0)		;POINT AT BUFFER POINTER AGAIN
	CMPB	R1,#DLE		;DLE ?
	BEQ	30$		;YES, MESSAGE IN SYNC
	.IFT			;DEBUG
	INC	D$OOS		;INC OUT OF SYNC COUNT
	.IFTF			;DEBUG
15$:	MOV	#DLICNT,R0	;POINT AT COUNT
	MOV	#SYNCT-HSIZE-1,(R0) ;RESET COUNT
	MOV	#DLIMSG,-(R0)	;RESET POINTER
	CLR	-(R0)		;CLEAR CRC
	BR	58$		;TRY TO GET BACK IN SYNC
20$:	INC	-(R0)		;INC BUFFER POINTER (KEEPING CHAR)
30$:	CALL	CRC		;CALCULATE CRC FOR THIS BYTE
	TST	(R0)+		;POINT AT COUNT
40$:	TST	(R0)		;HEADER OR DATA ?
	BPL	60$		;DATA
50$:	INC	(R0)		;BUMP HEADER COUNT
	BMI	58$		;MORE TO COME
	TST	DLICRC		;DONE, TEST CRC
	.IFT			;DEBUG
	BEQ	55$		;OK
	INC	D$HCRC		;INCR HEADER CRC ERROR COUNT
	BR	15$		;RESET AND RETRY
55$:
	.IFF			;DEBUG
	BNE	15$		;NOT ZERO IS ERROR, RESET AND RETRY
	.IFTF			;DEBUG
	MOVB	DLIMSG,(R0)	;COUNT FOR DATA PORTION
	ADD	#2,(R0)+	;2 EXTRA FOR CRC
	MOV	R0,DLIPTR	;RESET BUFFER POINTER
	CMP	-(R0),#MAXMSG+3	;MESSAGE BIGGER THAN MAX (+CRC+CODE) ?
	.IFT			;DEBUG
	BLE	58$		;OK
	INC	D$SIZE		;INC SIZE ERROR COUNT
	BR	15$		;RESET AND RETRY
	.IFF			;DEBUG
	BGT	15$		;YES, ERROR, SO RESET AND RETRY
	.IFTF			;DEBUG
58$:	MOV	(SP)+,R2	;EXIT
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	.IFT			;DEBUG
	DEC	D$DLI		;CLEAR DLINT FLAG
	.IFTF			;DEBUG
	RTI
60$:	DEC	(R0)		;DECR DATA FIELD COUNT
	BGT	58$		;MORE COMING
	TST	DLICRC		;DONE, CHECK CRC
	.IFT			;DEBUG
	BEQ	65$		;OK
	INC	D$MCRC		;INC MSG CRC ERROR COUNT
	BR	15$		;RESET AND RETRY
65$:
	.IFF			;DEBUG
	BNE	15$		;NON ZERO, RESET AND RETRY
	.IFTF			;DEBUG
	CLR	(R2)		;CLEAR MESSAGE INPUT FLAG
	BR	58$		;EXIT
;
;	COM LINE OUTPUT INTERRUPT SERVICE
;
DLOINT:
	.IFT			;DEBUG
	INC	D$DLO		;SET FLAG
	TST	MOMOD		;MESSAGE OUTPUT MODE ?
	BNE	105$		;YES
	ERROR	7		;SHOULDN'T GET THIS INTERRUPT
105$:
	.ENDC			;DEBUG
	MOV	R0,-(SP)	;SAVE REGS
	MOV	R1,-(SP)
	MOV	#DLOCNT,R0	;POINT AT BUFFER COUNTER
	TST	(R0)		;MORE ?
	BLE	150$		;NO, FINISHED
	.IF NE	CWAIT
	MOV	#CWAIT,R1	;CHAR DELAY TIME
	CALL	WAITX		;WAIT A BIT
	.ENDC			;CWAIT
	.IF NE	R$X11D!IA$
	ADD	FORWAY,PC	;FOUR WAY BRANCH
	BR	125$		;FIRST OF FOUR
	BR	130$		;SECOND OF FOUR
	BR	135$		;THIRD OF FOUR
				;FOURTH OF FOUR
	SUB	#3,(R0)		;DECREMENT COUNT OF 8 BIT CHARS BY 3
	MOVB	@-(R0),R1	;GET THIRD 8 BIT CHAR
	INC	(R0)		;INCREMENT POINTER
	CLR	FORWAY		;START AT FIRST OF FOUR NEXT TIME
	BR	145$		;FINISH OFF THE FOURTH 6 BIT CHAR
125$:	MOVB	@-(R0),R1	;GET FIRST 8 BIT CHAR
	ASR	R1		;THROW AWAY LOWER TWO BITS
	ASR	R1		;CREATING FIRST 6 BIT CHAR
	BR	140$		;FINISH IT OFF
130$:	MOVB	@-(R0),-(SP)	;GET FIRST 8 BIT CHAR AGAIN
	INC	(R0)		;INCREMENT BUFFER POINTER
	MOVB	@(R0)+,R1	;GET SECOND 8 BIT CHAR
	ASR	(SP)		;USE TWO LOW BITS FROM FIRST 8 BIT CHAR
	RORB	R1		;AND 4 HIGH BITS FROM SECOND
	ASR	(SP)+		;TO CREATE SECOND 6 BIT CHAR
	RORB	R1
	RORB	R1		;DON'T FORGET TO MOVE IT ALL THE WAY RIGHT
	RORB	R1
	BR	140$		;FINISH IT AND SEND IT OUT
135$:	MOVB	@-(R0),R1	;GET SECOND 8 BIT CHAR AGAIN
	INC	(R0)		;INCREMENT BUFFER POINTER
	MOVB	@(R0)+,-(SP)	;GET THIRD 8 BIT CHAR
	ROLB	(SP)		;USE LOWER FOUR BITS OF SECOND
	ROLB	R1		;AND UPPER TWO OF THIRD
	ROLB	(SP)+		;8 BIT CHAR TO CREATE
	ROLB	R1		;THIRD 6 BIT CHAR
140$:	ADD	#2,FORWAY	;INCREMENT 4 WAY BRANCHER
145$:	BIC	#177700,R1	;ONLY KEEP LOWER 6 BITS
	BIS	#100,R1		;MOVE ALL CHARS INTO LEGAL ASCII RANGE
	.IFF			;R$X11D!IA$
	DEC	(R0)		;DECR BYTE COUNT
	MOVB	@-(R0),R1	;GET THE CHAR
	INC	(R0)		;BUMP POINTER
	.ENDC			;R$X11D!IA$
	MOVB	R1,@#DLOBUF	;OUTPUT IT
				;NOTE: THIS INT SERVICE ROUTINE MAY BE
				;INTERRUPTED AND DELAYED LONG ENOUGH FOR
				;THE NEXT DLO INT TO OCCUR; HENCE THE
				;APPARENT INNEFFICIENCY
	BR	160$		;DONE
150$:	CLR	MOMOD		;CLEAR MESSAGE OUTPUT FLAG
	BIC	#100,@#DLOCSR	;DISABLE DL OUTPUT INTERRUTPS
160$:	MOV	(SP)+,R1	;RESTORE REGS
	MOV	(SP)+,R0
	.IF NE	DEBUG
	DEC	D$DLO		;CLEAR IN DL OUTPUT FLAG
	.ENDC			;DEBUG
	RTI
;
;	KEYBOARD INPUT INTERRUPT SERVICE
;
KBIINT:	MOVB	@#KBBUF,-(SP)	;GET THE CHAR
	BIC	#177600,(SP)	;ZAP EXTRA BITS
	CMPB	(SP),#CTLH	;CTL/H ?
	BNE	1$		;NO, DON'T CHANGE MODES
	COMB	KBMODE		;YES, FLIP KB MODE
	CALL	CURFLP		;NOW CHANGE THE CURSOR DISPLAY
	BR	30$		;THAT'S ALL
1$:	TSTB	KBMODE		;WHAT MODE IS KB IN ?
	BEQ	4$		;HOST GETS THE CHAR
	CMPB	(SP),#CTLB	;CTL/B ?
	BNE	2$		;NO
	JMP	@#BOOT		;YES, REBOOT
2$:	CMPB	(SP),#CTLC	;CTL/C ?
	BNE	3$		;NO
	JMP	ABORT		;YES, EXIT
3$:	TSTB	KBCHR		;DOES THE SAT WANT IT ?
	BNE	30$		;NO, FORGET IT
	MOVB	(SP)+,KBCHR	;YES, GIVE CHAR TO THE SAT
	RTI			;DONE
4$:	TST	MOMOD		;MESSAGE OUTPUT MODE ?
	BNE	20$		;YES, IGNORE KEYBOARD INPUT
	TST	MIMOD		;MESSAGE INPUT MODE ?
	BMI	20$		;YES
	TST	DLYMOD		;HOST IN DELAY MODE ?
	BNE	20$		;YES, DON'T CONFUSE IT WITH JUNK
10$:	TSTB	@#DLOCSR	;IS DL11 READY ?
	BPL	10$		;NO, HANG
	MOVB	(SP)+,@#DLOBUF	;SHIP CHARACTER TO HOST
	RTI
20$:	MOVB	#BELL,@#TTBUF	;BEEP THE KEYBOARD
	INC	@#DSR		;WHEREVER IT MAY BE
30$:	TST	(SP)+		;FIX SP
	RTI
;
;	CHANGE THE CURSOR TO MATCH THE KEYBOARD MODE
;
CURFLP:	TSTB	KBMODE		;WHO'S GETTING THE CHARS ?
	BEQ	10$		;HOST
	BIS	#30,CURSOR	;SAT, BLINK THE BOX
	MOVB	#SPACE,CURRO+1	;AND ERASE THE RUBOUT
	RTS	PC		;THATS ALL
10$:	BIC	#30,CURSOR	;HOST, UNBLINK THE BOX
	MOVB	#RUBOUT,CURRO+1	;AND RESTORE THE RUBOUT
	RTS	PC
	.ENDC			;$ATEL
	.IF NE	LOC$AV
	.SBTTL	FLOPPY DRIVER FOR LOCAL SAVE/RSTR
;
;	RX11 DRIVER - FORTRAN CALLABLE
;	BORROWED FROM RT11
;
DX:	CMP	-(SP),-(SP)	;RESERVE 2 WORDS ON TO STACK TO USE
				;COMMON EXIT SEQUENCE
	TST	(R5)+		;SKIP ARG COUNT
	MOV	#CSGO+CSRD,R4	;FORM A GUESS AT RXCS FUNCTION
	TST	@(R5)+		;UNIT 0 OR 1 ?
	BEQ	1$		;BRANCH IF 0
	BIS	#CSUNIT,R4	;UPDATE GUESS AT RXCS
1$:	TST	@(R5)+		;FUNCTION ?
	BEQ	2$		;ZERO IS READ
	CMPB	-(R4),-(R4)	;SUBTRACT 2 FOR WRITE
2$:	MOV	R4,RXFUN	;SAVE READ OR WRITE RXCS COMMAND
	MOV	@(R5)+,R3	;BLOCK NUMBER
	ASL	R3		;MAKE BLOCK INTO LOGICAL SECTOR NUMBER
	ASL	R3
	MOV	R3,RXLSN	;SAVE FOR LATER
	MOV	@(R5)+,BYTCNT	;WORD COUNT
	ASL	BYTCNT		;MAKE WORD COUNT UNSIGNED BYTE COUNT
	MOV	(R5)+,BUFRAD	;BUFFER POINTER
	MOV	(R5),RXSRET	;SAVE ADDR OF STATUS RETURN
	CLR	@(R5)+		;CLEAR IT FOR NOW
	MOV	#RETRY,(PC)+	;SET RETRY COUNT
RXTRY:	.WORD	0		;RETRY COUNT
RXINIT:	CLR	R3		;SET THIS IS INITIAL INTERRUPT FLAG
	BR	RXWAIT		;PERFORM A RETURN TO WAIT FOR INTERUPT
;
;	RX11 INTERRUPT SERVICE
;
DXINT:	JSR	R5,DXINTS	;INTERRUPT ENTRY SUB
	MOV	R2,-(SP)	;SAVE SOME REGS
	MOV	R3,-(SP)
	MOV	(PC)+,R4	;GET ADDRESS OF RX STATUS
RXCSA:	.WORD	RXCS		;ONLY POINTER TO I/O PAGE
	MOV	R4,R5		;POINT R5 TO RX DATA BUFFER
	TST	(R5)+		;CHECK FOR ERROR
	BMI	RXERR1		;BRANCH IF ERROR
	NEG	(PC)+		;IS THIS INITIAL INTERRUPT? C=0 IF YES
INTINT:	.WORD	0		;INTERNAL INITIAL INTERUPT FLAG
	MOV	#128.,R3	;INIT R3 FOR 128 BYTES, USED LATER
	BIT	#CSEBUF,RXFUN	;READ OR WRITE INTERUPT?
	BNE	2$		;BRANCH IF READ
	BCC	1$		;BRANCH TO AVOID UPDATING POINTERS
	JSR	PC,NXTSEC	;SET UP FOR NEXT WRITE
1$:	JSR	R0,SILOFE	;LOAD THE SILO
				;SILOFE ARG LIST
	MOVB	(R2)+,(R5)	;MOVB TO BE PLACED IN-LINE IN SILOFE
	.WORD	CSGO+CSFBUF	;FILL BUFFER COMMAND
	CLRB	(R5)		;ZERO FILL SECTOR INSTRUCTION WHICH
				;WOULD BE USED FOR SHORT WRITES
;	BR	3$		;SKIP READ FINISHING, (C BIT IS 0)
2$:	BCC	3$		;BRANCH TO AVOID EMPTYING SILO
	JSR	R0,SILOFE	;MOVE THE DATA INTO MEMORY FROM SILO
				;SILOFE ARG LIST
	MOVB	(R5),(R2)+	;MOVB TO BE PLACED IN LINE IN SILOFE
	.WORD	CSGO+CSEBUF	;EMPTY BUFFER COMMAND
	MOVB	(R5),R2		;DATA SLUFFER TO BE USED FOR SHORT READ
	JSR	PC,NXTSEC	;SET UP TO READ NEXT SECTOR
3$:	MOV	(PC)+,R3	;GET THE LOGICAL SECTOR NUMBER
RXLSN:	.WORD	0		;LOGICAL SECTOR NUMBER KEPT HERE
;
;	RX11 LOGICAL TO PHYSICAL SECTOR MAPPING
;
	MOV	#8.,R2		;LOOP COUNT
1$:	CMP	#6400,R3	;DOES 26 GO INTO DIVIDEND?
	BHI	2$		;BRANCH IF NOT, C CLEAR
	ADD	#171400,R3	;SUBTRACT 26 FROM DIVIDEND, SETS C
2$:	ROL	R3		;SHIFT DIVIDEND AND QUOTIENT
	DEC	R2		;DEC LOOP COUNT
	BGT	1$		;BRANCH TILL DIVIDE DONE
	MOVB	R3,R2		;COPY TRACK NUMBER
	CLRB	R3		;REMOVE TRACK NUMBER FROM REMAINDER
	SWAB	R3		;GET REMAINDER
	CMP	#12.,R3		;C=1 IF 13<=R3<=25, ELSE C=0
	ROL	R3		;DOUBLE FOR 2 TO 1 INTERLEAVE
				;C-BIT COMES IN FOR SECTOR GROUP
	ASL	R2		;ADD TRACK TO TRACK SKEW TO SECTOR
	ADD	R2,R3		;SKEW BY 2* TRACK
	ADD	R2,R3		;SKEW BY 4* TRACK
	ADD	R2,R3		;SKEW BY 6* TRACK
	ASR	R2		;REFIX TRACK NUMBER
	INC	R2		;PUT TRACK # IN RANGE 1-76 TO HANDLE
				;ANSI FLOPPY, TRACK 0 IS LEFT ALONE
3$:	SUB	#26.,R3		;MODULO SECTOR INTO RANGE -26,-1
	BGE	3$		;LOOP TILL REMAINDER GOES NEGATIVE
	ADD	#27.,R3		;PUT SECTOR IN RANGE 1,26
;
;	RX11 FUNCTION INITIATOR
;
	MOV	(PC)+,(R4)	;SET THE FUNCTION
RXFUN:	.WORD	0		;READ OR WRITE COMMAND ON CORRECT UNIT
1$:	TSTB	(R4)		;WAIT FOR TRANSFER READY
	BEQ	1$		;WAIT
	BPL	RXERR1		;TR IS NOT UP, THATS AN ERROR
	MOV	R3,(R5)		;SET SECTOR FOR FLOPPY
2$:	TSTB	(R4)		;WAIT FOR TRANSFER READY
	BEQ	2$		;WAIT
	BMI	SECOK		;BRANCH IF TR UP, ELSE ERROR
RXERR1:	DEC	RXTRY		;SHOULD WE TRY AGAIN?
	BLT	RXERR		;BRANCH IF NO, RETRY COUNT EXPIRED
	MOV	#CSINIT,(R4)	;START A RECALIBRATE
	BR	RXINIT		;EXIT THROUGH START OPERATION CODE
SECOK:	MOV	R2,(R5)		;SET TRACK FOR FLOPPY
RXWAIT:	MOV	R3,INTINT	;INTINT >0 FOR PROCESS INTERRUPT ENTRY
	MOV	(SP)+,R3	;RESTORE THE REGS
	MOV	(SP)+,R2
	BIS	#CSINT,@RXCSA	;ENABLE FLOPPY INTERRUPTS, THIS SHOULD
				;CAUSE AN INTERRUPT WHEN DONE IS UP
RETURN:	RTS	PC		;RETURN, WE'LL BE BACK WITH AN INTERUPT
;
;	SETUP TO DO NEXT SECTOR
;
NXTSEC:	ADD	R3,BUFRAD	;UPDATE BUFFER ADDRESS
	INC	RXLSN		;BUMP LOGICAL SECTOR
	SUB	R3,BYTCNT	;REDUCE THE AMOUNT LEFT TO TRANSFER
	BHI	RETURN		;BRANCH IF WE ARE NOT DONE
	CLR	BYTCNT		;INIT FOR POSSIBLE SHORT WRITE
	BIT	#CSEBUF,RXFUN	;IS THIS A READ ?
	BNE	1$		;FOR .WRITE WE HAVE TO 0 TO THE END OF A BLOCK
	BIT	#3,RXLSN	;ARE WE AT 1ST SECTOR IN BLOCK?
	BNE	RETURN		;BRANCH IF NOT TO CONTINUE
1$:	TST	(SP)+		;POP RETURN ADDRESS FROM STACK
	INC	@(PC)+		;SET COMPLETION FLAG
RXSRET:	.WORD	0		;POINTER TO STATUS RETURN
RXDONE:	MOV	(SP)+,R3	;RESTORE REGS
	MOV	(SP)+,R2
	CLR	@RXCSA		;DISALBE FLOPPY INTERRUPTS
	RTS	PC
RXERR:	DEC	@RXSRET		;SET HARD ERROR FLAG
	BR	RXDONE		;STOP FLOPPY AND EXIT
;
;	RX11 SILO FILL / EMPTY
;
SILOFE:	MOV	(R0)+,EFBUF	;PUT CORRECT MOV INSTRUCTION IN FOR
				;EITHER FILLING OR EMPTYING RX BUFFER
	MOV	(R0)+,(R4)	;INITIATE FILL OR EMPTY BUFFER COMMAND
	MOV	(PC)+,-(SP)	;ASSUME MAXIMUM OF BYTCNT TO MOVE FROM BUFFER
BYTCNT:	.WORD	0		;THE BYTE COUNT IS KEPT HERE
	BEQ	ZFILL		;BRANCH IF SEEK OR SHORT WRITE
				;NOTE SEEK DOES THE EMPTY (TIME WASTER)
	CMP	(SP),R3		;NOW MAKE SURE COUNT IS 128 OR LESS
	BLOS	1$		;BRANCH IF (SP) IS 128 OR LESS
	MOV	R3,(SP)		;RESET COUNT TO 128
1$:	MOV	(PC)+,R2	;PUT THE BUFFER ADDRESS IN R2
BUFRAD:	.WORD	0		;THE BUFFER ADDRESS IS KEPT HERE
TRBYT:	TSTB	(R4)		;WAIT FOR TRANSFER READY
	BPL	TRBYT		;BRANCH IF TR NOT UP
EFBUF:	HALT			;INSTRUCTION TO MOV OR SLUFF DATA FROM
				;BUFFER GETS PLACED HERE
				;  MOVE DATA	    SLUFF DATA
				;MOVB (R2)+,(R5)     CLRB (R5)	   FILL
				;MOVB (R5),(R2)+     MOVB (R5),R2  EMPTY
	DEC	(SP)		;CHECK FOR COUNT DONE
	BGT	TRBYT		;STILL MORE TO TRANSFER
ZFILL:	MOV	(R0),EFBUF	;CHANGE MOV INSTRUCTION TO CORRECT
				;INSTR FOR SLUFFING DATA TO/FROM BUFFER
1$:	TSTB	(R4)		;WAIT LOOP
	BEQ	1$		;WAIT FOR SOME INDICATION (TR,DONE)
	BMI	EFBUF		;BRANCH IF TR CAME UP TO SLUFF DATA
	BIT	(R0)+,(SP)+	;BUMP R0 TO RETURN ADDR AND REMOVE JUNK
				;WORD FROM STACK LEAVING C BIT=0
	RTS	R0		;RETURN
DXINTS:	MOV	R4,-(SP)	;SAVE R4 ALSO
	CALL	(R5)		;RETURN WILL COME BACK HERE
	MOV	(SP)+,R4	;RESTORE REGS
	MOV	(SP)+,R5
	RTI			;EXIT FROM INTERRUPT
	.ENDC			;LOC$AV
	.IF NE	$ATEL
	.SBTTL	INTERRUPT VECTORS
	.ASECT
	.=0			;NONSENSE INTERRUPTS TRAP TO ERROR PROCESSOR
	.REPT	STACK/4
	.WORD	NONSI,0
	.ENDR
	.=34
	.WORD	ERR,0
	.=$AOTS			;NOTE HOW THIS CLEVERLY RUINS TRAP4 IN RSX11D !
	.WORD	$OTSVA
 
	.=$AOTSM
	.WORD	$OTSVA
	.=KBVEC
	.WORD	KBIINT,0
	.=DLVEC
	.WORD	DLIINT,340
	.WORD	DLOINT,0
	.=GRVEC
	.WORD	STPINT,0
	.WORD	LPINT,0
	.WORD	SOINT,0
	.WORD	SOINT,0
	.IF NE	LK$11
	.=PBVEC
	.WORD	PBINT,0
	.ENDC			;LK$11
	.IF NE	LOC$AV
	.=RXVEC
	.WORD	DXINT,340
	.ENDC			;LOC$AV
	.CSECT
	.ENDC			;$ATEL
	.IF NE	$ATEL!RT$11
	.SBTTL	SCROLLER
;
;	CARRIAGE RETURNER
;
CRLF:	MOV	#CR,R1		;OUTPUT A CR
	CALL	SCROLL
	MOV	#LF,R1		;NOW A LF
;
;	SCROLLER
;
SCROLL:	BIC	#177600,R1	;CLEAR EXTRANEOUS BITS
	BEQ	70$		;IGNORE NULLS
	MOV	R0,-(SP)	;SAVE R0
	.IF EQ	$ATEL
	MOV	R1,R0		;PUT CHAR WHERE SYS EXPECTS IT
	.TTYOU
	.IFF			;-$ATEL
	MOV	R2,-(SP)	;SAVE R2
	INCB	INSCRL		;INCREASE 'IN SCROLLER' DEPTH
5$:	CALL	SIS		;CALL SCROLLER PROPER
50$:	MOVB	SCLCHR,R1	;GET THE DL INT CHAR
	BEQ	60$		;NONE THERE
	CLRB	SCLCHR		;DELETE THE CHARACTER
	BR	5$		;OUTPUT IT BUT DON'T INC DEPTH
60$:	DECB	INSCRL		;DECREASE THE 'IN SCROLLER' DEPTH
	MOV	(SP)+,R2	;RESTORE R2
	.IFTF			;-$ATEL
	MOV	(SP)+,R0	;RESTORE R0
70$:	RTS	PC
	.IFF			;-$ATEL
;
;	SCROLLER INNER SANCTUM
;
SIS:	MOV	SCLPTR,R0	;POINT AT NEXT SPOT IN BUFFER
	CMPB	R1,#SPACE	;CTRL CHAR ?
	BGE	25$		;NO, ITS NORMAL
	CMPB	R1,#TAB		;TAB ?
	BNE	10$		;NO
5$:	MOV	#SPACE,R1	;YES, USE SPACES
	CALL	25$		;INSERT A SPACE
	BIT	#7,-(R2)	;IS COL COUNT 0 MOD 8 ?
	BNE	5$		;NO, OUTPUT ANOTHER TAB
	RTS	PC		;YES, TABBED
10$:	CMPB	R1,#CR		;CARRIAGE RETURN ?
	BEQ	25$		;YES, TREAT IT NORMALLY
	CMPB	R1,#BACKSP	;BACK SPACE ?
	BNE	20$		;NO
	CMP	R0,#SCLBUF	;AT THE FRONT OF THE BUFFER ?
	BHI	15$		;NO
	MOV	#SCLEND,R0	;YES, REVERSE WRAPARROUND
15$:	CMPB	-(R0),#LF	;IS CHAR TO BE RUBBED A LF ?
	BEQ	50$		;YES, DON'T DO IT
	CLRB	(R0)		;OK, RUB IT OUT
	DEC	COLCNT		;DEC COL COUNT
	BR	42$		;RETURN THORUGH COMMON CODE
20$:	CMPB	R1,#LF		;LINE FEED ?
	BEQ	55$		;YES
	MOV	R1,-(SP)	;NO, RANDOM CTL CHAR
	MOV	#UARROW,R1	;OUTPUT ^
	CALL	25$		;NOW
	MOV	(SP)+,R1	;RESTORE CHAR
	BIS	#CTL,R1		;PUT BACK CTL BIT
25$:	TSTB	(R0)		;IS NEXT CHAR FREE  ?
	BEQ	40$		;YES, OK FOR NOW
	MOV	R0,R2		;COPY POINTER
	TST	(R2)+		;SKIP  OVER SHIFT OUT / RUB OUT
	CMP	R2,#SCLEND	;AT THE END ?
	BLO	30$		;NO
	MOV	#SCLBUF,R2	;YES, RESET IT
30$:	CMP	R2,SCLST	;HAVE WE FILLED THE BUFFER ?
	BNE	35$		;NO
	CALL	60$		;YES, SCROLL AWAY THE TOP LINE
35$:	MOV	(R0),(R2)	;COPY DOWN THE SO/RO
	CLR	(R0)		;AND NOW FREE IT FOR NEW CHARS
40$:	MOVB	R1,(R0)+	;PUT IN THE CHAR
	INC	COLCNT		;BUMP COL COUNTER
42$:	MOV	#SCLPTR,R2	;POINT AT SCLPTR
	CMP	R0,#SCLEND	;REACHED THE END YET ?
	BLO	45$		;NO
	MOV	#SCLBUF,R0	;YES, WRAP ARROUND
45$:	MOV	R0,(R2)		;SAVE NEW SCROLLER POINTER
50$:	RTS	PC		;DONE
55$:	CALL	25$		;OUTPUT LINE FEED
	CLR	R1		;FOLLOWED BY NULL
	CALL	25$		;INCASE ODD LENGTH LINE
	CLR	-(R2)		;CLEAR COL COUNTER (R2 LEFT AT SCLPTR)
	INC	-(R2)		;BUMP LINE COUNT
	CMP	(R2),-(R2)	;> MAX LINES ?
	BLT	80$		;NO, DON'T SCROLL
60$:	MOV	R1,-(SP)	;SAVE R1
	MOV	SCLST,R1	;POINT AT FIRST LINE
65$:	CMPB	(R1)+,#LF	;END OF TOP LINE ?
	BEQ	70$		;YES
	CMP	R1,#SCLEND	;PHYSICAL END OF BUFFER YET ?
	BLO	65$		;NO, KEEP LOOKING
	MOV	#SCLBUF,R1	;YES, START LOOKING AT THE FRONT
	BR	65$
70$:	INC	R1		;MAKE THE POINTER EVEN
	BIC	#1,R1		;SINCE ALL LINES END ON A WORD
	CMP	R1,#SCLEND	;PAST THE END ?
	BLO	75$		;NO
	MOV	#SCLBUF,R1	;YES, RESET
75$:	MOV	R1,SCLST	;SAVE THE NEW TOP LINE POINTER
	MOV	(SP)+,R1	;RESTORE R1
	DEC	LINCT		;BACK DOWN THE LINE COUNT
80$:	RTS	PC
	.ENDC			;-$ATEL
	.ENDC			;$ATEL!RT$11
	.IF NE	$ATEL
	.SBTTL	STARTUP
;
;	SATELLITE STARTUP
;
$$SATR:	MOV	THPTR,R4	;THREADED CODE POINTER ADDRESS
;
;	$OTI -- F4 INITIALIZATION ROUTINE
;		CALLED VIA:
;		JSR	R4,$OTI
;		.WORD	<POINTER TO THREADED CODE>
;
$OTI:
$$SAT:	RESET			;RESET UNIBUS
	MOV	R4,THPTR	;SAVE THREADED CODE POINTER ADDRESS
	MOV	(R4),R4		;ADDR OF THREADED CODE START
	MOV	#STACK,SP	;SETUP STACK POINTER
	MOV	#SCLBUF,R0	;ADDRESS OF SCROLLER BUFFER
	MOV	R0,SCLST	;SET TOP LINE POINTER TO START OF BUFR
	MOV	#SCLPTR,R1	;POINT TO SCROLLER INSERT POINTER
	MOV	R0,(R1)		;PUT IN ADDRESS OF START OF BUFFER
	MOV	(PC)+,(R0)	;PUT IN INITIAL SHIFTOUT/RUBOUT
	.BYTE	SHFTOU,RUBOUT
	CLR	-(R1)		;CLEAR COLUMN COUNTER
	CLR	-(R1)		;ZERO INITIAL LINE COUNT
	MOV	#SSCRN/CHRHT-1,-(R1) ;INITIAL MAX LINE COUNT
	MOV	#SSCRN-CHRHT,@-(R1) ;SET TOP OF SCREEN (ASSUME VR14)
	MOV	#DPC,R3		;POINT AT DPC
	MOV	#SIZER,(R3)+	;EXECUTE SCREEN SIZER DISPLAY LIST
5$:	TST	(R3)		;DPU HALTED YET ?
	BPL	5$		;NO
	BIT	#EDGEF,(R3)	;EDGE FLAG SET ?
	BNE	6$		;YES, MUST BE SMALL SCREEN
	ADD	#BSCRN-SSCRN,@(R1)+ ;NO, INCREASE SCREEN TOP (VR17)
	MOV	#BSCRN/CHRHT-1,(R1) ;SET NEW SCROLLER MAX LINE COUNT
6$:	MOV	#BUFST+2,BUFST	;DJMP TO A DHALT AFTER DELAY LIST
	CLR	HLTFLG		;CLEAR THE HALT FLAG
	MOV	RESTRT,-(R3)	;START UP THE DPU IN THE DELAY LIST
	CLR	$SEQC		;CLEAR F4 OTS SEQ NUMBER
	CLR	LASTMN		;CLEAR LAST MESSAGE NUMBER
	CLR	$NAMC		;CLEAR F4 OTS NAME POINTER
	CLR	SCLCHR		;CLEAR IN SCROLLER FLAG
	CLR	DLYMOD		;CLEAR DELAY MODE FLAG
	.IF NE	LK$11
	CLR	PBLCTL		;CLEAR LIGHT CONTROL FLAG FOR LK11
	.ENDC			;LK$11
	CLRB	KBMODE		;HOST COMMUNICATION MODE
	CALL	CURFLP		;MAKE THE CURSOR MATCH
	CLR	MOMOD		;CLEAR MESSAGE OUTPUT MODE FLAG
	.IF NE	DEBUG
	CLR	MIMOD		;CLEAR FLAG TO AVOID ERROR HALT
	.ENDC			;DEBUG
	CALL	RECMSG		;INITIATE A MESSAGE READ
	BIS	#100,@#DLICSR	;ENABLE DL11 INPUT INTERRUPTS
	.IF NE	LK$11
	MOV	#PBOBUF,R0	;POINT AT LIGHT REG
	CLR	(R0)		;TURN OFF LIGHTS
	CLR	-(R0)		;TURN OFF BUTTONS
	BIS	#40000,-(R0)	;ENABLE LK11 INTERRUPTS
	.ENDC			;LK$11
	BIS	#100,@#KBCSR	;ALLOW KEYBOARD INTERRUPTS
	.IF NE	DEBUG
	MOV	#D$OOS,R0	;POINT AT ERROR REPORTING SPACE
10$:	CLR	(R0)+		;CLEAR ERROR REPORTING AREA
	CMP	R0,#JUNK	;DONE YET ?
	BLO	10$		;NO
	MOV	#JUNKB,(R0)	;YES, RESET JUNK POINTER
	.ENDC			;DEBUG
	JMP	@(R4)+		;START FORTRAN THREADED CODE
	.ENDC			;$ATEL
	.IF NE	$ATEL
	.SBTTL	ERROR HANDLING
;
;	ERROR HANDLER
;
ERR:	MOV	(SP),R4		;GET PC AFTER TRAP
	MOV	-(R4),R4	;GET TRAP CALL
	SUB	#TRAP+128.,R4	;REMOVE UNINTERSESTING BITS
	BEQ	OURERR		;IF 0, JUST DO A TRACEBACK
	BPL	ERR63		;POS IS NORMAL FORTRAN ERROR
	ADD	#128.+200.,R4	;TRANSLATE OTHERS INTO RANGE > 200.
ERR63:	MOV	#EMSG,R3	;PRINT INTRO PART OF ERROR MESSAGE
	CALL	MESSAG		;PRINT SOME CHARS
	CALL	DECOUT		;OUTPUT ERROR NUMBER
	CALL	CRLF		;OUTPUT CR/LF
OURERR:	CALL	UNLINK		;UNHOOK DFILE FROM SCROLLER
	MOV	#IN,R3		;PRINT MESSAGE LINE OF FORM
	CALL	MESSAG		;IN   ROUTINE -XXXXXX- LINE YY
	CALL	PLINE		;PRINTS REST OF LINE
FATAL:	MOV	$NAMC,R2	;GET LAST SUBR LINK
	BEQ	ABORT		;END OF TRACEBACK WHEN 0
	MOV	6(R2),$NAMC	;BACK UP ONE SUBR LEVEL
	MOV	4(R2),$SEQC	;NAME POINTER AND SEQ NUMBER
	MOV	#FROM,R3	;PRINT LINE OF FORM
	CALL	MESSAG		;FROM ROUTINE -XXXXXX- LINE YY
	CALL	PLINE
	BR	FATAL		;GO THROUGH'EM ALL
MESSAG:	MOVB	(R3)+,R1	;GET NEXT CHAR OF MSG
	BEQ	RET		;BRANCH IF AT END
	CALL	SCROLL		;OUTPUT TO SCROLLER
	BR	MESSAG		;LOOP
PLINE:	MOV	#ROUT,R3	;SET UP TO PRINT 'ROUTINE -'
	CALL	MESSAG		;PRINT IT
	MOV	$NAMC,R3	;GET POINTER TO NAME
	BNE	1$		;BRANCH IF NOT AT TOP LEVEL
	MOV	(PC)+,-(SP)	;FUDGE TO PRINT .MAIN.
	.RAD50	/IN./
	MOV	(PC)+,R1
	.RAD50	/.MA/
	BR	2$
1$:	MOV	(R3)+,-(SP)	;PUT 1 WORD OF NAME ON STACK
	MOV	(R3),R1		;PUT SECOND WORD IN R1 (NAME IS BACKWARDS)
2$:	CALL	PUTNAM		;OUTPUT 3 RAD50 CHARS
	MOV	(SP)+,R1	;GET SECOND HALF
	CALL	PUTNAM
	MOV	#LIN,R3		;SETUP UP TO OUTPUT LINE NUMBER
	CALL	MESSAG
	MOV	$SEQC,R4	;GET CURRENT LINE NUMBER
	BNE	3$		;BRANCH IF IT EXISTS
	MOV	#'?,R1		;FLAG LACK OF ISNS
	CALL	SCROLL		;OUTPUT CHAR
	BR	CRLFX		;OUTPUT THE CRLF
3$:	CALL	DECOUT		;OUTPUT THE DIGITS
	BR	CRLFX		;OUTPUT CRLF
RET:	RTS	PC
DECOUT:	MOV	R4,-(SP)	;DECIMAL OUTPUT RTNE
	CLR	R4
1$:	INC	R4
	SUB	#10.,(SP)
	BGE	1$
	ADD	#ZERO+10.,(SP)
	DEC	R4
	BEQ	2$
	CALL	DECOUT
2$:	MOV	(SP)+,R1
	JMP	SCROLL
BADDIV:	MOV	R1,R3		;ENTER WITH NUM IN R1
	CLR	R1		;REM IN R3
2$:	CMP	R2,R3		;NUM IN R3
	BHI	RET		;DEN IN R2
	SUB	R2,R3		;QUO IN R1
	INC	R1
	BR	2$
PUTNAM:	MOV	#50,R2		;SET UP FOR RAD50 UNPACK
	CALL	BADDIV		;DO THE SLOW DIVIDE
	MOV	R3,-(SP)	;SAVE LOW CHAR
	CALL	BADDIV		;GET NEXT 2
	MOV	R3,-(SP)	;SAVE THE NEXT
	MOV	#3,R3		;SETUP TO OUTPUT 3 CHARS
2$:	MOVB	CONVTB(R1),R1	;GET THE CHAR
	CALL	SCROLL
	DEC	R3
	BEQ	RET
	MOV	(SP)+,R1	;GET NEXT CHAR
	BR	2$
CRLFX:	JMP	CRLF		;OUTPUT A CR/LF THEN RTS PC
;
;	UNDECIPHERABLE INTERRUPTS
;
NONSI:	MOV	#63.,R4		;ERROR CODE FOR NONSENSE INTERRUPTS
	JMP	ERR63		;ENTER ERROR PROCESSOR
;
;	PAUSE
;
PSE$:	JMP	@(R4)+		;PAUSE SIMPLY RETURNS
;
;	ABORT HOST ON ERROR OR ^H^C
;
ABORT:	BIC	#100,@#DLOCSR	;DISABLE DL OUTPUT INTERRUPTS
	BIC	#100,@#DLICSR	;AND DL INPUT INTERRUPTS
	.IF NE	R$X11D!IA$
	MOV	#<MAXMSG+HSIZE+5>*4/3*TRIES,R0 ;MAX NUMBER OF CHARS TO SEND
	.IFF			;R$X11D!IA$
	MOV	#<MAXMSG+HSIZE+3>*TRIES,R0 ;MAX NUMBER OF CHARS TO SEND
	.ENDC			;R$X11D!IA$
10$:	TSTB	@#DLOCSR	;IS CHAR SENT YET ?
	BPL	10$		;NO
	.IF NE	CWAIT
	MOV	#CWAIT,R1	;DELAY TIME PER CHARACTER
	CALL	WAITX		;WAIT SOME
	.ENDC			;CWAIT
	MOVB	#RUBOUT,@#DLOBUF ;SEND ANOTHER (FORCE COM FAILURE)
	DEC	R0		;SEND MORE ?
	BNE	10$		;YES
;
;	EXITS FROM FORTRAN
;
BAH$:				;EXIT POINTS
FOO$:
STP$:
EXIT$:
$EXIT:	MOV	#10000.,R1	;WAIT ONE SECOND
	CALL	WAITX
	MOV	#MSG,R3		;POINT AT EXIT MESSAGE
	CALL	MESSAG		;OUTPUT IT
	MOV	#KBMODE,R0	;POINT AT KEYBOARD MODE WORD
	MOVB	#-1,(R0)	;ENTER SATELLITE KEYBOARD MODE
	CALL	CURFLP		;FLIP CURSOR
	CLRB	-(R0)		;CLEAR PREVIOUS CHAR
10$:	MOVB	(R0),R1		;GET CURRENT CHAR
	BEQ	10$		;NONE YET
	CLRB	(R0)		;CLEAR CHAR BUFFER
	CMPB	R1,#CR		;CR TYPED ?
	BNE	10$		;NO, IT DOESN'T COUNT
	JMP	$$SATR		;DONE,  RESTART SATELLITE
	.ENDC			;$ATEL
	.IF NE	HO$AT&<1-$ATEL>
	.SBTTL	SEND MESSAGE TO SATELLITE
;
;	CREATE MESSAGE FOR SENDING TO SATELLITE
;
TOSAT:	MOV	#MOMSG+1,R0	;POINT TO MESSAGE BUFFER
	MOV	(R5)+,-(SP)	;PUSH ARG COUNT
	CLRB	1(SP)		;CLEAR OUT UPPER BYTE
	MOVB	@(R5)+,(R0)+	;MOVE IN CODE BYTE
	MOV	@(R5)+,R1	;NUMBER OF MANDATORY ARGS
10$:	SUB	#2,(SP)		;MORE ARGS IN CALL ?
	BLE	50$		;NO, MSG. DONE
	DEC	R1		;ANY MORE MANDATORY ARGS TO DO ?
	BLT	30$		;NO
	MOV	@(R5)+,R2	;NUMBER BYTES IN ARG
	MOV	(R5)+,R3	;ADDRESS OF ARG
20$:	MOVB	(R3)+,(R0)+	;MOVE ONE BYTE
	DEC	R2		;MORE ?
	BGT	20$		;YES
	BR	10$		;DO NEXT ARG
30$:	MOV	@(R5)+,R1	;NUMBER OF OPTIONS SUPPLIED AT UPPER LEVEL
	DEC	(SP)		;DECR OUR ARG COUNT
	BLE	50$		;NONE LEFT
35$:	MOV	@(R5)+,R2	;SIZE OF ARG
	MOV	(R5)+,R3	;ADDRESS OF OPTION
	MOV	(R5)+,R4	;ADDRESS OF DEFAULT
	DEC	R1		;MISSING TRAILING OPTION ?
	BLT	40$		;YES, USE DEFAULT
	CMP	R3,#-1		;SKIPPED OPTION ?
	BEQ	40$		;YES, USE DEFAULT
	MOV	R3,R4		;OPTION SUPPLIED, USE IT
40$:	MOVB	(R4)+,(R0)+	;MOVE BYTE OF OPTION
	DEC	R2		;MORE ?
	BGT	40$		;YES
	SUB	#3,(SP)		;ANY MORE TRIPLES ?
	BGT	35$		;YES
50$:	TST	(SP)+		;CLEAN STACK
	MOV	#MOMSG+1,R1	;POINT AT CREATED MESSAGE
	SUB	R1,R0		;LENGTH OF IT
	BR	TWOSAT		;OUTPUT IT
;
;	SEND MESSAGE TO SATELLITE
;
TOOSAT:	TST	(R5)+		;SKIP ARG COUNT
	MOV	@(R5)+,R0	;GET BYTE COUNT
	MOV	(R5)+,R1	;AND MESSAGE ADDRESS
TWOSAT:	CALL	SATATT		;ATTACH TI:
	MOV	#MOHDR+SYNCT,R5	;POINT AT MESSAGE HEADER (AFTER SYNS)
	INC	R0		;INC MESSAGE SIZE (DATCOD BYTE)
	MOVB	R0,1(R5)	;INTO MESSAGE HEADER
	MOV	#HSIZE-SYNCT-2,R4 ;NUMBER OF BYTES TO CRC
	CALL	BLDCRC		;COMPUTE THE CRC
	MOVB	R3,(R5)+	;FIRST CRC BYTE INTO HEADER
	SWAB	R3
	MOVB	R3,(R5)+	;SECOND CRC BYTE INTO HEADER
	MOV	R5,R2		;COPY START ADDR OF DATA PORTION
	MOVB	MSGNUM,(R2)	;GET CURRENT MESSAGE NUMBER
	INC	MSGNUM		;INCREMENT IT FOR NEXT TIME
	BICB	#CODEF,(R2)	;CLEAR OUT CODE FIELD
	BISB	#DATCOD,(R2)+	;PUT IN DATA CODE
	CMP	R1,R2		;IS MESSAGE ALREADY IN PLACE ?
	BEQ	15$		;YES (CAME FROM TOSAT)
	MOV	R0,R4		;COPY THE BYTE COUNT
10$:	MOVB	(R1)+,(R2)+	;COPY IN THE 'REAL' DATA
	DEC	R4		;MORE ?
	BGT	10$		;YES  (MOVES ONE BYTE TOO MANY)
15$:	MOV	R0,R4		;GET NUMBER OF BYTES TO CRC
	CALL	BLDCRC		;COMPUTE THE CRC
	MOVB	R3,(R5)+	;PUT IN THE FIRST BYTE
	SWAB	R3		;THEN ..
	MOVB	R3,(R5)+	;THE SECOND
	ADD	#HSIZE+2,R0	;ADD OVERHEAD BYTE COUNT
	MOV	#TRIES,TRYCNT	;RETRY COUNT
20$:	CLEF$S	#MSGF		;CLEAR THE MESSAGE IN FLAG
	CLEF$S	#TIMF		;CLEAR THE TIME OUT FLAG
	QIO$S	#IO.WAL,#LUNTT,,,#IOSB,,<#MOHDR,R0,#0> ;OUTPUT MESSAGE
	.IF NE	R$X11D!IA$
	QIO$S	#IO.RAL!IO.RNE,#LUNTT,#MSGF,,#IOSB+4,,<#MIHDR,#HSIZE+3*4/3> ;READ THE ACK
	.IFF			;R$X11D!IA$
	QIO$S	#IO.RAL,#LUNTT,#MSGF,,#IOSB+4,,<#MIHDR,#HSIZE+3> ;READ THE ACK
	.ENDC			;R$X11D!IA$
	MRKT$S	#TIMF,#TWAIT,#2	;MARK TIME
	WTLO$S	GTFMF,#TFMF	;WAIT FOR EITHER TIMEOUT OR MSG IN
	CLEF$S	#TIMF		;CLEAR THE TIMER FLAG
	CMP	$DSW,#IS.SET	;WAS IT A TIMEOUT ?
	BNE	30$		;NO, MESSAGE IN
	CLEF$S	#KILLF		;CLEAR KILL FLAG
	QIO$S	#IO.KIL,#LUNTT,#KILLF,,#IOSB+4 ;KILL THE READ
	WTSE$S	#KILLF		;WAIT FOR THE KILL
	WTSE$S	#MSGF		;ALSO WAIT FOR THE READ TO DIE
25$:	DEC	TRYCNT		;TRY AGAIN ?
	BLE	26$		;NO, QUIT
	JMP	20$		;YES
26$:	CALL	EXITER		;SEND EXIT MESSAGE
30$:	CMKT$S			;CANCEL THE MARK TIME
	.IF NE	R$X11D!IA$
	MOV	#HSIZE+3,R5	;SIZE OF INPUT
	CALL	FIX		;TRANSLATE TO REAL BYTES
	.ENDC			;R$X11D!IA$
	MOV	#MIHDR+SYNCT,R5	;POINT AT MESSAGE HEADER
	MOV	#HSIZE-SYNCT,R4	;LENGTH IN BYTES (INCLUDING CRC)
	CALL	BLDCRC		;COMPUTE CRC
	TST	R3		;IS IT 0 ?
	BNE	25$		;NO, ERROR
	MOV	#3,R4		;SIZE OF DATA (ACK,CRCL,CRCH)
	CALL	BLDCRC		;CRC IT
	TST	R3		;ZERO CRC ?
	BNE	25$		;NO, ERROR
	CMPB	MIMSG,#ACKCOD	;WAS IT AN ACK ?
	BNE	25$		;NO, RETRY SENDING
	RTS	PC
	.ENDC			;HO$AT&<1-$ATEL>
	.IF NE	HO$AT&<1-$ATEL>
	.SBTTL	RECIEVE MESSAGE FROM SATELLITE
;
;	RECIEVE MESSAGE FROM SATELLITE
;
FRSAT:	CALL	SATATT		;ATTACH TI:
	MOV	R5,-(SP)	;SAVE ARG LIST POINTER
	MOVB	(R5)+,R4	;GET ARG COUNT
	ASR	R4		;ARG PAIR COUNT (IGNORES FIRST ARG)
	INC	R5		;SKIP DEC'S RESERVED BYTE
	CLR	R3		;MESSAGE SIZE WILL GO HERE
5$:	TST	(R5)+		;SKIP ANOTHER WORD
	ADD	@(R5)+,R3	;ADD SIZE OF THIS ARG
	DEC	R4		;ANY MORE PAIRS ?
	BGT	5$		;YES KEEP COUNTING
	MOVB	R3,ASKS		;SEND SIZE OF DESIRED DATA WITH ASK
	ADD	#HSIZE+3,R3	;ADD HEADER SIZE + MSG CODE + DATA CRC
	MOV	R3,MSIZE	;SAVE MESSAGE SIZE
	.IF NE	R$X11D!IA$
	MOVB	X1.3(R3),MSIZE+2 ;MULTIPLY BY 4/3 TO GET SIZE OF READ
	.ENDC			;R$X11D!IA$
	MOV	#TRIES,TRYCNT	;SET RETRY COUNT
	MOVB	#ASKCOD,ASKC	;RESET ASK CODE
10$:	MOV	#ASKMSG+SYNCT,R5 ;POINT AT ASK MESSAGE
	MOV	#HSIZE-SYNCT-2,R4 ;HEADER SIZE LESS SYNS LESS 2 FOR CRC
	CALL	BLDCRC		;COMPUTE CRC
	MOVB	R3,(R5)+	;FIRST CRC BYTE
	SWAB	R3
	MOVB	R3,(R5)+	;SECOND CRC BYTE
	MOV	#2,R4		;NOW DO DATA SECTION
	CALL	BLDCRC		;COMPUTE CRC
	MOVB	R3,(R5)+	;CRC LOW
	SWAB	R3
	MOVB	R3,(R5)+	;CRC HIGH
	MRKT$S	#TIMF,#TWAIT,#2	;MARK TIME
11$:	CLEF$S	#TIMF		;CLEAR TIME OUT FLAG
	CLEF$S	#MSGF		;CLEAR MESSAGE FLAG
	QIO$S	#IO.WAL,#LUNTT,,,#IOSB,,<#ASKMSG,#HSIZE+4,#0> ;SEND ASK MESSAGE
	.IF NE	R$X11D!IA$
	QIO$S	#IO.RAL!IO.RNE,#LUNTT,#MSGF,,#IOSB+4,,<#MIHDR,MSIZE+2> ;READ THE MESSAGE
	.IFF			;R$X11D!IA$
	QIO$S	#IO.RAL,#LUNTT,#MSGF,,#IOSB+4,,<#MIHDR,MSIZE> ;READ THE MESSAGE
	.ENDC			;R$X11D!IA$
	WTLO$S	GTFMF,#TFMF	;WAIT FOR TIMEOUT OR MESSAGE IN
	CLEF$S	#TIMF		;CLEAR TIMEOUT FLAG
	CMP	$DSW,#IS.SET	;WAS IT A TIMEOUT ?
	BNE	15$		;NO
	CLEF$S	#KILLF		;CLEAR THE KILL FLAG
	QIO$S	#IO.KIL,#LUNTT,#KILLF,,#IOSB ;KILL REQUESTS
	WTSE$S	#KILLF		;WAIT FOR KILL
	WTSE$S	#MSGF		;ALSO WAIT FOR READ TO DIE
12$:	MOVB	#RPTCOD,ASKC	;CHANGE CODE TO REPEAT
	DEC	TRYCNT		;TRY AGAIN ?
	BLE	13$		;NO, QUIT
	JMP	10$		;YES
13$:	CALL	EXITER		;SEND EXIT MESSAGE
15$:	CMKT$S			;CANCEL MARK TIME
	.IF NE	R$X11D!IA$
	MOV	MSIZE,R5	;GET SIZE OF MESSAGE (AFTER UNSCRAMBLE)
	CALL	FIX		;FIX UP MESSAGE
	.ENDC			;R$X11D!IA$
	MOV	#MIHDR+SYNCT,R5	;POINT AT HEADER JUST INPUT
	MOV	#HSIZE-SYNCT,R4	;SIZE OF HEADER LESS SYNS
	CALL	BLDCRC		;COMPUTE THE CRC
	TST	R3		;WAS IT 0
	BNE	12$		;NO, RETRY
	MOV	#MIMSG,R5	;POINT AT INPUT MESSAGE
	MOVB	MISIZE,R4	;GET SIZE OF INPUT MESSAGE
	ADD	#2,R4		;PLUS 2 CRC BYTES
	CALL	BLDCRC		;COMPUTE THE CRC
	TST	R3		;WAS IT ZERO ?
	BNE	12$		;NO, RETRY
	MOV	#MIMSG,R0	;POINT AT THE DATA
	CMPB	(R0)+,#DATCOD	;CORRECT MESSAGE TYPE ?
	BEQ	100$		;YES, TAKE IT APART
	CMPB	-(R0),#DLYCOD	;DLY CODE ?
	BNE	12$		;NO, ERROR
	JMP	11$		;Q ANOTHER READ WITH NO TIMEOUT
100$:	MOV	(SP)+,R5	;RESTORE ARG  POINTER
	MOVB	(R5)+,R1	;NUMBER OF ARGS
	ASR	R1		;NUMBER OF ARG PAIRS (NOTE HOW WE LOSE BIT 0)
	INC	R5		;SKIP A BYTE
	MOV	@(R5)+,R2	;NUMBER OF ARG PAIRS TO USE (SOME OPTS)
	CMP	R2,R1		;FEWER PAIRS THAN MAX ?
	BGE	110$		;NO, ALL OPTS SPECIFIED
	MOV	R2,R1		;YES, SOME TRAILING OPTS MISSING
110$:	MOV	@(R5)+,R2	;SIZE OF ARG
	MOV	R2,R4		;SAVE IT
	MOV	(R5)+,R3	;ARG ADDRESS
	CMP	R3,#-1		;MISSING OPTION ?
	BNE	120$		;NO
	ADD	R2,R0		;YES, SKIP INPUT FOR THIS ARG
	BR	130$		;TEST FOR MORE PAIRS
120$:	MOVB	(R0)+,(R3)+	;MOVE A BYTE
	DEC	R2		;MORE ?
	BGT	120$		;YES
	BIT	#1,R4		;WAS IT AN ODD NUMBER ?
	BEQ	130$		;NO
	CLRB	(R3)+		;YES, CLEAR ANOTHER BYTE
130$:	DEC	R1		;MORE ARG PAIRS ?
	BGT	110$		;YES
140$:	RTS	PC
	.ENDC			;HO$AT&<1-$ATEL>
	.IF NE	HO$AT&<1-$ATEL>
	.SBTTL	HOST COMMUNICATION SUBROUTINES
;
;	COMPUTE A CRC
;
BLDCRC:	CLR	R3		;CRC WILL WIND UP HERE
110$:	MOVB	(R5)+,R2	;GET NEXT BYTE
	MOV	#8.,-(SP)	;8 BITS PER BYTE
120$:	CLC			;EMPTY THE CARRY BIT
	ROR	R3		;SHIFT OLD PARTIAL
	ROR	R2		;SHIFT CHAR
	BVC	130$		;XOR POLYNOMIAL
	MOV	#POLY,-(SP)	;POLY TO STACK
	BIC	R3,(SP)		;.NOT.PARTIAL.AND.POLYNOMIAL
	BIC	#POLY,R3	;.NOT.POLYNOMIAL.AND.PARTIAL
	BIS	(SP)+,R3	;POLYNOMIAL.XOR.PARTIAL
130$:	DEC	(SP)		;MORE BITS ?
	BGT	120$		;YES
	TST	(SP)+		;REMOVE BIT COUNT
	DEC	R4		;MORE BYTES ?
	BGT	110$		;YES
	RTS	PC		;NO, RETURN
;
;	ATTACH SATELLITE (TI:)
;
SATATT:	TST	(PC)+		;IS TI: ATTACHED ?
1$:	.WORD	0		;TI: ATTACHED FLLAG
	BNE	5$		;YES
	QIO$S	#IO.ATT,#LUNTT	;NO, ATTACH IT
	INC	1$		;SET THE FLAG
5$:	RTS	PC
	.IF NE	R$X11D!IA$
;
;	FIX UP A LINE (TRANSLATE TO 8 BIT BYTES)
;
FIX:	MOV	#MIHDR,R0	;POINT AT INPUT ASCII STRING
	MOV	R0,R1		;TWO POINTERS
10$:	MOVB	(R0)+,(R1)	;MOVE IN FIRST 6 BIT CHAR
	MOVB	(R0)+,R2	;GET SECOND 6 BIT CHARACTER
	MOVB	(R0)+,R4	;GET THIRD 6 BIT CHAR
	ASLB	R4		;WASTE TWO BITS OF THIRD 6 BIT CHAR
	ASLB	R4
	ASLB	R4		;THIS STUFF IS TOO COMPLICATED TO COMMENT
	ROLB	R2		;SO JUST TRUST ME
	ASLB	R4
	ROLB	R2
	ASLB	R4
	ROLB	R2
	ROLB	(R1)
	ASLB	R4
	ROLB	R2
	ROLB	(R1)+
	MOVB	R2,(R1)+
	MOVB	(R0)+,(R1)
	BICB	#300,(R1)
	BISB	R4,(R1)+
	SUB	#3,R5		;MORE 8 BIT CHARS ?
	BGT	10$		;YES
	RTS	PC
	.ENDC			;R$X11D!IA$
;
;	EXIT AND CAUSE SAT TO STOP
;
EXITER:	QIO$S	#IO.WLB,#LUNTT,#TTEF,,#IOSB,,<#COMERR,#CESIZE,#40>
	WTSE$S	#TTEF		;WAIT FOR MESSAGE
	TRAP	129.		;INITIATE TRACEBACK
	.ENDC			;HO$AT&<1-$ATEL>
	.IF NE	$ATEL!RT$11
	.SBTTL	LINK, UNLINK, STOP, CONT, GRWAIT, TRAP0
;
;	LINK DISPLAY BUFFER TO VT11/VS60 DRIVER
;
LINK:	TST	(R5)+		;SKIP OVER ARG COUNT
	MOV	(R5)+,R0	;GET BUFFER START ADDRESS
	CLR	(R0)		;CLEAR LOCK
	MOV	#LPADR,R4	;POINT AT POINTERS LIST
	MOV	R0,(R4)+	;SAVE ADDRESS OF LP STUFF
	ADD	#BFHDR,R0	;GET BUFFER ADDRESS
	MOV	R0,(R4)+	;SAVE IT FOR START, STOP, CONT
	MOV	@(R5)+,R1	;GET BUFFER LENGTH
	.IF EQ	$ATEL
	CLR	@(R5)+		;CLEAR SUCCESS FLAG
	CMP	(R4),#DELAY	;LINKED ALREADY ?
	BNE	40$		;YES, RETURN SUCCESS
	MOV	@#RMON,R1	;ADDRESS OF RMON
	ADD	#DISP,R1	;ADDRESS OF CONFIGURATION WORD
	BIT	#GOTVT,(R1)	;VT11/VS60 HARDWARE ?
	BEQ	50$		;NO, FAILURE
	MOV	2(R1),R3	;ADDRESS OF SCROLLER (IF PRESENT)
	BEQ	40$		;NO SCROLLER
	BIT	#VTLINK,(R1)	;IS ANOTHER JOB LINKED ?
	BNE	50$		;YES, FAILURE
	BIS	#VTLINK,(R1)	;ITS OURS NOW
	MOV	SCLINK(R3),R2	;START OF SCROLLER BUFFER
	MOV	R2,STSCRL	;PUT IT INTO SCROLLER FIX UP LIST
	MOV	-6(R2),FIXSCY	;ALSO COPY IN THE TOP OF SCREEN VALUE
	MOV	#FIXSCL,(R4)	;ENTER FIX UP LIST AFTER USER'S BUFFER
	MOV	#DELAY,SCLINK(R3);HAVE SCROLLER RESTART US AFTER SO INT
40$:	.DEVIC	#AREA,#KILLER	;VT11/VS60/LK11 STOPPER ON EXIT
	MOV	#GRVEC,R2	;ADDRESS OF VECTORS
	MOV	#340,R1		;PRIORITY 7
	.PROTEC	#AREA,R2	;PROTECT THE VECTOR
	BCS	50$		;ALREADY IN USE
	MOV	#STPINT,(R2)+	;PUT IN STOP INTERRUPT HANDLER
	MOV	R1,(R2)+	;PRI 7
	.PROTEC	#AREA,R2	;PROTECT IT
	BCS	50$		;IN USE
	MOV	#LPINT,(R2)+	;LPEN INTERRUPT
	MOV	R1,(R2)+	;PRI 7
	TST	R3		;SCROLLER ?
	BNE	45$		;YES, IT HANDLES SHIFT OUT INTERRUPTS
	.PROTEC	#AREA,R2	;PROTECT IT
	BCS	50$		;IN USE
	MOV	#SOINT,(R2)+	;NO, HANDLE 'EM HERE
	MOV	R1,(R2)		;PRI 7
	.IF NE	LK$11
	MOV	#PBVEC,R2	;LK11 VECTOR
	.PROTEC	#AREA,R2	;PROTECT IT
	MOV	#PBINT,(R2)+	;POINT AT INTERRUPT SERVICE
	MOV	R1,(R2)		;PRI 7
	MOV	#PBOBUF,R2	;POINT AT LIGHT REG
	CLR	(R2)		;TURN OFF LIGHTS
	CLR	-(R2)		;TURN OFF BUTTONS
	BIS	#40000,-(R2)	;ENABLE LK11 INTERRUPTS
	.ENDC			;LK$11
45$:	INC	@-(R5)		;SET FLAG
	.IFF			;-$ATEL
	INC	@(R5)+		;SET FLAG
	.IFTF			;-$ATEL
	CLR	HLTFLG		;CLEAR THE PLEASE HALT FLAG
	MOV	BADR,BUFST	;POINT AT BUFFER
	.IFT			;-$ATEL
	MOV	(R4),@#DPC	;START IT
	.IFTF			;-$ATEL
50$:	RTS	PC		;DONE
	.IFT			;-$ATEL
	.ENABL	LSB
;
;	VT11/VS60 STOPPER ON .EXIT OR CTL/C
;
KILLVT:	.INTENT	4		;ENTER UNLINK ROUTINE TO STOP VT11/VS60
	BR	10$
	.IFTF			;-$ATEL
;
;	UNLINK FROM DRIVER
;
UNLINK:
	.IFT			;-$ATEL
	JSR	PC,STOP		;STOP THE DPU
10$:
	.IF NE	V$60
	MOV	#CONRE,@#DPC	;EXECUTE DPU RESET LIST
20$:	CMP	@#DPC,#CRDONE	;DONE ?
	BNE	20$		;NO
	.ENDC			;V$60
	.IF NE	LK$11
	CLR	@#PBCSR		;DSIABLE LK11 INTERRUPTS
	.ENDC			;LK$11
	MOV	@#RMON,R5	;RMON ADDRESS
	MOV	DISP+2(R5),R4	;SCROLLER ADDRESS
	BEQ	50$		;NO SCROLLER
	BIT	#VTLINK,DISP(R5);STILL LINKED ?
	BEQ	50$		;NO
	MOV	STSCRL,SCLINK(R4);RESTORE SCROLLER HEADER
	BIC	#VTLINK,DISP(R5);CLEAR THE LINKED BIT
	MOV	RESTRT,@#DPC	;RESTART SCROLLER
	MOV	#DELAY,RESTRT	;RESET RESTART ADDRESS
50$:	RTS	PC		;DONE
	.IFTF			;-$ATEL
	.DSABL	LSB
;
;	STOP DISPLAY TEMPORARILY
;
STOP:	MOV	#HLTFLG,R3	;POINT AT HALT FLAG
	TST	(R3)		;ALREADY STOPPED ?
	BMI	20$		;YES
	MOV	#1,(R3)		;NO, SET HALT REQUEST FLAG
5$:	MOV	#10000.,R2	;TOTAL WAIT 2 SECONDS
10$:	TST	(R3)		;STOPPED YET ?
	BMI	20$		;YES
	MOV	#2.,R1		;USE TWO HUNDRED MICRO SECONDS
	CALL	WAITX		;AND THEN SEE WHATS UP
	DEC	R2		;TRY AGAIN ?
	BNE	10$		;YES
	.IF NE	V$60
	BIS	#EXTSTP,@#DSRX	;VS60 EXTERNAL HALT
	.IFF			;V$60
	MOV	(PC),@#VT.SP	;RESET STACK
	MOV	#BUFST+2,@#DPC	;FORCE DPC TO A HALT
	.ENDC			;V$60
	BR	5$		;WAIT AGAIN
20$:
	.IFF			;-$ATEL
	CLR	HLTFLG		;CLEAR THE PLEASE HALT FLAG
	MOV	#BUFST+2,BUFST	;UNHOOK DFILE FROM SCROLLER
	MOV	RESTRT,@#DPC	;RESTART DPU IN HEADER
	.IFTF			;-$ATEL
	RTS	PC
;
;	RESTART THE DISPLAY
;
CONT:	CLR	HLTFLG		;CLEAR HALT FLAG
	.IFF			;-$ATEL
	MOV	BADR,BUFST	;RELINK DFILE
	.IFTF			;-$ATEL
	MOV	RESTRT,@#DPC	;RESTART THE DISPLAY
	RTS	PC
	.IFT			;-$ATEL
;
;	WAIT FOR <CR> THEN EXIT
;
GRWAIT:	MOV	#MSG,R1		;ADDR OF MESSAGE
10$:	MOVB	(R1)+,R0	;GET NEXT CHAR
	BEQ	20$		;0 IS END
	.TTYOU			;PRINT IT
	BR	10$		;LOOP
20$:	.TTYIN			;GET A CHAR
	CMP	R0,#12		;LINE FEED ?
	BNE	20$		;NO
	JSR	PC,UNLINK	;DISCONNECT VT11/VS60
	CLR	R0		;FORCE AN INIT
	.EXIT			;EXIT TO RT11
	.IFTF			;-$ATEL
;
;	GENERATE A TRACEBACK
;
TRAP0:
	.IFT			;-$ATEL
	INC	@#1		;INITIATE A TRACEBACK
				;NOTE: RT11 DOESN'T GIVE A TRACEBACK
				;	WITH TRAP 0
	.IFF			;-$ATEL
	TRAP	128.		;INITIATE A TRACEBACK
	.ENDC			;-$ATEL
	.ENDC			;$ATEL!RT$11
	.IF NE	<1-HO$AT>&<1-RT$11>
	.SBTTL	LINK, UNLINK, STOP, CONT, GRWAIT, TRAP0
;
;	LINK DISPLAY BUFFER TO VT11/VS60 DRIVER
;
LINK:
	.IF NE	LK$11
	QIO$S	#IO.CON,#LUNPB,,,#IOSB,,<#PBBUF,#6,#PBEF> ;LINK TO LK11
	.ENDC			;LK$11
	TST	(R5)+		;SKIP OVER ARG COUNT
	MOV	(R5)+,R0	;GET BUFFER START ADDRESS
	CLR	(R0)		;CLEAR LOCK
	MOV	#LPADR,R4	;POINT AT POINTERS LIST
	MOV	R0,(R4)+	;SAVE ADDRESS OF LP STUFF
	ADD	#BFHDR,R0	;GET BUFFER ADDRESS
	MOV	R0,(R4)+	;SAVE IT FOR START, STOP, CONT
	MOV	@(R5)+,R1	;GET BUFFER LENGTH
	ASL	R1		;MAKE IT A BYTE COUNT
	CLR	@(R5)+		;CLEAR SUCCESS FLAG
	QIO$S	#IO.CON,#LUNV,,,#IOSB,,<LPADR,R1,#LPEF,#LPAST> ;CONNECT BUFFER
	CMP	IOSB,#IS.SUC	;DID IT WORK ?
	BNE	10$		;NO
	INC	@-(R5)		;YES, SET FLAG
10$:	RTS	PC
;
;	UNLINK FROM DRIVER
;
UNLINK:	QIO$S	#IO.DIS,#LUNV	;DISCONNECT FROM RSX11M
	.IF NE	LK$11
	QIO$S	#IO.DIS,#LUNPB	;ALSO DISCONNECT LK11
	.ENDC			;LK$11
	RTS	PC
;
;	STOP DISPLAY TEMPORARILY
;
STOP:	QIO$S	#IO.STP,#LUNV	;STOP THE DISPLAY
	RTS	PC
;
;	RESTART THE DISPLAY
;
CONT:	QIO$S	#IO.CNT,#LUNV	;RESTART THE DISPLAY
	RTS	PC
;
;	WAIT FOR <CR> THEN EXIT
;
GRWAIT:	QIO$S	#IO.WVB,#LUNTT,#TTEF,,,,<#MSG,#MSIZ,#44> ;PRINT MESSAGE
	WTSE$S	#TTEF		;WAIT FOR IT
	QIO$S	#IO.RVB,#LUNTT,#TTEF,,,,<#BADR,#1> ;READ A CHAR
	WTSE$S	#TTEF		;WAIT FOR IT
	JSR	PC,UNLINK	;DISCONNECT VT11/VS60
	EXIT$S			;EXIT TO RSX11M
;
;	GENERATE A TRACEBACK
;
TRAP0:	TRAP	129.		;CAUSE A TRACEBACK
	.ENDC			;<1-HO$AT>&<1-RT$11>
	.SBTTL	TTW,KBS,KBG
;
;	OUTPUT A BYTE STRING (BYPASSING FORTRAN IO)
;
TTW:
	.IF NE	RT$11!$ATEL
	MOVB	(R5)+,R4	;ARG COUNT
	INC	R5		;SKIP A BYTE
10$:	MOV	@(R5)+,R3	;BYTE COUNT
	BGE	15$		;MUST BE POS.
	RTS	PC		;COUNT < 0 CAUSES EXIT WITH NO CR/LF
15$:	MOV	(R5)+,R2	;STRING ADDRESS
20$:
	MOVB	(R2)+,R1	;GET A BYTE
	BEQ	30$		;NULL BYTE ENDS STRING
	CALL	SCROLL		;OUTPUT TO SCROLLER
	DEC	R3		;MORE ?
	BNE	20$		;YES
30$:	SUB	#2,R4		;MORE ARGS ?
	BGT	10$		;YES
	JMP	CRLF		;OUTPUT CR/LF AND RETURN
	.ENDC			;RT$11!$ATEL
	.IF NE	<1-$ATEL>&<1-RT$11>
	MOVB	(R5)+,R4	;GET ARG COUNT
	INC	R5
	MOV	#44,R0		;INITIAL LF, NO TRAILING CR
10$:	MOV	@(R5)+,R2	;GET BYTE COUNT
	BLT	20$		;NEG MEANS QUIT NOW WITH NO CR
	MOV	(R5)+,R3	;GET STRING ADDRESS
	TST	R2		;ZERO BYTE COUNT ?
	BNE	18$		;NO, USE COUNT SPECIFIED
	MOV	R3,R2		;COPY STRING POINTER
15$:	TSTB	(R2)+		;END OF STRING ?
	BNE	15$		;NO
	SUB	R3,R2		;GET REAL STRING SIZE
	DEC	R2		;DON'T COUNT NULL
18$:	CLEF$S	#TTEF		;CLEAR FLAG FIRST
	QIO$S	#IO.WVB,#LUNTT,#TTEF,,#IOSB,,<R3,R2,R0>
	WTSE$S	#TTEF		;OUTPUT STRING AND WAIT FOR IT
	CLR	R0		;NEXT STRING HAS NO CARRIAGE CONTROL
	SUB	#2,R4		;MORE STRINGS ?
	BGT	10$		;YES
	CLEF$S	#TTEF		;CLEAR FLAG FIRST
	QIO$S	#IO.WVB,#LUNTT,#TTEF,,#IOSB,,<#CARRET,#1,#0>
	WTSE$S	#TTEF		;OUTPUT CRLF AND WAIT FOR IT
20$:	RTS	PC
	.ENDC			;<1-$ATEL>&<1-RT$11>
;
;	KEYBOARD INPUT (STRING)
;
KBS:
	.IF NE	$ATEL
	MOV	R5,-(SP)	;SAVE ARG LIST POINTER (CTLU RESTARTS)
	TST	(R5)+		;SKIP COUNT
	MOV	@(R5)+,R3	;BUFFER SIZE
	CMP	R3,#73.		;TOO BIG ?
	BLE	1$		;NO
	MOV	#73.,R3		;YES, USE MAX
1$:	DEC	R3		;SAVE ROOM FOR NULL
	MOV	R3,-(SP)	;SAVE COUNT
	MOV	(R5)+,R4	;STRING DESTINATION
	MOV	#KBCNT,R0	;POINT AT RUBOUT COUNT BUFFER
10$:	MOVB	KBCHR,R1	;GET CURRENT CHAR
	BEQ	10$		;NONE THERE
	CLRB	KBCHR		;OK, NOW FREE UP THE BUFFER
	BIC	#177600,R1	;CLEAN IT
	CMPB	R1,#CR		;CR ?
	BEQ	100$		;YES, END OF LINE
	CMPB	R1,#LF		;LF ?
	BEQ	100$		;YES, ALSO END OF LINE
	CMPB	R1,#RUBOUT	;RUB OUT ?
	BEQ	20$		;YES, DELETE LAST CHAR
	CMPB	R1,#CTLU	;CTL/U ?
	BNE	15$		;NO
	CALL	SCROLL		;OUTPUT ^U
	CALL	CRLF		;CR/LF
	TST	(SP)+		;PURGE COUNT
	MOV	(SP)+,R5	;RESTORE R5
	BR	KBS		;START AGAIN
15$:	TST	R3		;ANY ROOM LEFT ?
	BLE	10$		;NO, DON'T TAKE ANY MORE
	DEC	R3		;DECREASE ROOM LEFT
	MOVB	R1,(R4)+	;NO, SAVE THE CHAR
	MOVB	COLCNT,(R0)+	;AND CURRENT COLUMN COUNTER
	CALL	SCROLL		;OUTPUT THE CHAR
	BR	10$		;GO GET THE NEXT ONE
20$:	CMP	R3,(SP)		;AT START OF BUFFER ?
	BGE	10$		;YES, DON'T RUBOUT
	MOVB	-(R0),R2	;OK, GET COLUMN POSITION BEFORE CHAR
	DEC	R4		;BACK OVER CHAR
	INC	R3		;INCREASE CHAR REMAINING COUNT
30$:	MOV	#BACKSP,R1	;USE BACK SPACE (SCROLLER UNDERSTANDS)
	CALL	SCROLL		;BACK ONE
	CMP	COLCNT,R2	;THERE YET ?
	BGT	30$		;NO
	BR	10$		;YES, NEXT INPUT
100$:	CALL	CRLF		;EOL DOES CRLF
	CLRB	(R4)+		;END STRING WITH NULL
	CMPB	-6(R5),#2	;RETURN ACTUAL SIZE ?
	BLE	110$		;NO
	SUB	R3,(SP)		;GET SIZE OF STRING (DON'T COUNT NULL)
	MOV	(SP),@(R5)+	;RETURN IT
110$:	CMP	(SP)+,(SP)+	;PURGE STACK
	RTS	PC
	.ENDC			;$ATEL
	.IF NE	RT$11
	TST	(R5)+		;SKIP COUNT
	MOV	@(R5)+,R3	;BUFFER SIZE
	CMP	R3,#73.		;TOO BIG ?
	BLE	1$		;NO
	MOV	#73.,R3		;YES, USE MAX
1$:	DEC	R3		;SAVE ROOM FOR NULL
	MOV	R3,-(SP)	;SAVE COUNT
	MOV	(R5)+,R4	;STRING DESTINATION
10$:	.TTYIN			;GET A CHAR
	CMPB	R0,#LF		;IS IT END OF LINE ?
	BEQ	20$		;YES
	TST	R3		;ROOM LEFT IN BUFFER ?
	BLE	10$		;NO
	DEC	R3		;YES, DECREASE IT BY ONE
	MOVB	R0,(R4)+	;SAVE THE CHAR
	BR	10$		;MORE
20$:	CLRB	-(R4)		;END STRING WITH NULL (KILLING CR)
	INC	R3		;DON'T COUNT CR
	CMPB	-6(R5),#2	;RETURN ACTUAL SIZE ?
	BLE	110$		;NO
	SUB	R3,(SP)		;GET SIZE OF STRING (DON'T COUNT NULL)
	MOV	(SP),@(R5)+	;RETURN IT
110$:	TST	(SP)+		;PURGE STACK
	RTS	PC
	.ENDC			;RT$11
	.IF NE	<1-$ATEL>&<1-RT$11>
	TST	(R5)+		;SKIP ARG COUNT
	MOV	@(R5)+,R3	;SIZE OF BUFFER
	CMP	R3,#73.		;TOO BIG ?
	BLE	1$		;NO
	MOV	#73.,R3		;YES, USE MAX
1$:	DEC	R3		;LEAVE ROOM FOR NULL
	MOV	(R5)+,R4	;POINTER TO INPUT BUFFER
	CLEF$S	#TTEF		;CLEAR TT EFN
	QIO$S	#IO.RLB,#LUNTT,#TTEF,,#IOSB,,<R4,R3> ;READ THE LINE
	WTSE$S	#TTEF		;WAIT FOR IT
	ADD	IOSB+2,R4	;FIND END OF STRING
	CLRB	(R4)		;PUT IN A NULL
	CMPB	-6(R5),#2	;DO WE WANT THE LENGTH ?
	BLE	110$		;NO
	MOV	IOSB+2,@(R5)+	;YES, RETURN IT
110$:	RTS	PC
	.ENDC			;<1-$ATEL>&<1-RT$11>
;
;	KEYBOARD INPUT (CHARACTER)
;
KBG:
	.IF NE	$ATEL
	MOVB	KBCHR,R0	;GET THE CHAR
	CMPB	(R5),#1		;TWO ARGS ?
	BGT	10$		;YES, LEAVE CHAR ALONE
	CLRB	KBCHR		;CLEAR IT OUT
10$:	MOV	R0,@2(R5)	;RETURN IT
	RTS	PC
	.ENDC			;$ATEL
	.IF NE	<1-HO$AT>&<1-RT$11>
	MOV	#KBCHR,R0	;POINT AT BUFFER
	MOV	#1,R1		;OFT USED
	CMPB	(R5),R1		;ONE ARG CALL ?
	BLT	10$		;ZERO ARGS, INIT READ
	BGT	20$		;TWO ARGS, KILL READ
	TST	(R0)		;ANY CHAR FROM PREVIOUS ?
	BNE	30$		;YES, DON'T READ AGAIN
	MRKT$S	#TTUF,#TTWAIT,R1 ;WAIT 1/2 SECOND
10$:	CLEF$S	#TTUF		;CLEAR EFNS
	CLEF$S	#TTEF
	.IF NE	R$X11D!IA$
	QIO$S	#IO.RAL!IO.RNE,#LUNTT,#TTEF,,#IOSB,,<R0,R1> ;ISSUE READ
	.IFF			;R$X11D!IA$
	QIO$S	#IO.RAL,#LUNTT,#TTEF,,#IOSB,,<R0,R1> ;ISSUE READ
	.ENDC			;R$X11D!IA$
	CMPB	(R5),R1		;ONE ARG CALL ?
	BNE	40$		;NO, JUST WANTED TO START READ
	WTLO$S	GTT,#TTMSK	;WAIT FOR READ OR TIMEOUT
	CLEF$S	#TTUF		;CLEAR TIMEOUT FLAG
	CMP	$DSW,#IS.SET	;WAS IT SET ?
	BNE	30$		;NO, READ COMPLETED
20$:	CLEF$S	#TTUF		;YES, KILL READ
	QIO$S	#IO.KIL,#LUNTT,#TTUF,,#IOSB
	WTSE$S	#TTUF		;WAIT FOR IT
	WTSE$S	#TTEF
	CLR	(R0)		;ZAP CHAR BUFFER
30$:	CMKT$S			;CANCEL MARK TIME
	BIC	#177600,(R0)	;ONLY SEVEN BITS
	MOV	(R0),@2(R5)	;COPY THE CHAR
	CLR	(R0)		;ZERO THE BUFFER
40$:	RTS	PC		;DONE (THIS WILL NEVER WORK!!)
	.ENDC			;<1-HO$AT>&<1-RT$11>
	.IF NE	RT$11
	MOV	#KBCHR,R1	;POINT AT CHARACTER
	TSTB	(R1)		;ANY THERE ?
	BNE	20$		;NO
	.TTINR			;GET A CHAR IF THERE IS ONE
	BCS	20$		;NONE THERE
	MOVB	R0,(R1)		;SAVE IT
10$:	.TTINR			;GET REST UNTIL EOL
	CMPB	R0,#LF		;EOL ?
	BNE	10$		;NO
20$:	MOVB	(R1),R0		;GET THE CHAR
	CMPB	(R5),#1		;ONE ARG CALL ?
	CLRB	(R1)		;YES, CLEAR THE CHAR
30$:	MOVB	R0,@2(R5)	;RETURN THE CHAR
	RTS	PC
	.ENDC			;RT$11
	.IF NE	LK$11&<$ATEL!<1-HO$AT>>
	.SBTTL	LK11 PUSH BUTTON BOX SUPPORT
;
;	READ BUTTONS
;
PBREAD:
	.IF NE	RT$11!$ATEL
	MOV	@#PBIBUF,@2(R5)	;READ THE BUTTONS
	.IFF			;RT$11!$ATEL
	MOV	PBBUF,@2(R5)	;READ THE BUTTONS
	.IFTF			;RT$11!$ATEL
	RTS	PC
;
;	WRITE LIGHTS
;
PBWRIT:
	TST	(R5)+		;SKIP ARG COUNT
	.IFT			;RT$11!$ATEL
	MOV	@(R5)+,R4	;GET OFFS
	MOV	@(R5)+,R3	;GET ONS
	CMP	R4,#-1		;ALL OFF ?
	BNE	20$		;NO, JUST PROCEED
	CMP	R3,R4		;ALL ON TOO ?
	BNE	20$		;NO
	CLR	PBLCTL		;YES, RETURN LIGHT CONTROL TO BUTTONS
	MOV	@#PBIBUF,@#PBOBUF ;AND SHOW WHERE THEY ARE NOW
	RTS	PC
20$:	MOV	SP,PBLCTL	;SET LIGHT CONTROL FLAG
	BIC	R4,@#PBOBUF	;TURN THESE LIGHTS OFF
	BIS	R3,@#PBOBUF	;AND THESE ON
	.IFF			;RT$11!$ATEL
	MOV	#PBBUF+4,R0	;POINT AT PUSH BUTTON BUFFER
	MOV	@(R5)+,(R0)	;OFFS
	MOV	@(R5)+,-(R0)	;ONS (NOTE: DRIVER TAKES 'EM BACKWARDS)
	QIO$S	#IO.WLB,#LUNPB	;WRITE THE LIGHTS
	.IFTF			;RT$11!$ATEL
	RTS	PC
	.IFT			;RT$11!$ATEL
;
;	SERVICE LK11 INTERRUPT
;
PBINT:
	.IF EQ	$ATEL
	.INTENT	4		;RT11 INTERRUPT ENTRY
	.IFTF			;-$ATEL
	TST	PBLCTL		;ARE WE CONTROLLING LIGHTS ?
	BNE	10$		;NO
	MOV	@#PBIBUF,@#PBOBUF ;YES, SET THEM TO MATCH BUTTONS
10$:
	.IFT			;-$ATEL
	RTS	PC
	.IFF			;-$ATEL
	RTI
	.ENDC			;-$ATEL
	.ENDC			;RT$11!$ATEL
	.ENDC			;LK$11&<$ATEL!<1-HO$AT>>
	.IF NE	RT$11!$ATEL
	.SBTTL	DEVICE DRIVER (RT11 AND SATELLITE ONLY)
;
;	STOP INTERRUPT HANDLER
;
STPINT:
	.IF EQ	V$60
	.IF NE	$ATEL
	.IF NE	DEBUG
	INC	D$STP		;SET IN STOP INT FLAG
	.ENDC			;DEBUG
	MOV	R5,-(SP)	;SAVE REGS
	MOV	R4,-(SP)
	.IFF			;$ATEL
	.INTENT	4		;INTERRUPT HANDLER ENTRY
	.IFTF			;$ATEL
	MOV	VT.SP,R4	;GET DPU STACK POINTER
	MOV	@#DPC,R5	;GET ADDRESS OF DHALT+2
	TST	(R5)		;IS NEXT WORD 0 ?
	BEQ	20$		;ZERO IS DRET
	MOV	R5,-(R4)	;PUSH POINTER TO RETURN ADDRESS
	MOV	2(R5),R5	;START DPU IN SUBPICTURE
10$:	MOV	R4,VT.SP	;SAVE DPU STACK POINTER
	.IFT			;$ATEL
	MOV	(SP)+,R4	;RESTORE REGS
	SPL	7		;SET PRIORITY TO 7
	.IFTF			;$ATEL
	MOV	R5,@#DPC	;RESTART THE DPU
	.IFT			;$ATEL
	MOV	(SP)+,R5	;RESTORE R5
	.IF NE	DEBUG
	DEC	D$STP		;CLEAR IN STOP INT FLAG
	.ENDC			;DEBUG
	RTI
	.IFF			;$ATEL
	RTS	PC
	.IFTF			;$ATEL
20$:	CMP	R4,#VT.SP	;STACK EMPTY ?
	BLO	30$		;NO
	TST	HLTFLG		;SHOULD IT STAY HALTED ?
	BEQ	25$		;NO
	BIS	#100000,HLTFLG	;YES, SET THE SUCCESS BIT
	.IFT			;$ATEL
	MOV	(SP)+,R4	;RESTORE REGS
	MOV	(SP)+,R5
	.IF NE	DEBUG
	DEC	D$STP		;CLEAR IN STOP INT FLAG
	.ENDC			;DEBUG
	RTI			;EXIT
	.IFF			;$ATEL
	RTS	PC		;EXIT
	.ENDC			;$ATEL
25$:	MOV	RESTRT,R5	;YES, RESTART DPU AT THE TOP
	BR	10$
30$:	MOV	@(R4)+,R5	;START DPU AT RETURN ADDRESS
	BR	10$		;GO TO IT
	.IFF			;-V$60
	.IF NE	DEBUG&$ATEL
	INC	D$STP		;SET IN STOP INT FLAG
	.ENDC			;DEBUG&$ATEL
	MOV	#SRESET,@#DSP	;RESET HARDWARE DISPLAY STACK
	TST	HLTFLG		;SHOULD IT STAY HALTED ?
	BEQ	10$		;NO
	BIS	#100000,HLTFLG	;YES, SET THE SUCCESS BIT
	.IF NE	DEBUG&$ATEL
	DEC	D$STP		;CLEAR IN STOP INT FLAG
	.ENDC			;DEBUG&$ATEL
	RTI
10$:	MOV	RESTRT,@#DPC	;RESTART DPU
	.IF NE	DEBUG&$ATEL
	DEC	D$STP		;CLEAR IN STOP INT FLAG
	.ENDC			;DEBUG&$ATEL
	RTI			;RETURN DUMMY
	.IFTF			;-V$60
;
;	SHIFT OUT INTERRUPT
;
SOINT:
	.IFT			;-V$60
	MOV	(PC),@#VT.SP	;RESET STACK POINTER
	.IFF			;-V$60
	MOV	#SRESET,@#DSP	;RESET HARDWARE DISPLAY STACK
	.ENDC			;-V$60
	.IF NE	$ATEL
	MOV	#CURSOR,@#DPC	;RESTART AT THE CURSOR
	.IFF			;$ATEL
	MOV	RESTRT,@#DPC	;RESTART DPU
	.ENDC			;$ATEL
	RTI
;
;	LIGHT PEN INTERRUPT
;
LPINT:
	.IF NE	$ATEL
	.IF NE	DEBUG
	INC	D$LP		;SET IN LP INT FLAG
	.ENDC			;DEBUG
	MOV	R5,-(SP)	;SAVE REGS
	MOV	R4,-(SP)
	.IFF			;$ATEL
	.INTENT	4		;INTERRUPT ENTRY
	.ENDC			;$ATEL
	.IF EQ	V$60
	MOV	#1,LPHF		;SET LIGHT PEN HIT FLAG
	.IFF			;-V$60
	MOV	@#CSTAT,R5	;GET CONSOLE STATUS
	BIT	#TON0,R5	;TIP SWITCH 1 TURNED ON ?
	BEQ	10$		;NO
	INC	TIP1		;YES, SET FLAG
	BR	60$		;GO RESTART
10$:	BIT	#TOFF0,R5	;TIP SWITCH 1 TURNED OFF ?
	BEQ	20$		;NO
	CLR	TIP1		;YES, CLEAR FLAG
	BR	60$		;GO RESUME DISPLAY
20$:
	.IF NE	SCOPE$
	BIT	#TON1,R5	;TIP SWITCH 2 TURNED ON ?
	BEQ	30$		;NO
	INC	TIP2		;YES, SET FLAG
	BR	60$		;GO RESUME DISPLAY
30$:	BIT	#TOFF1,R5	;TIP SWITCH 2 TURNED OFF ?
	BEQ	40$		;NO
	CLR	TIP2		;YES, CLEAR FLAG
	BR	60$		;GO RESUME DISPLAY
40$:
	.IFTF			;SCOPE$
	MOV	#1,LPHF		;LP HIT, SET FLAG
	.IFT			;SCOPE$
	BIT	#LP1,R5		;WAS IT SCOPE 1 ?
	BEQ	50$		;NO
	INC	LPHF		;YES, SET FLAG TO 2
50$:
	.ENDC			;SCOPE$
	.IFTF			;-V$60
	MOV	LPADR,R4	;ADDRESS OF THE LP DATA
	TST	(R4)+		;TEST LOCK WORD
	.IFT			;-V$60
	BNE	CNTNUE		;DON'T CHANGE DATA WHILE ITS BEING READ
	.IFF			;-V$60
	BEQ	70$
60$:	JMP	CNTNUE		;DON'T CHANGE DATA WHILE ITS BEING READ
70$:
	.IFTF			;-V$60
	MOV	R4,R5		;SAVE ADDRESS OF START OF NAME LIST
	MOV	R3,-(SP)	;SAVE THE REST OF THE REGS
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	.IFT			;-V$60
	MOV	VT.SP,R2	;GET SOFTWARE STACK POINTER
80$:	CMP	R2,#VT.SP	;REACHED THE TOP YET ?
	BHIS	110$		;YES
	MOV	(R2)+,(R4)+	;RETURN ADDRESS INTO LIST
	BR	80$
	.IFF			;-V$60
	MOV	#DSP,R1		;POINT AT THE HARDWARE STACK POINTER
	MOV	(R1),R2		;GET CURRENT STACK POINTER
	MOV	R2,-(SP)	;SAVE CURRENT STACK LEVEL
	BIC	#177703,R2	;CLEAR OUT WORD SELECT BITS
				;THUS SELECTING WORD 0
80$:	CMP	R2,#SRESET	;AT THE TOP YET ?
	BHIS	100$		;YES
	MOV	R2,(R1)		;SELECT THE WORD TO READ
	MOV	@#DSTACK,(R4)+	;RETURN ADDRESS INTO LIST
	ADD	#4,R2		;GO DOWN ONE MORE STACK LEVEL
	BR	80$		;LOOP
100$:	MOV	(SP)+,(R1)	;RESTORE CURRENT STACK LEVEL
	.IFTF			;-V$60
110$:	MOV	#-2,(R4)+	;END OF TAG LIST IS -2
	ADD	#NAMSIZ,R5	;POINT AT REST OF LP DATA
	MOV	#DPC,R4		;POINT AT DPC
	MOV	(R4)+,(R5)+	;GET DPC
	MOV	(R4)+,(R5)+	;AND DSR
	MOV	(R4)+,(R5)+	;AND XSR
	MOV	(R4)+,(R5)+	;AND YSR
	.IFF			;-V$60
	TST	(R4)+		;SKIP RELOCATE REG
	MOV	(R4)+,(R5)+	;GET EXTENDED STATUS
	MOV	(R4)+,(R5)+	;X OFFSET
	MOV	(R4)+,(R5)+	;Y OFFSET
	MOV	DOS-DNR(R4),(R5)+ ;X,Y OFFSET SIGNS
	.IFT			;-V$60
	CLR	(R5)+		;ZERO EXTENDED STATUS
	CLR	(R5)+		;AND X OFFSET
	CLR	(R5)+		;AND Y OFFSET
	CLR	(R5)+		;AND OFFSET SIGNS
	.ENDC			;-V$60
	MOV	TIP1,(R5)+	;TIP SWITCH STATUS FOR SCOPE 1
	.IF EQ	SCOPE$
	CLR	(R5)+		;TIP SWITCH 2 ALWAYS OFF
	.IFF			;-SCOPE$
	MOV	TIP2,(R5)+	;AND FOR SCOPE 2
	.ENDC			;-SCOPE$
	MOV	LPHF,(R5)	;AND LP FLAG
	.ENDC			;RT$11!$ATEL
	.IF NE	$ATEL!<1-HO$AT>
	.SBTTL	TRACKING AND RUBBER-BANDING
;
;	LIGHT PEN AST SERVICE
;
LPAST:
	.IF EQ	RT$11!$ATEL
	MOV	R5,-(SP)	;SAVE REGS
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	.ENDC			;-<RT$11!$ATEL>
	MOV	LPADR,R1	;ADDRESS OF LP DATA
	MOV	R1,R2		;SAVE LP DATA ADDRESS
	INC	(R1)+		;SET LOCK
	MOV	R1,R0		;COPY POINTER TO ADDRESS LIST
10$:	MOV	(R0),R3		;GET NEXT RETURN ADDRESS
	CMP	R3,#-2		;END OF LIST ?
	BEQ	16$		;YES
	.IF EQ	V$60
	MOV	4(R3),(R0)+	;CHANGE RETURN ADDRESS INTO TAG
	.IFF			;-V$60
	CMP	(R3)+,#DJMPR+2	;ON SUBPICTURE CALL ?
	BEQ	15$		;YES, TAG IS NEXT WORD
	TST	(R3)+		;NO, SKIP A WORD TO REACH TAG
15$:	MOV	(R3),(R0)+	;SUBSTITUTE TAG
	.ENDC			;-V$60
	BR	10$		;LOOP
16$:	CMP	(R1)+,#-1	;TRACK OBJ ?
	BNE	100$		;NO, IGNORE IT
	ADD	#NAMSIZ,R1	;SKIP OVER REST OF NAME LIST AND DPC
	BIT	#40,(R1)+	;EDGE VIOLATION ?
	BNE	100$		;YES, DON'T MOVE OFF SCREEN
	ADD	#BFHDR+TOHDR,R2	;ADDRESS OF TRACK OBJ #1 X,Y
	MOV	#IATT,R0	;ADDRESS OF ATTACH LIST #1
	.IF NE	V$60
	.IF NE	SCOPE$
	CMP	LPE(R1),#1	;HIT ON SCOPE 1 ?
	BNE	18$		;NO
	.IFTF			;SCOPE$
	TST	T1(R1)		;IS TIP SWITCH 1 SET ?
	BEQ	100$		;NO, DON'T TRACK
	.IFT			;SCOPE$
	BR	19$		;YES, TRACK
18$:	TST	T2(R1)		;ITS SCOPE 2, IS TIP SWITCH 2 SET ?
	BEQ	100$		;NO, DON'T TRACK
	ADD	#TOHDR2-TOHDR,R2;POINT AT TRACK OBJ #2 X,Y
	ADD	#ALSIZE+1,R0	;AND AT ATTACH LIST #2
	.ENDC			;SCOPE$
19$:
	.ENDC			;V$60
	JSR	PC,20$		;DO DELTA X
	MOV	R4,R3		;SAVE DELTA X
	MOV	#25$,-(SP)	;DO DELTA Y
20$:	MOV	(R1)+,R4	;GET COORD
	BIC	#XYMASK,R4	;ONLY 10 BITS
	SUB	(R2),R4		;NEW-OLD
	ASR	R4		;DIVIDE BY 4
	ASR	R4
	ADD	R4,(R2)+	;OLD+(NEW-OLD)/4
	RTS	PC
25$:	MOV	#VSIGN,R5	;OFT USED CONSTANT
	.IF EQ	V$60
	MOV	#VMAX,-(SP)	;MAX VECTOR/POINT DISPLACEMENT
	.IFF			;-V$60
	CLR	-(SP)		;MAKE ROOM ON STACK
	.IFTF			;-V$60
30$:	MOV	(R0)+,R1	;GET ADDRESS OF FIRST THING
	BEQ	80$		;NO MORE IN LIST
	.IFF			;-V$60
	MOV	#VMAX,(SP)	;MAX FOR VECTORS
	.IFTF			;-V$60
	TST	(R0)		;WHAT TYPE OF PRIMITIVE ?
	.IFF			;-V$60
	BNE	35$		;LONG VECTOR
	MOV	#PMAX,(SP)	;ABS POINT, USE BIGGER MAX
35$:
	.ENDC			;-V$60
	BPL	40$		;NEGATIVE CONNECTED LONG VECTOR ?
	NEG	R3		;YES, NEGATE DELTA X AND Y
	NEG	R4
40$:	MOV	(R1),R2		;GET FIRST THING'S X COORDINATE
	BMI	75$		;IF NEG, ITS TURNED INTO A MODE WORD??
	BIC	#VSIGN+PMAX,(R1);ISOLATE INTENSIFY BIT AND OFFSET BIT
	BIC	(R1),R2		;REMOVE IT FROM DATA WORD
	BIT	R5,R2		;IS X COORD NEGATIVE ?
	BEQ	45$		;NO
	BIC	R5,R2		;YES, KILL SIGN
	NEG	R2		;MAKE IT 2'S COMPLEMENT NEGATIVE
45$:	ADD	R3,R2		;ADD CHANGE IN X
	BPL	50$		;RESULT IS +
	NEG	R2		;NEGATIVE RESULT, GET MAGNITUDE
	BIS	R5,(R1)		;SET SIGN IN COORD
50$:	CMP	(SP),R2		;OVERFLOW ?
	BGE	55$		;NO
	MOV	(SP),R2		;YES, SUBSTITUTE MAX
55$:	BIS	R2,(R1)+	;RESTORE TO DISPLAY LIST
	MOV	(R1),R2		;GET Y COORD
	BMI	75$		;IF NEG ITS CHANGED TO A MODE ??
	BIC	#VSIGN+PMAX,(R1);ISOLATE INTENSIFY AND OFFSET BITS
				;NOTE: Y COORDS DON'T HAVE INTENSIFY BITS ON
	BIT	R5,R2		;NEGATIVE ?
	BEQ	60$		;NO
	BIC	R5,R2		;YES, KILL SIGN BIT
	NEG	R2		;MAKE IT 2'S COMPLEMENT NEG
60$:	ADD	R4,R2		;ADD DELTA Y
	BPL	65$		;RESULT IS PLUS
	NEG	R2		;GET RESULT MAGNITUDE
	MOV	R5,(R1)		;PUT SIGN ON IN D LIST
65$:	CMP	(SP),R2		;OVERFLOW
	BGE	70$		;NO
	MOV	(SP),R2		;YES, SUBSTITUTE MAX
70$:	BIS	R2,(R1)		;FINISH DATA WORD
75$:	TST	(R0)+		;WAS IT A NEGATIVE ATTACHED LONG VECTOR
	BPL	30$		;NO
	NEG	R3		;YES, FIX UP DELTA X AND Y
	NEG	R4
	BR	30$
80$:	TST	(SP)+		;REMOVE THING FROM STACK
100$:	MOV	(SP)+,R0	;RESTORE
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
CNTNUE:
	.IF EQ	RT$11
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	.ENDC			;-RT$11
	CLR	@LPADR		;CLEAR THE LOCK
	.IF EQ	RT$11!$ATEL
	ASTX$S			;AST SERVICE EXIT
	.IFF			;-<RT$11!$ATEL>
	.IF NE	$ATEL
	SPL	7		;UP PRIORITY TO 7
	.IFTF			;$ATEL
	INC	@#DPC		;RESTART DPU
	.IFT			;$ATEL
	.IF NE	DEBUG
	DEC	D$LP		;CLEAR IN LP INT FLAG
	.ENDC			;DEBUG
	RTI
	.IFF			;$ATEL
	RTS	PC
	.ENDC			;$ATEL
	.ENDC			;-<RT$11!$ATEL>
	.ENDC			;$ATEL!<1-HO$AT>
	.SBTTL	DATA BASE
	.IF NE	$ATEL
CONVTB:	.ASCII	# ABCDEFGHIJKLMNOPQRSTUVWXYZ$. 0123456789#
FROM:	.ASCIZ	/FROM/
IN:	.ASCIZ	/IN  /
ROUT:	.ASCIZ	/ ROUTINE "/
LIN:	.ASCIZ	/"  LINE /
EMSG:	.ASCIZ	<15><12>/?SATELLITE ERROR /
R50TAB:	.BYTE	0,1,2,3,4,5,6,7,10,11,12,13,14,15,16,17,20
	.BYTE	21,22,23,24,25,26,27,30,31,32,0,0,0,0,0,0
	.BYTE	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,36,37,40,41,42
	.BYTE	43,44,45,46,47,0,0,0,0,0,0
	.EVEN
	.ENDC			;$ATEL
	.IF NE	RT$11!$ATEL
MSG:	.ASCIZ	<15><12>"TYPE <CR> TO EXIT"
	MSIZ=.-MSG
	.EVEN
				;***WARNING***  THE ORDER OF LOCAL DATA IS FIXED
LPADR:	.WORD	0		;ADDRESS OF LP DATA
BADR:	.WORD	0		;ADDRESS OF DISPLAY BUFFER
RESTRT:	.WORD	DELAY		;DPU RESTART
HLTFLG:	.WORD	100001		;HALT FLAG
	.IF NE	LK$11
PBLCTL:	.WORD	0		;LK11 LIGHT CONTROL FLAG
	.ENDC			;LK$11
	.IF EQ	V$60
TIP1:	.WORD	1		;TIP SWITCH FOR SCOPE 1 (ALWAYS 'ON')
	.IFF			;-V$60
TIP1:	.WORD	0		;TIP SWITCH FOR SCOPE 1
	.IF NE	SCOPE$
TIP2:	.WORD	0		;TIP SWITCH FOR SCOPE 2
	.ENDC			;SCOPE$
	.IFT			;-V$60
	.BLKW	8.		;STACK FOR DPU
VT.SP:	.WORD	.		;DPU STACK POINTER
	.ENDC			;-V$60
LPHF:	.WORD	0		;LIGHT PEN HIT FLAG
	.IF EQ	$ATEL
AREA:	.WORD	0,0		;EMT SPACE
KILLER:	.WORD	GRVEC,KILLVT	;VT11 STOPPER
	.IF NE	LK$11
	.WORD	PBCSR,0		;LK11 STOPPER
	.ENDC			;LK$11
	.WORD	0
KBCHR:	.WORD	0		;CHAR BUFFER FOR KBG
	.ENDC			;-$ATEL
DELAY:	.WORD	116724		;APNT+INT3+LPOFF+BLINKOFF
	.IF NE	V$60
	.WORD	10000,0		;ZERO X AND Y OFFSETS
	.IFTF			;V$60
	.WORD	1777,1777	;MOVE TO UPPER RIGHT CORNER
	.WORD	110000		;LONG VECTOR
	.WORD	21777,21777	;BACK TO LOWER LEFT (TO DELAY DPU INTERRUPTS)
	.REPT	3
	.WORD	1777,1777,21777,21777 ;MORE DELAY FOR VS60
	.ENDR
	.WORD	100000		;CHARACTER
	.WORD	17		;SHIFT IN
	.WORD	171242		;STOP INT OFF + LP HIT BRIGHT UP + NOITALLICS + NO MENU
	.IFT			;V$60
	.WORD	164354		;SCOPE 1  INTENSIFY, LP INT OFF, TIP INT ON
	.IF NE	SCOPE$
	.WORD	164654		;SCOPE 2  NO INTENS, LP INT OFF, TIP INT ON
	.ENDC			;SCOPE$
	.WORD	155264		;NO CHAR ROT, CSCALE=NORM, VSCALE=NORM
	.ENDC			;V$60
	.IF NE	$ATEL
	.WORD	114000		;APNT
SCLXY:	.WORD	0,0		;X,Y OF START
	.WORD	103600		;CHAR+INT7
	.WORD	160000		;DJMP
SCLST:	.WORD	.+2		;POINTS TO TOP LINE OF SCROLLER
SCLBUF:	.BYTE	SHFTOU,RUBOUT	;SHIFT OUT / RUB OUT ENDS SCROLLER BUFFER
	.BLKB	SCLSIZ-2	;SCROLLER BUFFER
	.EVEN
SCLEND:	.WORD	160000		;DJMP
	.WORD	SCLBUF		;BACK TO THE START
CURSOR:	.WORD	100000		;CHAR
	.BYTE	BOX,SHFTIN
	.WORD	100030		;CHAR+BLINK
CURRO:	.BYTE	BACKSP,RUBOUT
	.WORD	116620		;APNT+NOBLINK+INT3
	.WORD	0,0		;BACK TO LOWER LEFT
	.IFTF			;$ATEL
	.WORD	160000		;JUMP TO USER'S DISPLAY LIST
BUFST:	.WORD	.+2
	.WORD	173400,0
	.IFT			;$ATEL
SIZER:	.WORD	114000		;ABS POINT
	.WORD	1000,1300	;(512.,708.)
	.WORD	110000		;LONG VECT
	.WORD	0,200		;(0.,128.)
	.WORD	173000		;HALT
	.IFF			;$ATEL
FIXSCL:	.WORD	116724		;SCROLLER FIX UP LIST
	.WORD	0
FIXSCY:	.WORD	0		;TOP OF SCREEN FROM RT SCROLLER
	.IF NE	V$60
	.WORD	10000,0		;ZERO X AND Y OFFSETS
	.IFTF			;V$60
	.WORD	100000		;CHARACTER
	.WORD	17		;SHIFT IN
	.WORD	171242		;STOP INT OFF + LP HIT BRIGHT UP + NOITALLICS + NO MENU
	.IFT			;V$60
	.WORD	164354		;SCOPE 1  INTENSIFY, LP INT OFF, TIP INT ON
	.IF NE	SCOPE$
	.WORD	164654		;SCOPE 2  NO INTENS, LP INT OFF, TIP INT ON
	.ENDC			;SCOPE$
	.WORD	155264		;NO CHAR ROT, CSCALE=NORM, VSCALE=NORM
	.IFTF			;V$60
	.WORD	160000		;NOW JUMP TO SCROLLER BUFFER
STSCRL:	.WORD	0
	.ENDC			;V$60
	.ENDC			;$ATEL
	.IF NE	V$60
	.IF EQ	$ATEL
CONRE:	.WORD	164350		;RESET CONSOLE 1 STATUS
	.IF NE	SCOPE$
	.WORD	164650		;RESET CONSOLE 2 STATUS
	.ENDC			;SCOPE$
	.WORD	114000		;RESET OFFSET REGISTORS
	.WORD	100000,0
	.WORD	155264		;RESET C SCALE, V SCALE, C ROTATE
	.WORD	173242		;HALT, NO INT, NOMENU, NOITAL, LP HIT BRITE
CRDONE:
	.ENDC			;-$ATEL
	.ENDC			;V$60
	.ENDC			;RT$11!$ATEL
	.IF NE	<1-$ATEL>&<1-RT$11>
CARRET:	.BYTE	15
	.EVEN
	.ENDC			;<1-$ATEL>&<1-RT$11>
	.IF NE	<1-HO$AT>&<1-RT$11>
MSG:	.ASCIZ	"TYPE <CR> TO EXIT"
	MSIZ=.-MSG
	.EVEN
				;***WARNING***  THE ORDER OF LOCAL DATA IS FIXED
LPADR:	.WORD	0		;ADDRESS OF LP DATA
BADR:	.WORD	0		;ADDRESS OF DISPLAY BUFFER
IOSB:	.WORD	0,0		;STATUS RETURN FOR RSX
	.IF NE	LK$11
PBBUF:	.WORD	0,0,0		;LK11 CONTROL BUFFER
	.ENDC			;LK$11
KBCHR:	.WORD	0		;KBG BUFFER
	.ENDC			;<1-HO$AT>&<1-RT$11>
	.IF NE	$ATEL
	.IF NE	DEBUG
D$OOS:	.WORD	0		;OUT OF SYNC COUNT
D$HCRC:	.WORD	0		;HEADER CRC ERROR COUNT
D$SIZE:	.WORD	0		;SIZE ERROR COUNT
D$MCRC:	.WORD	0		;MSG CRC ERROR COUNT
D$DLI:	.WORD	0		;IN DLIINT FLAG
D$DLO:	.WORD	0		;IN DLOINT FLAG
D$STP:	.WORD	0		;IN STPINT FLAG
D$LP:	.WORD	0		;IN LPINT FLAG
JUNKB:	.BLKB	400.		;JUNK BUFFER
JUNK:	.WORD	JUNKB		;JUNK POINTER
	.ENDC			;DEBUG
	.IF NE	R$X11D!IA$
FORWAY:	.WORD	0		;FOUR WAY BRANCH CONTROL FOR 3 IN 4 PACKING
	.ENDC			;R$X11D!IA$
SCLCHR:	.BYTE	0		;BUFFER CHAR FROM DL IF IN SCROLLER
INSCRL:	.BYTE	0		;'IN SCROLLER' FLAG
MIMOD:	.WORD	0		;DL11 MESSAGE INPUT MODE FLAG (0=NO, 1=PENDING, -1=IN PROGRESS)
DLICRC:	.WORD	0		;DL11 INPUT CRC
DLIPTR:	.WORD	0		;DL11 INPUT BUFFER POINTER
DLICNT:	.WORD	0		;DL11 INPUT BYTE COUNT
DLIMSG:	.BLKB	MAXMSG+3	;DL11 INPUT MESSAGE BUFFER
	.EVEN
DLYMOD:	.WORD	0		;DELAY MODE FLAG
DLONWF:	.WORD	0		;DL11 OUTPUT NO-WAIT FLAG
MOMOD:	.WORD	0		;DL11 MESSAGE OUTPUT MODE FLAG (0=NO, 1=IN PROGRESS)
DLOCRC:	.WORD	0		;DL11 OUTPUT CRC
DLOPTR:	.WORD	0		;DL11 OUTPUT BUFFER POINTER
DLOCNT:	.WORD	0		;DL11 OUTPUT BYTE COUNT
DLOMSG:	.BLKB	HSIZE		;DL11 OUTPUT MESSAGE BUFFER
	.EVEN
DLOTMP:	.BLKB	MAXMSG+5	;TOHOST BUILDS MESSAGE HERE
KBCNT:	.BLKB	72.		;KEYBOARD INPUT COUNT BUFFER (FOR RUBOUTS)
KBCHR:	.BYTE	0		;KEYBOARD INPUT BUFFER
KBMODE:	.BYTE	0		;KEYBOARD MODE
	.EVEN
THPTR:	.WORD	0		;THREADED CODE POINTER
LASTMN:	.WORD	0		;LAST RECIEVED MESSAGE NUMBER
	.WORD	SCLXY+2		;POINTER TO TOP OF SCREEN COORD.
LINMAX:	.WORD	0		;SCROLLER MAX LINE COUNT
LINCT:	.WORD	0		;SCROLLER LINE COUNT
COLCNT:	.WORD	0		;COLUMN COUNTER
SCLPTR:	.WORD	SCLBUF		;SCROLLER BUFFER INPUT POINTER
ACKMSG:	.WORD	1,ACKCOD	;ACK MESSAGE
DLYMSG:	.WORD	0,DLYCOD	;DELAY MESSAGE
	.ENDC			;$ATEL
	.IF NE	HO$AT&<1-$ATEL>
IOSB:	.WORD	0,0,0,0,0,0,0,0	;STATUS RETURNS FOR RSX
MSGNUM:	.WORD	0		;CURRENT MESSAGE NUMBER
TRYCNT:	.WORD	0		;RETRY COUNTER
MOHDR:				;OUTPUT MESSAGE HEADER
	.REPT	SYNCT
	.BYTE	SYN
	.ENDR
	.BYTE	DLE,0		;(SECOND BYTE IS COUNT)
	.BYTE	0,0		;(TWO BYTES OF CRC)
MOMSG:	.BLKB	MAXMSG+3	;OUTPUT MESSAGE BUFFER
COMERR:	.ASCII	'COMMUNICATIONS FAILURE' ;WHAT WE HAVE HERE IS A FAILURE T'COMMUNICATE
	CESIZE=.-COMERR
	.IF NE	R$X11D!IA$
	X1.3=.-1
	N$$=4
	.REPT	<<MAXMSG+HSIZE+3>+2>/3
	.BYTE	N$$,N$$,N$$
	N$$=N$$+4
	.ENDR
	.ENDC			;R$X11D!IA$
MIHDR:	.BLKB	SYNCT+1		;INPUT MESSAGE HEADER
MISIZE:	.BYTE	0		;INPUT MESSAGE SIZE
	.BYTE	0,0		;INPUT MESSAGE CRC
MIMSG:	.BLKB	MAXMSG+3	;INPUT MESSAGE BUFFER
	.IF NE	R$X11D!IA$
	.BLKB	<MAXMSG+HSIZE+5>/3 ;1/3 EXTRA FOR 3 IN 4 PACKING
	.ENDC			;R$X11D!IA$
ASKMSG:				;ASK MESSAGE
	.REPT	SYNCT
	.BYTE	SYN
	.ENDR
	.BYTE	DLE,2
	.BYTE	0,0
ASKC:	.BYTE	ASKCOD
ASKS:	.BYTE	0,0,0
	.EVEN
MSIZE:	.WORD	0		;SIZE OF READ IN FRSAT
	.IF NE	R$X11D!IA$
	.WORD	0		;4/3 SIZE OF MESSAGE IN FRSAT
	.ENDC			;R$X11D!IA$
	.ENDC			;HO$AT&<1-$ATEL>
	.IF NE	RT$11
	.CSECT	GRDAT
	.BLKW	GRDSZ1		;RANDOM CRAP IN GRDAT
IATT:	.BLKW	ALSIZE		;ATTACH LIST
	.BLKW	GRDSZ2		;OTHER RANDOM STUFF
	.ENDC			;RT$11
	.IF NE	<$ATEL!<1-HO$AT>>&<1-RT$11>
	.PSECT	GRDAT,RW,D,GBL,REL,OVR
	.BLKW	GRDSZ1		;RANDOM CRAP IN GRDAT
IATT:	.BLKW	ALSIZE		;ATTACH LIST
	.BLKW	GRDSZ2		;OTHER RANDOM STUFF
	.ENDC			;<$ATEL!<1-HO$AT>>&<1-RT$11>
	.IF NE	$ATEL&<1-F4PLU$>
	.PSECT	$$AOTS,D
$OTSVA:
$SEQC:	.WORD	0		;F4 OTS SEQUENCE NUMBER
$NAMC:	.WORD	0		;F4 OTS SUBROUTINE LINK
	.ENDC			;$ATEL&<1-F4PLU$>
	.END
                                                                                                                                                                                                                                                                                                                      