.NLIST	CND
;
;	/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
;	\						   /
	.IF	NDF,$PAPER
;	/	L A B F N S  -  R T - 1 1 		   \
	.ENDC
	.IF	DF,$PAPER
;	/	L A B F N S   -  PAPER TAPE		   \
	.ENDC
;	\						   /
;	/						   \
	.IF	NDF,$PAPER
;	\		DEC-11-LFOCB-A-LA		   /
	.ENDC
	.IF	DF,$PAPER
;	\		DEC-11-ORUMA-A-LA		   /
	.ENDC
;	/						   \
;	\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;
;	WRITTEN BY: BOB FRIEDENTHAL
;
;	COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION
;				MAYNARD, MASSACHUSETTS 01754
;
;
; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DEC ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT.
;
; THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A
; LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND
; CAN BE COPIED (WITH INCLUSION OF DEC'S COPYRIGHT
; NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY
; OTHERWISE BE PROVIDED IN WRITING BY DEC.
;
; DEC ASSUMES NO RESPONSIBILITY FOR THE USE 
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DEC.
;
	.TITLE	AR11-LPS/DR11-K/VT11/VT55 FUNCTIONS FOR FOCAL

	.SBTTL	COMMENTS


;THIS CODE INCLUDES FUNCTIONS FOR HANDLING THE AR11/LPS, THE DR11-K, AND THE
;VT55 UNDER BOTH RT11 AND PAPER TAPE FOCAL.  IT ALSO INCLUDES FUNCTIONS
;FOR HANDLING THE VT11 UNDER RT11 FOCAL.


;IT MAY BE ASSEMBLED TO INCLUDE ANY COMBINATION OF AVAILABLE RELATED FUNCTIONS.
;
;TO ASSEMBLE FOR RT11, DO NOT DEFINE '$PAPER'.
;THIS WILL PRODUCE CODE THAT INCLUDES GLOBAL STATEMENTS RELATING IT TO
;RT11 FOCAL.  USE RT11 LINK TO ADD IT TO RT11 FOCAL.
;
;TO ASEMBLE FOR PAPER TAPE USE, DEFINE '$PAPER'.
;THIS WILL PRODUCE CODE THAT ADDS ENTRIES TO THE PAPER TAPE FUNCTION TABLE,
;PATCHES THE HIGH ADDRESS OF FOCAL TO EQUAL THE BASE OF THE FUNCTIONS,
;AND ALLOWS FOR BUFFER ALLOCATION/DEALLOCATION FROM FOCAL'S FREE AREA.
;IN ADDITION. DEFINE 'CORE' AS EQUAL TO CORE SIZE IN BYTES (DEFAULT
;VALUE=100000(16K)).
;AR11/LPS FUNCTIONS FOR FOCAL

;THE FUNCTIONS IMPLEMENTED IN THIS CODE INCLUDE TEN FUNCTIONS FOR HANDLING
;THE AR11 OR LPS AND TWO GENERAL PURPOSE FUNCTIONS.

;AR11/LPS FUNCTIONS
;FCRT ALLOWS CREATION OF DISPLAYS USING THE DISPLAY REGISTERS
;FFRM ALLOWS SAVING AND RESTORING OF DISPLAY FILE TO AN RT11 FILE
;FSAM ALLOWS SAMPLING FROM THE A/D CHANNELS.
;FBUF ALLOWS CREATION OF A BUFFER IN MEMORY USABLE BY FSAM AS A RING BUFFER.
;FFIL ALLOWS SAMPLES TO BE WRITTEN AUTOMATICALLY TO A VIRTUAL FILE.(RT11 ONLY)
;FDMA ALLOWS DIRECT MEMORY ACCESS SAMPLING VIA AN LPS.
;FLED ALLOW LOADING OF THE LEDS ON THE LPS.
;FTIC AND FDLY HANDLE THE CLOCK.
;FTOI ALLOWS SAVING TIME OF INTERRUPT THROUGH A SPECIFIED VECTOR.

;GENERAL PURPOSE
;FFNS ALLOWS EXECUTION OF ITS ARGUMENTS SEQUENTIALLY.
;FBIT ALLOWS BIT SETTING, CLEARING, COMPLEMENTING AS WELL AS WORD ORIENTED
;	LOGICAL AND, OR, XOR.

;DEFINING ANY COMBINATION OF THE SYMBOLS BELOW WILL ASSEMBLE THE
;FUNCTIONS SPECIFIED IN THE LIST,

;	SYMBOL			FUNCTIONS DEFINED
;
;	CRT			FCRT, DISPLAY HANDLER
;				FTIC, CLOCK HANDLER
;				FDLY, CLOCK WAIT FUNCTION
;	FRM			FFRM, DISPLAY SAVE/RESTORE
;				FCRT, DISPLAY HANDLER
;				FTIC, CLOCK HANDLER
;				FDLY, CLOCK WAIT FUNCTION
;	SAM				FSAM, A/D HANDLER
;				FBUF, BUFFER ALLOCATER
;				FTIC, CLOCK FUNCTION
;				FDLY, CLOCK WAIT FUNCTION
;	BUF			FBUF, BUFFER ALLOCATER
;	FIL			FFIL, A/D FILE OUTPUTTER (RT11 ONLY)
;				FSAM
;				FBUF
;	DMA			FDMA, DIRECT MEMORY ACCESS SAMPLING
;				FSAM
;				FBUF
;	LED			FLED, LPS LED LOADING FUNCTION
;	TIC			FTIC, AR11 CLOCK FUNCTION
;				FDLY, CLOCK WAIT FUNCTION
;	TOI			FTOI, TIME OF INTERRUPT (ONLY IF TIC DEFINED)
;	FNS			FFNS, SERIES FUNCTION EXECUTER
;	BIT			FBIT, BIT SET/RESET FUNCTION


;THE FTOI FUNCTION ALLOWS BY DEFAULT ROOM FOR 8 VECTOR ADDRESSES.
;TO SET THE NUMBER OF VECTOR ADDRESSES IT CAN SAVE, DEFINE
;'TIMES' TO EQUAL THIS NUMBER.


;IF UNDEFINED AT ASSEMBLY TIME , 'REG' HAS THE VALUE 170400 INDICATING THE
;BASE OF AR11/LPS DEVICE REGISTERS AND 'VEC' HAS THE VALUE OF '340' INDICATING
;THE FISRT AR11/LPS INTERRUPT VECTOR ADDRESS.  FOR HARDWARE CONFIGURATIONS
;WITH DIFFERENT ADDRESSES DEFINE ONE OR BOTH OF THESE SYMBOLS TO THE
;HAVE THE VALUES OF THE NEW ADDRESSES.


;THE VT11 FUNCTIONS

;DEFINING 'VT11' AT ASSEMBLY TIME INCLUDES THE 14 FUNCTIONS FOR
;HANDLING THE VT11 DISPLAY PROCESSOR:

;VT11 FUNCTIONS
;FVT ALLOWS CREATION OF THE DISPLAY FILE AND TURNING THE DISPLAY
;	ON AND OFF.
;FVEC ALLOWS LOADING OF VISIBLE RELATIVE VECTORS.
;FMOV ALLOWS LOADING OF INVISIBLE RELATIVE VECTORS.
;FPT ALLOWS LOADING OF ABSOLUTE POINTS.
;FSET ALLOWS LOADING OF INVISIBLE ABSOLUTE POINTS.
;FTXT ALLOWS LOADING OF CHARACTERS.
;FSPC ALLOWS LOADING SPECIAL CHARACTERS.
;FDIS ALLOWS CHOOSING THE MODE OF THE NEXT ELEMENT LOADED.
;FSKP ALLOWS LOADING OF DISPLAY JUMPS.
;FCLR ALLOWS CLEARING OF THE DISPLAY FILE.
;FXCO AND FYCO ALLOW RETURNING OF X AND Y COORDINATES RESPECTIVELY
;	OF INDIVIDUAL DISPALY ELEMENTS.
;FLP ALLOWS READING THE THE ELEMENT LAST HIT BY THE LIGHT PEN.
;FSCR ALLOWS ALTERATION OF VT11 TTY I/O SCROLLING.

;THE VT11 FUNCTIONS MAY BE ASSEMBLED WITH ANY OR ALL OR NONE OF THE OTHER
;FUNCTIONS.


;IF UNDEFINED AT ASEMBLY TIME, THE SYMBOL 'VTREG' HAS THE
;VALUE 172000.  IF THE VT11 STATUS REGISTER IS AT AN ADDRESS OTHER THAN
;172000, DEFINE 'VTREG' TO HAVE THE VALUE OF THE NEW ADDRESS.
;IF UNDEFINED AT ASSEMBLY TIME, THE SYMBOL 'VTVEC' HAS THE VALUE
;320.  IF THE STOP INTERRUPT VECTOR FOR THE VT11 HAS A DIFFERENT VALUE,
;DEFINE 'VTVEC' AT ASSEMBLY TIME TO HAVE THIS OTHER VALUE.


;VT55 FUNCTIONS

;EIGHT FUNCTIONS ALLOW FOCAL TO ACCESS THE VT55.  SIX OF THE FUNCTIONS
;ACCESS THE GRAPHICS CAPABILITIES, TWO THE ALPHAMERIC CPABILITIES.

;FGRA TURNS GRAPHICS MODE ON AND OFF
;FGRD ALLOWS THE FOCAL PROGRAM TO DRAW A GRID
;FXY ALLOWS THE FOCAL PROGRAM TO DRAW POINTS AND LINES
;FMD0 AND FMD1 ALLOWS THE FOCAL PROGRAM TO TURN VARIOUS GRAPHICS FEATURES
;	ON AND OFF
;FMRK ALLOW THE FOCAL PROGRAM TO DISPLAY THE CURSORS
;FCUR ALLOWS THE FOCAL PROGRAM TO MOVE THE ALPHAMERIC CURSOR
;FALP ALLOWS THE FOCAL PROGRAM TO OUTPUT ESCAPE SEQUENCE COMMANDS

;DEFINING THE SYMBOL 'VT55' AT ASSEMBLY TIME PRODUCES CODE THAT INCLUDES
;ALL THE VT55 FUNCTIONS.


;USER DEFINABLE CONDITIONAL ASSEMBLY SYMBOLS

;	$PAPER=0
;	CORE=100000
;	VT55=1
;	ARLPS=1
	.IF	DF,ARLPS
	CRT=0
	FRM=0
	SAM=0
	DMA=0
	LED=0
	TIC=0
	TOI=0
	FNS=0
	BIT=0
	.ENDC
;	VT11=0


;CONDITIONAL ASSEMBLY IMPLIED DEFINITIONS

	.IF	DF,FRM
	CRT=0
	.ENDC

	.IF	DF,CRT
	TIC=0
	.ENDC

	.IF	DF,FIL
	BUF=0
	.ENDC

	.IF	DF,DMA
	BUF=0
	.ENDC


	.IF	DF,SAM
	BUF=0
	TIC=0
	.ENDC


	.SBTTL	ASSIGNMENTS AND DEFINITIONS

	.IF	NDF,$PAPER
	.GLOBL	FPMP,EVAL.X,SORTC,GETC,OUTCH
	.GLOBL	REQM,CLRM,IDENT
	.MCALL	.WRITC
	.ENDC

	.MCALL	..V2..,.REGDEF
	..V2..
	.REGDEF

;REGISTER DEFINITIONS
	TEMP=R0
	AC=R1
	PTR=R2
	AXOUT=R3
	CHAR=R4

;EMT CODES
	EMT=007000

	FGET=EMT+00
	FADD=EMT+10
	FSUB=EMT+20
	FDIV=EMT+30
	FMUL=EMT+40
	FPOW=EMT+50
	FPUT=EMT+60
	FINT=EMT+71
	FSGN=EMT+72
	FABS=EMT+73
	FNEG=EMT+74
	FLOAT=EMT+75
	FZER=EMT+77

	DIRECT=0
	IPTR=1
	XPTR=2
	INTO=3
	FROM=3
	THROUGH=4
	IMMED=5
	REL=6

;AR11 REGISTER DEFINITIONS

	.IF	NDF,REG		;IF REG NOT DEFINED,
	REG=170400		;REGISTERS START AT 170400
	.ENDC
	.IF	NDF,VEC		;IF VEC NOT DEFINED,
	VEC=340			;VECTORS START AT 340
	.ENDC
	ADSTA=REG		;A/D STATUS REGISTER
	ADBUF=REG+2		;A/D BUFFER
	CKSTA=REG+4		;CLOCK STATUS
	CKBUF=REG+6		;CLOCK BUFFER.PRESET
	DSTA=REG+10		;DISPLAY STATUS
	XC=REG+12		;X REGISTER
	YC=REG+14		;Y REGISTER
	DMAADR=REG+36		;DMA REGSITER ON LPS

	ADV=VEC			;A/D VECTOR
	ADP=VEC+2
	CKV=VEC+4		;CLOCK VECTOR
	CKP=VEC+6
	DV=VEC+10		;DISPLAY VECTOR
	DP=VEC+12


;GLOBAL DEFINITIONS
	.IF	DF,$PAPER
	.ASECT

	TRAP=104400
	ERROR=TRAP
	ERASEV=TRAP+236
	GETC=TRAP+214
	SORTC=TRAP+202
	OUTCH=TRAP+210
	EVAL.X=TRAP+260
	FPMP=TRAP+262


	FBASE=1050
	FLAC=1610
	BOTTOM=2310

	.IF	NDF,CORE
	CORE=40000		;DEFAULT CORE SIZE (8K) IF CORE UNDEFINED
	.ENDC
	LOADER=300		;LOADER SIZE
	STACK=6			;FNEW STACK SIZE
	FS=0			;SET FUNCTION SIZE TO 0
	FTOP=CORE-STACK-LOADER	;SET TOP OF USABLE MEMORY
	FB=FBASE		;SET TO POINT TO FUNCTION LIST
	.ENDC
	.IF	NDF,$PAPER
;GLOBAL DEFINITIONS
	.GLOBL	PARAM		;ADDRESS OF PARAMETER TABLE IN FOCAL
	.GLOBL	L.CHAN,C.BUF,C.BLK,L.WRT,L.OPEN
	.GLOBL	L.CHAN,GCHAN
	.GLOBL	DMPBLK,NXTBLK
	.MCALL	.INTEN
	ERROR=104400

	.ENDC
;MISCELLANEOUS
	SPACE=200		;INTERNAL SPACE
	PLUS=201		;INTERNAL PLUS
	MINUS=202		;INTERNAL MINUS

	.IF	DF,$PAPER
	PARAM=2326		;ADDRESS OF PARAMETER TABLE IN FOCAL
	.ENDC
	.IF	DF,CRT
	.SBTTL	GRAPHICS ROUTINES


	.IF	NDF,$PAPER
	.GLOBL	FCRT
	.ENDC
	.IF	DF,$PAPER
	FCRTS=3746		;SIZE OF FUNCTION
	FB=FB-4			;EXTEND TABLE UP
	.=FB			;POINT TO BASE OF FUNCTION TABLE
	.WORD	0,0		;END TABLE WITH TWO 0'S
	.WORD	FCRT		;INSERT ADDRESS
	.WORD	13514		;HASH CODE FOR FCRT

	FS=FS+FCRTS		;INCREASE SIZE OF FUNCTION AREA
	.=FTOP-FS		;SET START OF FUNCTION
	.ENDC
	.SBTTL		SCALE ROUTINE

;SCALING FUNCTION
;FCRT(-N),N<=5
;SETS THE SCALING OF CHARACTERS TO 2**(N-1) TIMES THE
;SMALLEST SCALING.  IT DOES THIS  BY SHIFTING EACH BYTE IN THE BYTE
;MAP UNTIL THE REQUESTED SCALING MATCHES THE BYTE MAP SCALING.
;IN SO DOING IT ALSO SHIFTS THE BYTE WHICH INDICATES DISTANCE
;BETWEEN CHARACTER COLUMNS.  IT USES THIS BYTE TO DETERMINE
;WHEN IT HAS ACHIEVED CORRECT SCALING.

SCAL:	NEG	TEMP		;GET ARG POSITIVE
	MOV	#1,AC		;SET REGISTER LO BIT
ROLS:	DEC	TEMP		;AND GET POWER OF 2 FROM ARG
	BLE	1$
	ASL	AC
	CMP	AC,#20		;ALLOW MAX SCALE OF 5
	BGE	1$
	BR	ROLS
1$:	MOV	#ASLB+10,SHIFT	;SET FOR SHIFT LEFT
LOOPS:	CMPB	AC,SCALE	;THEN IF ALL SCALED,
	BEQ	DUNSC		;DONE SCALING
	BGT	2$		;IF SCALING CURRENTLY TOO BIG,
	MOV	#ASRB+10,SHIFT	;SHIFT RIGHT
2$:	MOV	#SCALE,TEMP	;POINT TO SCALE WORD
LOOPT:	CMP	TEMP,#ENDMAP	;IF REACHED END,
	BGE	LOOPS		;GO SEE IF ALL DONE
	TSTB	(TEMP)		;ELSE, IF DELIMITER BYTE,
	BLT	COLBYT		;DON'T SCALE IT
SHIFT:	ASLB	(TEMP)		;ELSE SHIFT
COLBYT:	INC	TEMP		;PT. TO NEXT BYTE
	BR	LOOPT		;AND GO DO IT

DUNSC:	MOVB	SCALE,TEMP	;SET REAL X INTERVAL
	ASL	TEMP
	.IF	NDF,LPS
XBR:	BR	.+4		;EITHER BRANCH OR SHIFT LEFT
	.ENDC
	.IF	DF,LPS
XBR:	ASL	TEMP
	.ENDC
	ASL	TEMP
	MOV	TEMP,(PC)+
SBYT:	.WORD	0		;(ACTUAL DISTANCE BET. COLUMNS)
	MOV	TEMP,-(SP)	;NOW GET 9*COLUMN DISTANCE
	ASL	(SP)		;AS LINE SIZE
	ASL	(SP)
	ASL	(SP)
	ADD	TEMP,(SP)
	MOV	(SP)+,(PC)+	;WHICH SAVE
LINSIZ:	.WORD	0		;(DIST. BET. LINES)
	RTS	PC


	.SBTTL		FCRT ROUTINE



ONOFF:	TST	TEMP		;IF 1 ARG, AND ARG=0,
	BEQ	OFFD		;GO STOP DISPLAY
	BLT	SCAL		;IF <0, SCALE BYTE MAP
GODISP:	TST	DBUFF		;IF NO BUFFER,
	BEQ	NOBUFF		;DISALLOW DISPLAY
	MOV	TEMP,(PC)+	;THE 2ND ARG GIVES NUMBER OF PASSES
PASSES:	.WORD	0		;(PASSES EACH TIME DISP CALLED)
ON:	MOV	TCOUNT,CURCNT	;SET TICKS PER 1/20TH SECOND ON CLOCK
	RTS	PC


OFFD:	CLR	PASSES		;STOP DISPLAY AFTER NEXT PASS
	RTS	PC		;RETURN 0 FROM FLAC

NOBUFF:	FPMP			;ON NO BUFFER, RETURN 0
	.WORD	FZER
	RTS	PC

;FCRT FUNCTION
;FCRT CAN BE CALLED WITH 1, 2, OR 3 ARGUMENTS.
;FCRT(N),N<>0			TURNS DISPLAY ON EXECUTING !N! PASSES
;				THEN WAITING 4 CLOCK TICKS.
;				ON FAILURE (NO FILE AVAILABLE), RETURNS
;				0
;FCRT(0)			STOPS DISPLAY
;FCRT(0,N),N<>0			SET UP A DISPLAY FILE USING !N! TO DETERMINE THE
;				LEAST NUMBER OF BLOCKS TO FURNISH
;				!N! LOCS. TAKES N MOD 4 BLOCKS. RETURNS ACTUAL
;				NUMBER OF LOCS AVAILABLE.
;FCRT(0,0)			RETURNS DISPLAY FILE.  STOPS DISPLAY.
;FCRT(N,A),N<>0			IN LOC !N! INSERTS THE CHARACTER IN 'A'
;				MOD 100.
;FCRT(N,X,Y),N<>0		INSERT A POINT IN LOC !N!.  IT DETERMINES
;				A RELATIVE COORDINATE IF ARGUEMENT PRE-
;				CEEDED BY + OR - SIGN, AN INVISLBE ABS.
;				POINT IF ARGUMENT >1024 OR 4096.

FCRT:	FPMP			;GET FLAC INTO AC
	FINT
	MOV	AC,TEMP		;AND SAVE IT
	SORTC			;2ND ARG?
	RTPAR
	ONOFF			;IF NOT, PROCESS ON/OFF
	TST	TEMP		;ELSE, FIRST ARG=0?
	BNE	ADDISP		;IF NOT, GO ADD GRAPHICS
KILBUF:	JSR	PC,OFFD		;ON FCRT(0,N) KILL ANY EXISTING DISPLAY BUFFER
	.IF	NDF,$PAPER
	MOV	#1,IDENT	;IDENTIFY THIS HUNK
	CLRM			;CLRM: RELEASE MEMORY
	.ENDC
	.IF	DF,$PAPER
	MOV	#1,TEMP		;ID 1
	CLR	AC		;DE-ALLOCATE
	JSR	PC,BUFALC
	.ENDC
	CLR	DBUFF		;SET ADDR OF BUFFER=0
	EVAL.X			;GET 2ND ARG
	FPMP			;AS INTEGER
	FABS			;FOR BUFFER CREATION/RELEASE
	FINT
	.IF	NDF,$PAPER
	ADD	#127.,AC	;CONVERT IT TO NEXT HIGHEST
	BIC	#177,AC		;MULTIPLE OF 128 FOR TRUE NUMBER OF LOCS
	FPMP			;AND PUT IT BACK IN FLAC RETURN
	FLOAT
	.ENDC
	ASL	AC		;DOUBLE IT TO WORD COUNT
	MOV	AC,(PC)+	;AND SAVE IT AS BUFFER LENGTH
DLEN:	.WORD	0		;(LENGTH IN WORDS OF DISPLAY FILE)
	BEQ	DUNSC		;0 REQUEST MEANS KILL BUFFER
	.IF	NDF,$PAPER
	SWAB	AC		;/256 FOR BLOCK COUNT
	BIC	#177400,AC
	MOV	AC,(PC)+	;AND SAVE COUNT
DBLOCK:	.WORD	0		;BLOCKS IN CURRENT DFILE
	MOV	AC,-(SP)	;REQUEST THIS MANY BLOCKS
	MOV	#1,IDENT	;UNDER ID #1
	REQM			;REQM: REQUEST MEMORY
	MOV	(SP)+,AC	;GET START ADDR. INTO PTR
	.ENDC
	.IF	DF,$PAPER
	MOV	#1,TEMP		;ID 1
	MOV	DLEN,AC		;LENGTH ARGUMENT
	JSR	PC,BUFALC	;ALLOCATE SPACE
	TST	AC		;IF NONE AVAILABLE
	BEQ	LOCN0		;RETURN A 0
	.ENDC
	MOV	AC,(PC)+	;AND SAVE IT, TOO
DBUFF:	.WORD	0		;(START ADDR. OF DFILE)
	MOV	DLEN,TEMP	;NOW PUT 177777 IN ENTIRE BUFFER
L17777:	MOV	#177777,(AC)+
	DEC	TEMP
	BGT	L17777
	CMP	-(AC),-(AC)	;BACK PTR UP 2 WORDS
	MOV	AC,(PC)+	;AND CALL THIS END OF BUFFER
EBUFF:	.WORD	0		;(END OF DFILE: LAST LOC ALWAYS 177777)
	MOV	#DSTA,TEMP	;SET FOR AR11 DISPLAY REGISTERS
	MOV	#176000,MOD	;AND SCREEN SIZE 1024.
	MOV	#401,ARBR	;AND FOR ASL ONLY ONCE
	MOV	#401,XBR	;IN TWO PLACES
	BIT	#20,@CKSR	;TEST AR11 BIT IN CLOCK STATUS,
	BNE	AR11		;THEN IF LPS,
	MOV	#6302,ARBR	;MOVE AN ASL R2 INTO DISPLAY ROUTINE
	MOV	#6300,XBR	;AND SCALING ROUTINE
	MOV	#170000,MOD	;SET SCREEN SIZE 4096.
	ADD	#6,TEMP		;AND ADD 6 TO REGISTER ADDRESSES
AR11:	MOV	TEMP,DSR	;NOW SET UP REGISTER ADDRESSES
	CLR	(TEMP)		;CLEAR THE STATUS REGISTER
	TST	(TEMP)+
	MOV	TEMP,X
	TST	(TEMP)+
	MOV	TEMP,Y
	MOV	#-2,TEMP	;ON BUFFER FUNCTION, SET DEFAULT SCALING TO 2
	JSR	PC,SCAL
	RTS	PC		;RETURN FLAC: ACTUAL LOCS



ADDISP:	MOV	TEMP,(PC)+	;ON >1 ARG & 1ST ARG<>0, ADD TO FILE
LOC:	.WORD	0		;(LOC TO ADD TO [FIRST ARG.])
	BGT	1$		;MAKE ARG>0
	NEG	TEMP
1$:	TST	DBUFF		;ON NO BUFFER,
	BNE	GUDBUF
	CLR	LOC		;SET FOR 0 RETURN
	MOV	#SIMBUF,TEMP	;PT TO DUMMY ENTRY
	BR	INBUFF		;AND ALLOW INSERT THERE
GUDBUF:	DEC	TEMP
	ASL	TEMP		;CHANGE LOC NUMBER TO WORD OFFSET
	ASL	TEMP
	ADD	DBUFF,TEMP	;INTO DISPLAY FILE
	CMP	TEMP,EBUFF	;IF BEYOND FILE,
	BLT	INBUFF
	MOV	DBUFF,TEMP	;PT. TO START  OF BUFFER INSTEAD
	MOV	#1,LOC		;AND SET TO RETURN LOC 2
INBUFF:	MOV	TEMP,-(SP)	;IF GOOD LOC, SAVE ITS ADDRESS
	JSR	PC,SEVAL	;AND GET ARG.2 INTO TEMP AS INSTRUCTION
	SORTC			;IF ONLY TWOARGS,
	RTPAR
	TWOARG			;GO ADD A CHARACTER
	MOV	TEMP,@(SP)	;ELSE, INSERT INSTR. IN WORD 1
	JSR	PC,SEVAL	;AND GET THIRD ARG AS INSTRUCTION
	MOV	(SP)+,AC	;RETRIEVE LOC ADDRESS
	TST	(AC)+		;PT. TO WORD 2
	MOV	TEMP,(AC)+	;THEN 2ND
LOCOUT:	MOV	LOC,AC		;THEN RETURN LOC+1
	BEQ	LOCN0		;ON LOC=0, RETURN 0
	BGE	POSLOC
	NEG	AC		;ON LOC<0, MAKE IT POSITIVE
POSLOC:	INC	AC		;ON ARG>0, RETURN LOC+1
LOCN0:	FPMP
	FLOAT
	RTS	PC




;SIMBUF IS A DUMMY ENTRY USED WHEN A THE USER LOADS A LOC
;WITHOUT HAVING CREATED A DISPLAY FILE.  ITS USE IS
;TO SAVE CODE ONLY.

SIMBUF:	.BLKW	2		;DUMMY LOC FOR WHEN NO BUFFER


	.SBTTL		CHARACTER ENTRY ROUTINE

;ROUTINE TO ENTER A CHARACTER IN THE DISPLAY FILE
;IT LOOKS UP THE ADDRESS OF THE CHARACTER IN THE BYTE MAP ADDRESS
;TABLE AND INSERTS IT IN WORD 2 OF THE LOC.  THEN IT
;INSERTS THE CHARACTER INSTRUCTION, 140000, IN WORD 1.  THE ORDER OF
;INSERTION ELIMINATES THE POSSIBLITY OF THE DISPLAY ROUTINE EXECUTING
;A CHARACTER INSTRUCTION WITH AN ILLEGAL ADDRESS.

TWOARG:	ASL	TEMP		;CONVERT CHAR TO WORD OFFSET
	TST	LOC		;IF LOC<0 AND CHARACTER WANTED
	BGE	ASCHAR
	BIC	#177760,TEMP	;USE SPECIAL CHARACTERS
	ADD	#CONTRL,TEMP
	BR	GETADD
ASCHAR:	BIC	#177600,TEMP	;IF 2ND >0, GET 2ND MOD 200
INRANG:	ADD	#CHART,TEMP	;INTO BYTE ADDRESS TABLE
GETADD:	MOV	(TEMP),TEMP	;AND GET CHARACTER'S ADDRESS
CHARIN:	MOV	(SP)+,AC	;RETRIEVE LOC ADDR.
	MOV	TEMP,2(AC)	;INSERT ADDRESS AS WORD 2
	MOV	#140000,(AC)	;CHARACTER INSTRUCTION AS WORD 1
LOCV:	BR	LOCOUT		;AND RETURN LOC+1
	.SBTTL		DISPLAY PROCESSOR

;DISPLAY ROUTINE

;DISPLAY PROCESSOR
;THE DISPLAY ROUTINE EXECTUTES AT INTERRUPT LEVEL, PRIORITY 0, EACH TIME THE CLOCK
;INTERRUPT ROUTINE HAS SERVICED A SPECIFIED NUMBER OF CLOCK TICKS.
;IT RETURNS VIA AN RTI.  WHILE IT EXECUTES, THE CLOCK INTERRUPT
;ROUTINE CAN CONTINUE TO SERVICE CLOCK INTERRUPTS.  ONLY WHEN
;IT EXITS DOES DISP RE-ENABLE ITSELF FOR OPERATION.
;EACH TIME IT IS CALLED, IT GOES THROUGH THE DISPLAY FILE EXECUTING
;THE GRAPHICS INSTRUCTIONS IT FINDS THERE.  IT MAKES AS MANY PASSES
;THROUGH THE FILE AS THE USER HAS REQUESTED IN THE FCRT(N) FUNCTION.
;THERE ARE BASICALLY FOUR KINDS OF GRAPHICS INSTRUCTIONS:
;ABSOLUTE PT.S, INVISIBLE ABSOLUTE PT.S, RELATIVE PT.S AND CHARACTERS.
;THE TOP 2 BITS OF THE FIRST WORD IN EACH LOC INDICATE THE TYPE OF 
;INSTRUCTION THAT WORD, OR LOC, CONTAINS AS FOLLOWS:
;	BITS 15 AND 14		INSTRUCTION
;		00		ABSOLUTE POINT
;		01		INV. ABS. PT.
;		10		RELATIVE PT.
;		11		CHARACTER
;
;IF THE FIRST WORD DOES NOT INDICATE CHARACTER, THEN EACH WORD
;IN THE LOC IS INTERPRETTED AS A COORDINATE, X COORDINATE THEN Y
;COORDINATE.  EITHER MAY SPECIFY ABSOLUTE OR RELATIVE GRAPHICS.
;THE Y COORDINATE MAY ALSO SPECIFY AN INVISIBLE ABSOLUTE COORDINATE.
;IF THE FIRST WORD INDICATES A CHARACTER, THEN DISP TAKES THE
;SECOND WORD AS THE ADDRESS OF THE CHARACTER'S BYTE MAP.  IT INTERPRETS
;EACH BYTE IN THE BYTE MAP AS EITHER A Y OFFSET FROM THE CURRENT Y
;POSTION, AS A DELIMETER BETWEEN COLUMNS, OR AS AN END OF CHARACTER.
;ANY POSTIVE BYTE INDICATES AN OFFSET.  DISP WILL DRAW A POINT VERITCALLY
;ABOVE THE LAST POINT AT THE DISTANCE INDICATED BY THE BYTE.
;BYTE 200 MEANS GO TO NEXT COLUMN.  DISP CHANGES THE CURRENT
;X COORDINATE AS PER THE CURRENT SCALING AND RESETS THE CURRENT Y
;COORDINATE TO THE BASE OF THE CHARACTER, BUT DRAWS NO POINT.
;BYTE 300 MEANS END OF CHARACTER AND ALSO INCREMENTS THE CURRENT X.
;EACH BYTE IN THE BYTE MAP LEAVES THE VALUES IN THE X AND Y REGISTER
;AT THE LOWER RIGHT OF THE CHARACTER.

DISP:	MOV	TEMP,-(SP)	;SAVE REG.S
	MOV	AC,-(SP)
	MOV	R2,-(SP)
	MOV	PASSES,-(SP)	;GET NUMBER OF PASSES TODO
	BEQ	PT		;IF NO PASSES, NO DISPLAY
PASSD:	MOV	DBUFF,TEMP	;POINT TOSTART OF DFILE
	BNE	1$		;IF NO FILE, QUIT
	JMP	NOBUFF
1$:	CLRB	@DSR		;SET FOR INV. GRAPHICS
	JSR	PC,TSTSTA
	CLR	@X		;ON EACH PASS, CLEAR X,Y
	JSR	PC,TSTSTA
	CLR	@Y
VISIT:	MOVB	#10,@DSR	;THEN SET FOR VIS. GRAPHICS
LOOPX:	MOV	(R0),R1		;GET WORD 1 FROM LOC
	BLT	RLXCAR		;<0 MEANS REL OR CHAR OR END
	JSR	PC,TSTSTA
	MOV	(R0)+,@X	;ABS: SET X COORDINATE
LOOPY:	MOV	(R0),R1		;GET WORD 2
	BLT	RELY		;<0 MEANS RELATIVE
	ROL	R1		;BIT 14 SET MEANS INVISIBLE
	BPL	VIS
	CLRB	@DSR		;IF SO, SET NO DISPLAY ON Y
	JSR	PC,TSTSTA
	MOV	(R0)+,@Y	;IN EITHER CASE, SET Y REG.
	MOVB	#10,@DSR	;THEN RESET FOR VISIBLE.
	BR	LOOPX		;STATUS LOADS ONLY ON INV. PT. THIS WAY
VIS:	JSR	PC,TSTSTA	;WAIT FOR READY
	MOV	(R0)+,@Y	;ON VIS, LOAD Y REGISTER
	BR	LOOPX		;AND GO BACK FOR NEXT X

RLXCAR:	ROL	R1		;GET BIT 14 FROM INSTRUCTION
	BMI	CARDUN		;SET MEANS CHARACTER OR END OF FILE
	JSR	PC,TSTSTA
	ADD	(R0)+,@X	;ELSE, RELATIVE COORD, ADD IT TO X
	BR	LOOPY		;GET Y COORD
RELY:	JSR	PC,TSTSTA
	ADD	(R0)+,@Y	;ADD A RELATIVE Y COORD
	BR	LOOPX		;GO TO NEXT LOC

CARDUN:	ROL	R1		;IF BIT 13 SET
	BMI	DONE		;END OF BUFFER REACHED
	TST	(R0)+		;ELSE, A CHARACTER.  PT. TO WORD 2
	MOV	(R0)+,R1	;AND GET ADDR. OF BYTE MAP
	MOV	@Y,-(SP)	;SET START Y
	MOV	(SP),-(SP)	;AND CURRENT Y
LOPC:	MOVB	(R1)+,R2	;GET A BYTE FROM MAP
	BLT	INCDUN		;<0 MEANS END OR NEXT COLUMN
	ASL	R2		;SHIFT SIZE *4
ARBR:	.IF	NDF,LPS
	BR	.+4		;SHIFT FOR BIG SCREEN. BR IF NOT
	.ENDC
	.IF	DF,LPS
	ASL	R2
	.ENDC
	ASL	R2
	ADD	R2,(SP)		;ELSE, ADD TO CURRENT Y
	JSR	PC,TSTSTA
	MOV	(SP),@Y		;AND MOVE CURRENT Y TO Y REG.
	BR	LOPC		;GET NEXT BYTE

INCDUN:	JSR	PC,TSTSTA
	ADD	SBYT,@X		;CURRENT SCALE
	MOV	2(SP),(SP)	;SET Y BACK TO BASE
	ROLB	R2		;THEN IF BIT 6 NOT SET,
	BPL	LOPC		;GO ON TO NEXT BYTE
	TST	(SP)+		;ELSE, RID CURRENT Y
	JSR	PC,TSTSTA
	ROLB	R2		;IF BIT 377
	BPL	NOTNUL
	ROLB	R2
	BPL	NULLC
	ROLB	R2
	BPL	LFC
	ROLB	R2
	BPL	UPSPC
	ROLB	R2
	BPL	CRC
	TST	(SP)+		;RID Y
	BR	DONE
NULLC:	SUB	SBYT,@X		;IF BYTE 340, LEAVE X AS IT STARTED
	BR	SET		;TO CREATE NULL CHARACTER


LFC:	SUB	LINSIZ,(SP)	;SUBTRACT LINE SIZE FROM Y
	BR	SET

CRC:	CLR	@X		;SET X TO LEFT SIDE OF SCREEN
	BR	SET

UPSPC:	ADD	LINSIZ,(SP)	;SET Y UP ONE LINE
	BR	SET
NOTNUL:	ADD	SBYT,@X		;ELSE, OUTPUT A SPACE
SET:	CLRB	@DSR
	JSR	PC,TSTSTA	;THEN SET Y TO  BASE OF  CHAR
	MOV	(SP)+,@Y
	BR	VISIT		;AND END THIS CHARACTER
DONE:	DEC	(SP)		;ELSE, DO NEXT PASS
	BGT	PASSD
	MOV	TCOUNT,CURCNT	;TURN DISPLAY BACK ON
PT:	TST	(SP)+		;RID COUNTER FROM STACK
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,AC
	MOV	(SP)+,TEMP
	RTS	PC		;RETURN TO CLOCK ROUTINE

TSTSTA:	TSTB	@DSR
	BPL	TSTSTA
	RTS	PC
	.SBTTL		CHARACTER TABLE

;CONTRL CONTAINS THE ADDRESSES OF THE 5 SPECIAL CHARACTERS

CONTRL:	.WORD	NULL
	.WORD	LF
	.WORD	UPSP
	.WORD	CR
	.WORD	EOF

;CHART CONTAINS THE ADDRESSES OF ALL 64 DISPLAYABLE CHARACTERS

CHART:	.WORD	AT
	.WORD	A
	.WORD	B
	.WORD	C
	.WORD	D
	.WORD	E
	.WORD	F
	.WORD	G
	.WORD	H
	.WORD	I
	.WORD	J
	.WORD	K
	.WORD	L
	.WORD	M
	.WORD	N
	.WORD	O
	.WORD	P
	.WORD	Q
	.WORD	R
	.WORD	S
	.WORD	T
	.WORD	U
	.WORD	V
	.WORD	W
	.WORD	EXX
	.WORD	WHY
	.WORD	Z
	.WORD	LTB
	.WORD	SLASH
	.WORD	RTB
	.WORD	UPARR
	.WORD	UNDER
	.WORD	BLANK
	.WORD	EXCLAM
	.WORD	QUOTE
	.WORD	NUMBER
	.WORD	DOLLAR
	.WORD	PCENT
	.WORD	ANDS
	.WORD	SQUOTE
	.WORD	LPAR
	.WORD	RPAR
	.WORD	STAR
	.WORD	PLUSS
	.WORD	COMMA
	.WORD	MINUSS
	.WORD	PERIOD
	.WORD	BACKSL
	.WORD	N0
	.WORD	N1
	.WORD	N2
	.WORD	N3
	.WORD	N4
	.WORD	N5
	.WORD	N6
	.WORD	N7
	.WORD	N8
	.WORD	N9
	.WORD	COLON
	.WORD	SEMICO
	.WORD	LANG
	.WORD	EQUAL
	.WORD	RANG
	.WORD	QUEST

;CHARACTER BYTE MAP AND SCALING BYTE

SCALE:	.BYTE	1		;CURRENT SCALING
AT:	.BYTE	 1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 0,2,1,1,2,200 
	.BYTE	 0,2,1,3,200 
	.BYTE	 0,3,1,1,300 
A:	.BYTE	 0,1,1,1,1,200 
	.BYTE	 2,3,200 
	.BYTE	 2,4,200 
	.BYTE	 2,3,200 
	.BYTE	 0,1,1,1,1,300 
B:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 1,1,2,1,300 
C:	.BYTE	 1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 1,4,300 
D:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 1,1,1,1,1,300 
E:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,6,300 
F:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 3,3,200 
	.BYTE	 3,3,200 
	.BYTE	 3,3,200 
	.BYTE	 6,300 
G:	.BYTE	 1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 0,2,4,200 
	.BYTE	 0,1,1,4,300 
H:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 3,200 
	.BYTE	 3,200 
	.BYTE	 3,200 
	.BYTE	 0,1,1,1,1,1,1,300 
I:	.BYTE	 200 
	.BYTE	 0,6,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 300 
J:	.BYTE	 1,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 1,1,1,1,1,1,300 
K:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 3,200 
	.BYTE	 2,2,200 
	.BYTE	 1,4,200 
	.BYTE	 0,6,300 
L:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 0,300 
M:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 5,200 
	.BYTE	 3,1,200 
	.BYTE	 5,200 
	.BYTE	 0,1,1,1,1,1,1,300 
N:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 4,200 
	.BYTE	 3,200 
	.BYTE	 2,200 
	.BYTE	 0,1,1,1,1,1,1,300 
O:	.BYTE	 1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 1,1,1,1,1,300 
P:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 3,3,200 
	.BYTE	 3,3,200 
	.BYTE	 3,3,200 
	.BYTE	 4,1,300 
Q:	.BYTE	 1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 0,2,4,200 
	.BYTE	 1,5,200 
	.BYTE	 0,2,1,1,1,300 
R:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 3,3,200 
	.BYTE	 2,1,3,200 
	.BYTE	 1,2,3,200 
	.BYTE	 0,4,1,300 
S:	.BYTE	 1,3,1,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 1,1,3,300 
T:	.BYTE	 6,200 
	.BYTE	 6,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 6,200 
	.BYTE	 6,300 
U:	.BYTE	 1,1,1,1,1,1,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 1,1,1,1,1,1,300 
V:	.BYTE	 2,1,1,1,1,200 
	.BYTE	 1,200 
	.BYTE	 0,200 
	.BYTE	 1,200 
	.BYTE	 2,1,1,1,1,300 
W:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 1,200 
	.BYTE	 2,1,200 
	.BYTE	 1,200 
	.BYTE	 0,1,1,1,1,1,1,300 
EXX:	.BYTE	 0,1,4,1,200 
	.BYTE	 2,2,200 
	.BYTE	 3,200 
	.BYTE	 2,2,200 
	.BYTE	 0,1,4,1,300 
WHY:	.BYTE	 5,1,200 
	.BYTE	 4,200 
	.BYTE	 0,1,1,1,200 
	.BYTE	 4,200 
	.BYTE	 5,1,300 
Z:	.BYTE	 0,1,5,200 
	.BYTE	 0,2,4,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,4,2,200 
	.BYTE	 0,5,1,300 
LTB:	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,300 
SLASH:	.BYTE	 5,200 
	.BYTE	 4,200 
	.BYTE	 3,200 
	.BYTE	 2,200 
	.BYTE	 1,300 
RTB:	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 0,6,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,1,1,1,1,1,1,300 
UPARR:	.BYTE	 2,200 
	.BYTE	 3,200 
	.BYTE	 4,200 
	.BYTE	 3,200 
	.BYTE	 2,300 
UNDER:	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 0,200 
	.BYTE	 0,300 
BLANK:	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 300 
EXCLAM:	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 0,2,1,1,1,1,200 
	.BYTE	 200 
	.BYTE	 300 
QUOTE:	.BYTE	 200 
	.BYTE	 4,1,1,200 
	.BYTE	 200 
	.BYTE	 4,1,1,200 
	.BYTE	 300 
NUMBER:	.BYTE	 2,2,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 2,2,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 2,2,300 
DOLLAR:	.BYTE	 1,3,200 
	.BYTE	 1,2,2,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 1,2,2,200 
	.BYTE	 2,3,300 
PCENT:	.BYTE	 1,4,1,200 
	.BYTE	 2,3,1,200 
	.BYTE	 3,200 
	.BYTE	 0,1,3,200 
	.BYTE	 0,1,4,300 
ANDS:	.BYTE	 1,1,2,1,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,2,2,1,200 
	.BYTE	 1,200 
	.BYTE	 0,2,300 
SQUOTE:	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 4,1,1,200 
	.BYTE	 200 
	.BYTE	 300 
RPAR:	.BYTE	 2,1,1,200 
	.BYTE	 1,4,200 
	.BYTE	 0,6,200 
	.BYTE	 200 
	.BYTE	 300 
LPAR:	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 0,6,200 
	.BYTE	 1,4,200 
	.BYTE	 2,1,1,300 
STAR:	.BYTE	 1,4,200 
	.BYTE	 2,2,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 2,2,200 
	.BYTE	 1,4,300 
PLUSS:	.BYTE	 3,200 
	.BYTE	 3,200 
	.BYTE	 1,1,1,1,1,200 
	.BYTE	 3,200 
	.BYTE	 3,300 
COMMA:	.BYTE	 200 
	.BYTE	 0,200 
	.BYTE	 1,1,200 
	.BYTE	 200 
	.BYTE	 300 
MINUSS:	.BYTE	 3,200 
	.BYTE	 3,200 
	.BYTE	 3,200 
	.BYTE	 3,200 
	.BYTE	 3,300 
PERIOD:	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 0,200 
	.BYTE	 200 
	.BYTE	 300 
BACKSL:	.BYTE	 1,200 
	.BYTE	 2,200 
	.BYTE	 3,200 
	.BYTE	 4,200 
	.BYTE	 5,300 
N0:	.BYTE	 1,1,1,1,1,200 
	.BYTE	 0,2,4,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,4,2,200 
	.BYTE	 1,1,1,1,1,300 
N1:	.BYTE	 200 
	.BYTE	 0,5,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 0,200 
	.BYTE	 300 
N2:	.BYTE	 0,1,4,200 
	.BYTE	 0,2,4,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,4,1,300 
N3:	.BYTE	 1,5,200 
	.BYTE	 0,6,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,1,2,200 
	.BYTE	 1,1,3,1,300 
N4:	.BYTE	 2,1,200 
	.BYTE	 2,2,200 
	.BYTE	 2,3,200 
	.BYTE	 0,1,1,1,1,1,1,200 
	.BYTE	 2,300 
N5:	.BYTE	 1,3,1,1,200 
	.BYTE	 0,4,2,200 
	.BYTE	 0,4,2,200 
	.BYTE	 0,4,2,200 
	.BYTE	 1,1,1,3,300 
N6:	.BYTE	 1,1,1,1,200 
	.BYTE	 0,3,2,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 1,1,4,300 
N7:	.BYTE	 6,200 
	.BYTE	 0,1,1,4,200 
	.BYTE	 3,3,200 
	.BYTE	 4,2,200 
	.BYTE	 5,1,300 
N8:	.BYTE	 1,1,2,1,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 1,1,2,1,300 
N9:	.BYTE	 0,4,1,200 
	.BYTE	 0,3,3,200 
	.BYTE	 0,3,3,200 
	.BYTE	 1,2,3,200 
	.BYTE	 2,1,1,1,300 
COLON:	.BYTE	 200 
	.BYTE	 200 
	.BYTE	 2,2,200 
	.BYTE	 200 
	.BYTE	 300 
SEMICO:	.BYTE	 200 
	.BYTE	 0,200 
	.BYTE	 1,1,2,200 
	.BYTE	 200 
	.BYTE	 300 
LANG:	.BYTE	 3,200 
	.BYTE	 2,2,200 
	.BYTE	 1,4,200 
	.BYTE	 0,6,200 
	.BYTE	 300 
EQUAL:	.BYTE	 2,2,200 
	.BYTE	 2,2,200 
	.BYTE	 2,2,200 
	.BYTE	 2,2,200 
	.BYTE	 2,2,300 
RANG:	.BYTE	 200 
	.BYTE	 0,6,200 
	.BYTE	 1,4,200 
	.BYTE	 2,2,200 
	.BYTE	 3,300 
QUEST:	.BYTE	 5,200 
	.BYTE	 6,200 
	.BYTE	 0,2,1,3,200 
	.BYTE	 4,2,200 
	.BYTE	 5,300

NULL:	.BYTE	340
LF:	.BYTE	360
UPSP:	.BYTE	370
CR:	.BYTE	374
EOF:	.BYTE	377
	ENDMAP=.		;END OF BYTE MAP
	.EVEN


	.SBTTL		INSTRUCTION FORMATION ROUTINE

;INSTRUCTION FORMATION ROUTINE
;THIS ROUTINE CONSTRUCTS A GRAPHICS INSTRUCTION BASED ON THE
;NEXT ARGUMENT IN THE USER FUNCTION.  IT RETURNS IT IN 'TEMP'.
;IT DETERMINES WHETHER A + OR - SIGN PRECEDES THE
;NEXT FUNCTION ARGUMENT AND EVALUATES THE ARGUMENT.  IF + OR -
;PRECEDES IT, SEVAL RETURNS THE ARGUMENT IN A WORD WITH BIT
;15 SET.  IF NOT THEN IF THE LOC ARGUMENT IS LESS THAN 0,
;INDICATING INVISIBLITY, IT RETURNS THE ARGUMENT WITH BIT
;14 SET.  ON ABSOLUTE POINTS ONLY ENOUGH BITS
;TO SATISFY THE COORDINATE REGISTER REQUIREMENTS ARE SET.  IF
;THE ARGUMENT INDICATES A CHARACTER, THE CALLING ROUTINE WILL
;CORRECTLY INTERPRET THE RETURNED VALUE.

SEVAL:	CLR	-(SP)		;SET SIGN FLAG 0
GETPM:	CMPB	(AXOUT),#SPACE	;IGNORE LEADING SPACES
	BNE	NOTSP
	GETC			;JUST GET THEM AND GO ON
	BR	GETPM

NOTSP:	CMPB	(AXOUT),#PLUS	;IF ARG STARTS WITH PLUS
	BEQ	SIGNED
	CMPB	(AXOUT),#MINUS	;OR MINUS, SET SIGN FLAG
	BNE	UNSIGN
SIGNED:	INC	(SP)		;SET FLAG=1
UNSIGN:	EVAL.X			;AND GET VALUE OF THIS ARG
	FPMP
	FINT
	MOV	AC,TEMP		;WHICH SAVE
	BIC	(PC)+,TEMP	;MOD IT
MOD:	.WORD	176000		;1024.
	TST	(SP)+		;IF SIGN <>0
	BNE	RELTIV		;GO MAKE RELATIVE OFFSET
	TST	LOC		;IF ABS. PT. AND LOC<0,
	BGT	VISIBL
	BIS	#40000,TEMP	;SET INVSIBLE BIT
VISIBL:	RTS	PC

RELTIV:	BIS	#100000,TEMP	;ON RELATIVE, SET BIT 15
	RTS	PC
	.ENDC
	.IF	NDF,$PAPER
	.IF	DF,FRM
	.SBTTL	FFRM FUNCTION

	.GLOBL	FFRM
	.SBTTL		FFRM ROUTINE

;FFRM WRITES TO OR FROM THE DISPLAY FILE TO THE FILE ON THE CHANNEL
;SPECIFIED BY ITS FIRST ARGUMENT.  THE SECOND ARGUMENT SPECIFIES THE
;FRAME OF THE FILE TO READ OR WRITE.  A FRAME IS EQUAL IN LENGTH
;TO THE CURRENT DISPLAY FILE.
;	FUNCTION FORMAT			OPERATION
;	FFRM(N,M),M>0		WRITE FRAME M TO CHANNEL N
;	FFRM(N,-M)		READ FRAME M FRAM CHANNEL N

FFRM:	FPMP			;GET CHANNEL
	.WORD	FINT
	MOV	L.CHAN,-(SP)	;SAVE CURRENT CHANNEL
	MOV	AC,L.CHAN	;REPLACE WITH THIS CHANNEL
	GCHAN			;AND GET CHANNEL TABEL TO TEMP
	MOV	TEMP,-(SP)	;SAVE IT
	EVAL.X			;GET FRAME NUMBER
	FPMP
	.WORD	FINT
	MOV	(SP)+,TEMP	;RESTORE TABEL POINTER
	BIT	#L.OPEN,(TEMP)	;IF THIS CHANNEL NOT OPEN,
	BNE	OGO
ZRET:	FPMP			;RETURN A 0
	.WORD	FZER
RETF:	MOV	(SP)+,L.CHAN	;RESTORE L.CHAN
	RTS	PC

OGO:	MOV	AC,(PC)+	;SAVE FRAME ARGUMENT
IO:	.WORD	0		;(FRAME ARGUMENT)
	DEC	AC		;DECREASE FRAME COUNT
	BGE	1$		;IF COUNT >0, OK
	ADD	#2,AC		;ELSE, DECREASE NEGATIVE COUNT
1$:	MOV	AC,-(SP)	;SAVE IT ON STACK
	MOV	DBLOCK,R2	;GET BLOCKS IN DFILE
BLKLOP:	DEC	R2		;AND FIGURE BLOCK FROM FRAME
	BEQ	GOTBLK
	ADD	AC,(SP)
	BR	BLKLOP

GOTBLK:	TST	(SP)		;MAKE RESULTING VALUE POSITIVE
	BGT	1$
	NEG	(SP)
1$:	MOV	(SP)+,C.BLK(TEMP) ;POINT TABLE ENTRY TO RESULTING BLOCK
	NXTBLK			;GET THE RIGHT BLOCK
	MOV	DBLOCK,-(SP)	;COUNT BLOCKS IN FILE
BLKOUT:	MOV	C.BUF(TEMP),AC	;AC POINT TO BUFFER ADDRESS
	MOV	DBUFF,R2	;R2 CONTAINS DFILE ADDRESS
	BEQ	ZRET
	TST	IO		;BUT IF INPUT,
	BGE	OUT
	MOV	R2,-(SP)	;REVERSE THEM
	MOV	AC,R2		;R2 CONTAINS BUFFER ADDRESS
	MOV	(SP)+,AC	;AC POINTS TO DISPLAY FILE
OUT:	BEQ	ZRET		;ABORT IF NO DFILE
	MOV	#256.,-(SP)	;COUNT 256 WORDS
WRDOUT:	MOV	(R2)+,(AC)+	;AND XFER FROM DFILE TO OUTPUT BUFFER
	DEC	(SP)
	BGT	WRDOUT
	TST	(SP)+		;RID WORD COUNTER
	TST	IO		;ON OUTPUT,
	BLT	IN
	BIS	#L.WRT,(TEMP)	;WHEN DONE, SET WRITTEN BIT
	DMPBLK			;AND WRITE THE BLOCK
IN:	DEC	(SP)		;DEC COUNT OF BLOCKS IN DFILE
	BEQ	DONB		;IF 0, XFER DONE SO GO
	INC	C.BLK(TEMP)	;ELSE, ASK FOR NEXT BLOCK OF FILE
	NXTBLK
	BR	BLKOUT		;WHICH DO

DONB:	TST	(SP)+		;RID BLOCK COUNT
	BR	RETF		;AND RETURN, ALL DONE





	.ENDC				;END OF FFRM
	.ENDC
	.IF	DF,SAM
	.SBTTL	SAMPLING ROUTINES

	.IF	NDF,$PAPER
	.GLOBL	FSAM,FFIL
	.IF	DF,DMA
	.GLOBL	FDMA
	.ENDC
	.ENDC

	.IF	DF,$PAPER
	FSAMS=662		;SIZE OF FUNCTION
	FB=FB-4			;EXTEND TABLE UP
	.IF	DF,DMA
	FSAMS=FSAMS+216		;INCREASE SIZE IF DMA DEFINED
	FB=FB-4
	.ENDC
	.=FB			;POINT TO BASE OF FUNCTION TABLE
	.WORD	0,0		;END TABLE WITH TWO 0'S
	.WORD	FSAM
	.WORD	14001
	.IF	DF,DMA
	.WORD	FDMA
	.WORD	13465
	.ENDC

	FS=FS+FSAMS		;EXTEND TOTAL FUNCTION SIZE
	.=FTOP-FS		;SET START OF FUNCTION
	.ENDC
	.SBTTL		FSAM ROUTINE


;FSAM HANDLES THE AR11 A/DCONVERTER.
;	CALL FORMAT		FUNCTION
;	FSAM(N),N>=0		RETURNS THE CURRENT VALUE OF CHANNEL N
;	FSAM(0,N)		RETURNS THE !N!TH ENTRY IN THE BUFFER
;				IF THIS SAMPLE HAS NOT YET BEEN TAKEN,
;				IT RETURNS -1.  IF IT HAS ALREADY
;				BEEN OVERWRITTEN, IT RETURNS -2.
;	FSAM(N,M,O,P...)	INITIATES SAMPLING OF N POINTS
;				CONSECUTIVELY FROM CAHNNELS M,O,P... 
;				(UP TO 8 CHANNELS)
;				FOR N>0, SAMPLE BY CLOCK TICK
;				FOR N<0 SAMPLE BY EXTERNAL EVENT
;	FSAM(-N)		WAIT FOR N EXTERNAL EVENTS


FSAM:
	.IF	DF,DMA
	CLR	DMAFLG		;SAY NON-DMA TRANSFER
	.ENDC
	MOV	#SAMINT,@ADVEC	;ON ANY CALL, SET INTERRUPT VECTOR
	MOV	#340,@ADPR	;AND PRIORITY
	FPMP			;GET FIRST ARGUMENT
	FINT
	MOV	AC,-(SP)	;AND SAVE IT
	SORTC			;ANOTHER ARG.?
	RTPAR
	SAMRET			;IF NOT,  GO
	TST	(SP)		;IF 2 ARGS AND 1ST=0,
	BEQ	RETWRD		;GO RETURN FROM BUFFER
	CLR	@ADSR		;IF FIRST NON-0, KILL INTERRUPTS
	MOV	#140,(PC)+	;SET FOR CLOCK OFLOW CAUSES SAMPLE
ADBYT:	.WORD	0		;(LOW BYTE OF ADSTATUS WORD)
	MOV	(SP)+,COUNT	;GET 1ST ARG SAMPLE COUNT
	BGT	1$		;IF COUNT NEGATIVE,
	NEG	COUNT		;MAKE IT POSITIVE
	MOV	#120,ADBYT	;AND SET FOR EXT. EVENT A/D
1$:	CLR	CTR		;SET SAMPLE COUNTER TO 0
	MOV	BEGBUF,SPTR	;SET POINTER TO START OF A/D BUFFER
	BEQ	ACNEG		;IF NO BUFFER, RETURN -1 ERROR

BUFE:	MOV	#LINES,TEMP	;ELSE, SET EACH LINE TO  0
	MOV	TEMP,LINE	;SET TABLE PTR
	MOV	#LINES,-(SP)	;NOW PT. TO TABLE  OF CHANNELS TO SAMP
LOOPA:	EVAL.X			;GET THE NEXT ARG.
	FPMP
	FINT
	BIC	#177600,AC	;MOD 128
	MOVB	AC,@(SP)	;INSERT ARG.'S VALUE (CHANNEL)
	INC	(SP)		;POINT TO NEXT TABLE SLOT
	SORTC			;IF ANOTHER ARG.
	RTPAR
	DUNARG
	CMP	(SP),#ENDLNS	;AND ROOM IN TABLE
	BLT	LOOPA		;GO ADD IT TO TABLE
DUNARG:	MOVB	#-1,@(SP)	;SIGNIFY END OF TABLE
	TST	(SP)+		;WHEN ALL GOTTEN OR TABLE FULL,
	CLR	(PC)+		;SET TO 1 SLOT PER SAMPLE
CLKSAM:	.WORD	0		;(>0 MEANS GET TIMER ALSO)
	CMPB	ADBYT,#140	;IF CLOCK SAMPLING,
	BEQ	DOLIN		;LEAVE IT THAT WAY
	MOV	#PARAM,AC	;ELSE, POINT TO PARAM 13
	ADD	#13.,AC
	MOVB	(AC),CLKSAM	;SET FLAG TO ITS VALUE
	BLE	DOLIN		;IF TIME INCLUDED,
	ASL	COUNT		;DOUBLE COUNT
DOLIN:	MOVB	@LINE,@ADHI	 ;NOW PUT LINE IN ADSR
	MOVB	ADBYT,@ADSR	;SET FOR CLOCK OVERFLOW AND INTERRUPT
	RTS	PC

SAMRET:	MOV	(SP)+,AC	;ONE ARG, IF NEGATIVE,
	BGE	ONESAM
EXTLOP:	MOV	@ADBUFF,TEMP	;GET BUFFER TO CLEAR DONE FLAG
	MOVB	#20,@ADSR	;WAIT FOR EXTERNAL EVENT
1$:	TSTB	@ADSR
	BPL	1$
	INC	AC		;AS MANY TIMES AS SPECIFIED
	BLT	EXTLOP
	RTS	PC		;THEN RETURN

ONESAM:	BIC	#177600,AC	;IF NON-NEG GO MOD 64
	SWAB	AC		;PUT LINE NO. IN PROPER BITS
	INC	AC		;SET GO BIT
	MOV	@ADSR,-(SP)	;SAVE CURRENT REGISTER VALUE
	MOV	AC,@ADSR	;AND GO
1$:	TSTB	@ADSR		;THEN WAIT FOR FLAG
	BPL	1$
	MOV	@ADBUFF,AC	;AT WHICH PT., GET VALUE
	MOV	(SP)+,@ADSR	;RESTORE POSSIBLE INTERRUPT ENABLED
ACBAK:	FPMP			;AC TO FLAC
	FLOAT
NOFP:	RTS	PC		;RETURN


RETWRD:	TST	(SP)+		;RID ARG FROM STACK
	EVAL.X			;ON 0 FIRST ARG, GET SECOND: SAMPLE NUMBER
	FPMP
	.WORD	FINT
	MOV	AC,SLOFLG	;SET FLAG <>0
RETW2:	TST	BEGBUF		;IF NO BUFFER
	BEQ	ACNEG		;RETURN ERROR -1
SLORET:	.IF	DF,DMA
	TST	DMAFLG		;FOR DMA OPERATION
	BNE	DMAX		;GO PROCESS
	.ENDC
NOTDIR:	MOV	CTR,-(SP)	;COMPARE IT TO SAMPLE COUNT
	CMP	AC,(SP)
	BGT	ACNEG		;IF GREATER, SAMPLE NOT DONE
DUNSAM:	SUB	LEN,(SP)	;SO SUB BUFFER LENGTH FROM COUNT
	INC	(SP)
	SUB	(SP)+,AC	;GIVING EARLIEST SAMPLE IN BUFFER
	BLT	AC2		;IF ARG<THIS VALUE, GO RETURN -2
	ASL	AC		;ELSE, ALL OK, GET WORD OFFSET
	ADD	SPTR,AC		;FROM BUFFER POINTER
	CMP	AC,ENDBUF	;IF BEYOND END OF BUFFER,
	BLT	H2
	SUB	LENB,AC		;SUBTRACT BUFFER LENGTH
H2:	MOV	(AC),AC		;AND GET THE VALUE IN THAT WORD
	TST	(PC)+		;IF CALLED BY FFIL,
SLOFLG:	.WORD	0		;(=0 MEANS CALLED BY FFIL;<>0 MEANS FOCAL)
	BEQ	NOFP
1$:	JMP	CLKBAK		;ELSE, GET AC INTO FLAC

ACNEG:	MOV	#-1,AC		;RETURN -1
	TST	(SP)+		;CLEAR STACK
DECSLO:	TST	SLOFLG		;EITHER RETURN TO FFIL OR FOCAL
	BNE	ACBAK		;IF TO FOCAL, RETURN ERROR CODE
	MOV	AC,SLOFLG	;IF FFIL, PUT CODE IN FLAG
	RTS	PC

AC2:	MOV	#-2,AC		;RETURN  -2
	BR	DECSLO

	.IF	DF,DMA

DMAX:	MOV	DMAFLG,-(SP)	;SAVE TOTAL COUNT REQUESTED
	NEG	(SP)		;AS POSITIVE VALUE
	BIS	#6,@ADSR	;POINT TO CURRENT ADDRESS REGISTER
	MOV	@DMAREG,SPTR	;MAKE IT THE BUFFER POINTER
	BIC	#2,@ADSR	;POINT TO WC REGISTER
	ADD	@DMAREG,(SP)	;ADD NEG. VALUE THERE TO TOTAL COUNT
	MOV	(SP)+,CTR	;AND MAKE THIS THE CURRENT COUNT
	BR	NOTDIR		;THEN GO CONTINUE PROCESSING
	.ENDC



	.IF	DF,DMA

	.SBTTL		FDMA ROUTINE


;FDMA INITIATES DMA SAMPLING INTO THE SAMPLE BUFFER
;	FUNCTION FORMAT		OPERATION
;	FDMA(C,CH,M)		TAKE C SAMPLES, FROM CHANNEL CH
;				IN MODE M

FDMA:	CLR	@ADSR		;STOP ANY TRANSFERS
	MOV	#6,@ADSR	;SET FOR CURRENT ADDRESS LOAD
	MOV	BEGBUF,@DMAREG	;AND LOAD START OF BUFFER
	FPMP			;THEN GET TRANSFER COUNT
	.WORD	FINT
	MOV	AC,DMAFLG	;MAKE COUNT THE DMA FLAG
	NEG	AC		;THEN NEGATE IT
	MOV	#4,@ADSR	;AND LOAD WORD COUNT REGISTER
	CMP	AC,LEN		;MAKE SURE LENGTH LESS THAN BUFFER SIZE
	BLT	1$
	MOV	LEN,AC
1$:	MOV	AC,@DMAREG
	EVAL.X			;NEXT GET CHANNEL/MODE ARGUMENT
	FPMP
	.WORD	FINT
	MOVB	AC,@ADHI	;AND LOAD INTO A/D STATUS HIGH BYTE
	EVAL.X			;THEN GET MODE ARGUMENT
	FPMP
	.WORD	FINT
	BIC	#177774,AC	;MOD 4
	MOV	#4,TEMP		;SET BIT 2 IN TEMP
LP:	ASL	TEMP		;SHIFT IT TO NEXT BIT
	DEC	AC		;AS MANY TIMES AS ARGUMENT INDICATES
	BGT	LP
	MOVB	AC,@ADSR	;LOAD INTO LOW BYTE TO INITIATE XFER
	RTS	PC		;AND RETURN

	.ENDC
	.IF	NDF,$PAPER
	.SBTTL		FFIL ROUTINE

	.IF	NDFP,$PAPER
	.GLOBL	L.CHAN,C.BUF,C.BLK
	.ENDC

;FFIL WRITES FROM THE SAMPLE BUFFER TO THE FILE OPENED ON THE
;CHANNEL SPECIFIED AS ITS FIRST ARGUMENT STARTING AT THE LAST
;SAMPLE NOT WRITTEN FORM THE PREVIOUS CALL,
;IT CONTINUALLY SENDS THE NEXT SAMPLE NUMBER TO THE SAMPLE RETRIEVAL
;ROUTINE.  IF THE SAMPLE HAS NOT BEEN TAKEN, THE RETRIEVAL ROUTINE
;SETS A FLAG NEGATIVE AND FFIL RETURNS.
;OTHERWISE IT LOADS THE SAMPLE VALUE INTO AN OUTPUT
;BUFFER IT HAS ALLOCATTED.  WHEN THE BUFFER FILLS, IT WRITES IT TO DISK
;USING A COMPLETION ROUTINE TO LET IT KNOW WHEN THE PREVIOUS
;WRITE HAS COMPLETED.
;		FUNCTION FORMAT		OPERATION
;		FCLR(C),C>=0		ALLOCATE DOUBLE BUFFER
;		FCLR(C),C<0		WRITE STARTING AT LAST SAMPLE PREVIOUSLY WRITTEN
;					SAMPLE S

FFIL:	FPMP			;GET CHANNEL
	.WORD	FINT
	TST	AC		;NEG ARGUMENT
	BLT	XX		;MEANS CONTINUE WRITING
	MOV	AC,(PC)+	;AS FILE TO WRITE TO
SCHAN:	.WORD	0		;(FILE TO WRITE TO ON SAMPLE)
XX:	MOV	L.CHAN,-(SP)	;SAVE CURRENT CHANNEL
	MOV	SCHAN,L.CHAN	;AND LOOK UP OUTPUT CHANNEL
	TST	AC		;NOW IF THIS IS THE FIRST CALL,
	BLT	XXX
	ADD	#20,AC		;MAKE ID FOR THIS CHANNEL
	NEG	AC
	MOV	AC,IDENT
	CLRM			;GET RID OF SINGLE BUFFER
	MOV	#2,-(SP)	;REQUEST DOUBLE BUFFER INSTEAD
	REQM
	GCHAN
	MOV	(SP),C.BUF(TEMP) ;REPLACE ADDRESS IN KETNRY TABLE
	MOV	(SP)+,(PC)+	;AND SAVE ADDRESS
CURBUF:	.WORD	0		;(CURRENT BUFFER START)
	CLR	(PC)+		;SET COUNT TO SAMPLE 0
CUNT:	.WORD	0		;(COUNT OF SAMPLE JUST TAKEN)
	CLR	(PC)+		;POINT TO FIRST BLOCK OF FILE
BLOCK:	.WORD	0		;(CURRENTLY OPEN BLOCK FOR OUTPUT)
	CLR	WFLAG		;SAY NO WRITE YET
	BR	ENDFIL		;AND EXIT

XXX:	BIC	#377,CUNT	;SET COUNT TO START OF THIS BLOCK
	MOV	CURBUF,R2	;SET R2 TO START OF LAST BUFFER USED
	CLR	SLOFLG		;SET FLAG IN ROUTINE TO 0
FILL:	MOV	CUNT,AC		;GET CURRENT COUNT
	INC	AC		;+1 FOR ROUTINE ARGUMENT
	JSR	PC,SLORET	;S SAMPLE

	TST	SLOFLG		;ON NEGATIVE RESULT
	BLT	TSTERR		;GO EXIT
	MOV	AC,(R2)+	;ELSE, PLUG RETURNED DATA THERE
	INC	CUNT		;COUNT UP 1
	TSTB	CUNT		;IF COUNT NOW AT BLOCK BOUNDARY (BYTE=0),
	BNE	FILL
BDONE:	JSR	PC,DMPGET	;AND WRITE THIS BLOCK
	INC	BLOCK		;WHEN BLOCK DONE, INC BLOCK NUMBER
	BR	FILL		;THEN START FILLING IT

TSTERR:	GCHAN
	MOV	BLOCK,C.BLK(TEMP) ;SET ENTRY TO CORRENT BLOCK
	MOV	CURBUF,C.BUF(TEMP) ;SET START OF CURRENT BUFFER
	BIS	#L.WRT,(TEMP)	;AND SAY ITS WRITTEN
	INC	AC		;IF AC RETURNED=-2,
	BLT	ENDFIL		;RETURN A -1 ERROR FOR OVERRUN
	MOV	CUNT,AC		;ELSE, RETURN CURRENT COUNT
ENDFIL:	FPMP
	.WORD	FLOAT
	MOV	(SP)+,L.CHAN
	RTS	PC

DMPGET:	TST	(PC)+		;WAIT FOR FLAG TO GO >=0
WFLAG:	.WORD	0		;(<0 MEANS WRITE IN PROGRESS)
	BLT	DMPGET		;=0 MEANS BUFF1 JUST DONE
	SUB	#1000,R2	;POINT TO START OF BUFFER
	.WRITC	#WA,SCHAN,R2,#256.,#DUNWRT,BLOCK ;WRITC THIS BLOCK
	BCC	1$
	ERROR+201+32.+32.
1$:	ADD	#1000,R2	;POINT BACK TO END OF BUFFER
	DEC	WFLAG		;MAKE FLAG -1 OR 0
	BLT	BUFF2		;=0 MEANS BUFF2 JUST DONE,
	SUB	#2000,R2	;SO POINT R2 TO START OF BUFF 1
BUFF2:	MOV	R2,CURBUF	;SAVE START OF THIS BUFFER
	DEC	WFLAG		;SET FLAG -2 OR -1
	RTS	PC

WA:	.BLKW	5		;BLOCK FOR WRITC

DUNWRT:	COM	WFLAG		;SET FLAG NON-NEG (0 OR 1
	RTS	PC		;RETURN TO LOOP

	.ENDC
	.SBTTL		A/D INTERRUPT HANDLER

;SAMINT HANDLES AR11 INTERRUPTS CAUSED BY EITHER CLOCK OVERFLOW
;IT FIRST DETERMINES WHTHER DMA OPERATION IS IN PROGRESS.  IF
;SO, TI UPDATES THE COUNTER AND EXITS. OTHERWISE,
;IT ENTERS THE DATA IN THE RING BUFFER UPDATING ALL POINTERS.
; THE COUNT OF TOTAL SAMPLES TAKEN AND A POINTER TO THE
;CURRENT ADDRESS,
;NEXT IT INITIATES A SAMPLE ON THE NEXT SEQUENTIALLY SPECIFIED
;CHANNEL.

SAMINT:	.IF	NDF,$PAPER
	 .INTEN	6		;SET TO PRIORITY 6
	.ENDC
	.IF	DF,DMA
	TST	(PC)+		;IF DMA TRANSFER JUST COMPLETED,
DMAFLG:	.WORD	0		;(<>0 MEANS DMA TRANFER IN PROGRESS
	BEQ	NOTDMA
	ADD	DMAFLG,CTR	;POINT COUNTER TO END OF TRANSFER
	BR	INTDUN		;AND RETURN
NOTDMA:	.ENDC
	TSTB	CLKSAM		;ELSE, IF TIMER FLAG<=0
	BLE	NOTIME		;JUST GET A/D VALUE
	MOV	CLOCKER,@SPTR	;ELSE, GET CLOCK VALUE INTO BUFFER
	ADD	#2,SPTR		;AND INCREMENT POINTER
	INC	CTR		;COUNT ONE MORE ENTRY
	CMP	SPTR,ENDBUF	;TEST FOR END OF BUFFER
	BLT	NOTIME
	MOV	BEGBUF,SPTR
NOTIME:	MOV	@ADBUFF,@SPTR	;GET SAMPLE
	ADD	#2,(PC)+	;UPDATE BUFFER SPTR
SPTR:	.WORD	0		;(PTR TO CURRENT SAMPLE WORD)
	INC	(PC)+		;NEXT, INC SAMPLE COUNTER
CTR:	.WORD	0		;(COUNT OF CURRENT SAMPLE)
	CMP	SPTR,ENDBUF	;IF BEYOND END OF BUFFER,
	BLT	NOTEND
	MOV	BEGBUF,SPTR	;SET IT TO START AGAIN (RING BUFFER)
NOTEND:	CMP	CTR,(PC)+	;AND COMPARE COUNTER TO NUMBER REQUESTED
COUNT:	.WORD	0		;(TOTAL SAMPLES TO DO)
	BLT	NOTDUN		;IF LAST ONE,
INTDUN:	CLR	@ADSR		;RETURN, NO MORE SAMPLES
	.IF	NDF,$PAPER
	RTS	PC
	.ENDC
	.IF	DF,$PAPER
	RTI
	.ENDC

NOTDUN:	INC	LINE		;ELSE, PT. TO NEXT TABLE ENTRT
	CMPB	@LINE,#-1	;LOOK AT LINE THERE
	BNE	SAMP		;IF ENTRY <>-1, GO SAMPLE
	MOV	#LINES,LINE	;ELSE, PT. TO START OF LINE TABLE
SAMP:	MOVB	@LINE,@ADHI	;NOW PUT LINE IN ADSR
	MOVB	ADBYT,@ADSR	;SET FOR CLOCK OVERFLOW AND INTERRUPT
	.IF	NDF,$PAPER
	RTS	PC		;THEN RETURN
	.ENDC
	.IF	DF,$PAPER
	RTI
	.ENDC

;LINES CONTAINS THE UP TO 8 CHANNELS WHICH THE INTERRUPT ROUTINE
;WILL SEQUENTIALLY SAMPLE.  EACH BYTE CONTAINS A VALUE FROM 0 TO 7
;OR A -1 INDICATING NO VALUE.  LINES PT.S TO THE CURRENT ENTRY.

LINE:	.WORD	LINES		;SPTR TO LINE TABLE
LINES:	.BLKB	8.		;TABLE OF LINES
	ENDLNS=.		;END OF LINE TABLE
	.WORD	177777		;END OF TABLE MARKER
	.ENDC
	.IF	DF,BUF

	.SBTTL	BUFFER ALLOCATION ROUTINE

	.IF	NDF,$PAPER
	.GLOBL	FBUF
	.ENDC

	.IF	DF,$PAPER
	FBUFS=124
	FB=FB-4
	.=FB
	.WORD	0,0
	.WORD	FBUF
	.WORD	13472

	FS=FS+FBUFS
	.=FTOP-FS
	.ENDC
	.SBTTL		FBUF ROUTINE

;FBUF SETS UP THE SAMPLING BUFFER
;
;	FORMAT			FUNCTION
;	FBUF(N)			SET UP A BUFFER !N! LONG

FBUF:	CLR	@ADSR	;STOP INTERRUPTS
	.IF	NDF,$PAPER
	MOV	#2,IDENT	;GET RID OF PREVIOUS BUFFER
	CLRM
	.ENDC
	.IF	DF,$PAPER
	MOV	#2,TEMP		;ID 1
	CLR	AC		;LENGTH ARG
	JSR	PC,BUFALC	;DE-ALLOCATE
	.ENDC
	CLR	BEGBUF		;CLEARING START ADDRESS
	FPMP			;THEN GET LENGTH ARG
	FABS
	FINT
	MOV	AC,(PC)+	;AND SAVE IT
LEN:	.WORD	0		;(LENGTH OF BUFFER IN SAMPLES(WORDS))
	MOV	AC,TEMP		;TWICE
	ASL	TEMP		;2ND TIME AS BYTE COUNT
	MOV	TEMP,(PC)+	;SAVE IT TO QUICKEN 'SLORET'
LENB:	.WORD	0		;(SIZE OF BUFFER IN BYTES)
	.IF	NDF,$PAPER
	ADD	#127.,AC	;CONVERT LENGTH TO BLOCKS
	BIC	#177,AC
	ASL	AC
	SWAB	AC
;	BIC	#177760,AC	;MOD 16
	BEQ	ACB		;IF 0 BLOCKS, BUFFER DELETED
	MOV	TEMP,-(SP)	;PUSH BYTE COUNT
	MOV	AC,-(SP)	;IF NOT,  REQUEST MEMORY
	MOV	#2,IDENT	;UNDER ID 2
	REQM
	.ENDC
	.IF	DF,$PAPER
	BEQ	ACB		;IF 0 CSIZE, RETURN 0
	MOV	TEMP,-(SP)	;ELSE, SAVE SIZE IN BYTES
	MOV	#2,TEMP		;THEN UNDER ID 2,
	MOV	LEN,AC	;GET LENGTH IN WORDS
	JSR	PC,BUFALC	;ALLOCATE THEM
	TST	AC		;IF NO,
	BEQ	ACB		;RETURN A 0
	MOV	AC,-(SP)	;ELSE, SAVE ADDRESS
	.ENDC
	MOV	(SP)+,AC	;GET RETURNED ADDRESS
	MOV	AC,(PC)+	;AND SAVE IT
BEGBUF:	.WORD	0		;(SATRT OF SAM BUFFER)
	FPMP			;INTO FLAC FOR RETURN
	FLOAT
	ADD	(SP)+,AC	;AND BYTE LENGTH OF BUFFER
	MOV	AC,(PC)+	;SAVE END OF BUFFER
ENDBUF:	.WORD	0		;(ADDR. OF END OF SAM BUFFER)
	RTS	PC		;THAT DOES IT


ACB:	FPMP			;RETURN AC
	FLOAT
	RTS	PC
	.ENDC				;END OF FBUF CONDITIONALIZATION
	.IF	DF,LED
	.SBTTL	FLED ROUTINE

	.IF	NDF,$PAPER
	.GLOBL	FLED
	.ENDC

	.IF	DF,$PAPER
	FLEDS=262		;SIZE OF FUNCTION
	FB=FB-4			;EXTEND TABLE UP
	.=FB			;POINT TO BASE OF FUNCTION TABLE
	.WORD	0,0		;END TABLE WITH TWO 0'S
	.WORD	FLED
	.WORD	13630

	FS=FS+FLEDS
	.=FTOP-FS		;SET START OF FUNCTION
	.ENDC

;FLED LOADS THE LEDS ON THE LPS.  IT USES ITS FIRST ARGUMENT
;TO DETERMINE THE NUMBER OF PLACES TO THE RIGHT OF THE
;DECIMAL POINT.  IT DETERMINES THE SIGN OF THE SECOND ARGUMENT
;AND LOADS LED 5 WITH EITHER A MINUS SIGN OR A + SGIN, THEN
;MAKES THE FLAC POSITIVE.  NEXT IT MULTIPLIES THE FLAC
;BY 10 ENOUGH TIMES TO GET ALL NECESSARY DIGITS TO THE LEFT OF
;THE DECIMAL POINTS, I.E. THE NUMBER OF TIMES SPECIFIED BY
;THE FIRST ARGUMENT.  THEN FOR EACH OF 5 DIGITS, STARTING WITH
;THE RIGHTMOST DIGIT, IT GETS THE FLAC, THAN DIVIDES AND MULTIPLIES
;THE FLAC BY 10 TO 0 THE LOWEST DIGIT, SUBTRACT THE RESULT
;FROM THE PREVIOUS FLAC TO GET THE LOW DIGIT, THEN SETS THE DIGIT IN
;THE CURRENT LED WITH A DECIMAL POINT IF NECESSARY.  IT THEN DIVIDES
;THE FLAC BY 10 AND CONTINUES THE PROCESS.

;		FUNCTION FORMAT	OPERATION
;		FLED(N,M)		LOAD M WITH N PLACES RIGHT OF
;					DECIMAL POINT

FLED:	FPMP			;GET DEC POINT ARGUMENT
	.WORD	FINT
	CMP	AC,#5		;ALLOW MAX OF 5 DECIMALS
	BLE	1$
	MOV	#5,AC
1$:	MOV	AC,-(SP)	;AND SAVE IT
	EVAL.X			;GET VALUE INTO FLAC
	FPMP			;GET RESULT
	.WORD	FPUT+DIRECT	;AND TEST ITS SIGN
	.WORD	STORE
	MOV	#2413,AC	;IF POSITIVE, LOAD DIGIT 6 WITH A BLANK
	TST	STORE
	BGE	POSNUM
	MOV	#2415,AC	;IF NEG, MINUS SIGN
	FPMP			;AND MAKE FLAC POSITIVE
	.WORD	FNEG
POSNUM:	CMP	(SP),#5		;IF DEC PT IN TOP DIGIT, SET IT THERE
	BNE	NOTD5
	BIS	#20,AC
NOTD5:	MOV	AC,@ADBUFF	;THEN LOAD DIGIT 5
	MOV	(SP),AC		;RETRIEVE DECIMAL PLACE
	MOV	#FP10,R2	;POINT TO FLOATING POINT 10
1$:	DEC	AC		;MULTIPLY FLAC THAT MANY TIMES BY 10
	BLT	DUNT
	FPMP
	.WORD	FMUL+IPTR
	BR	1$

DUNT:	CLR	(PC)+		;CLEAR DIGIT COUNTER TO POINT TO LEFTMOST DIGIT
HIBITS:	.WORD	0		;(HIGH BYTE COUNTS DIGITS)
DLOP:	FPMP			;FIRST SAVE THE CURRENT FLAC
	.WORD	FPUT+DIRECT
	.WORD	STORE
	.WORD	FDIV+IPTR	;THEN DIVIDE BY 10
	.WORD	FINT		;INTEGERIZE THE FLAC
	.WORD	FLOAT
	.WORD	FMUL+IPTR	;THEN MULTIPLY IT BY 10 TO GET RID
	.WORD	FNEG		;GET OLD FLAC-NEW FLAC
	.WORD	FADD+DIRECT	;WHICH LEAVES LOW DIGIT IN FLAC
	.WORD	STORE
	.WORD	FINT		;GET THIS DIGIT IN AC
	.WORD	FGET+DIRECT	;THEN RESTORE OLD FLAC
	.WORD	STORE
	.WORD	FDIV+IPTR	;DIVIDED BY 10
	TST	AC		;IF DIGIT 0
	BNE	MORD
	CMP	STORE,#41040	;AND FLAC <10
	BGE	MORD
	TSTB	HIBITS+1	; AND NOT RIGHT MOST DIGIT
	BEQ	MORD
	MOV	#13,AC		;SET DIGIT TO BLANK
MORD:	ADD	HIBITS,AC	;THEN ADD DIGIT COUNT IN HIGH BYTE
	CMPB	(SP),HIBITS+1	;THEN IF DEC. PT. GOES AFTER THIS DIGIT
	BNE	NODEC
	BIS	#20,AC	;SET BIT 4, TOO
NODEC:	MOV	AC,@ADBUFF	;THEN DISPLAY THIS VALUE
	INCB	HIBITS+1	;INC COUNTER
	CMPB	HIBITS+1,#4	;AND GO BACK FOR ALL 5 DIGITS
	BLE	DLOP
	TST	(SP)+		;WHEN DONE, RID DEC. PT.
	RTS	PC

FP10:	.WORD	41040		;FLOATING 10
	.WORD	0
	.WORD	0
	.WORD	0

STORE:	.BLKW	4

	.ENDC
	.IF	DF,TIC
	.SBTTL	CLOCK ROUTINES

	.IF	NDF,$PAPER
	.GLOBL	FTIC,FDLY
	.ENDC

	.IF	DF,$PAPER
	FTICS=410		;SIZE OF FUNCTION
	.IF	DF,CRT		;IF CRT IN USE,
	FTICS=FTICS+130		;INCREASE SIZE
	.ENDC
	FB=FB-10			;EXTEND TABLE UP
	.=FB			;POINT TO BASE OF FUNCTION TABLE
	.WORD	0,0		;END TABLE WITH TWO 0'S
	.WORD	FTIC
	.WORD	14047
	.WORD	FDLY
	.WORD	13511

	FS=FS+FTICS
	.=FTOP-FS		;SET START OF FUNCTION
	.ENDC

	.SBTTL		FTIC ROUTINE

	.IF	NDF,$PAPER
	.GLOBL	I.SLOT,MAXTSK
	.ENDC



;FTIC HANDLES THE  AR11 CLOCK.
;
;	CALL FORMAT		OPERATION
;	FTIC(N), N>=0		SUBTRACT N FROM THE CURRENT VALUE OF
;				THE CLOCK AND RETURN IT
;	FTIC(N,M) ,N>0,M>0	START THE CLOCK AT RATE N, INTERVAL M
;				IF N MOD 8 =0, STOP THE CLOCK AND SET
;				THE CLOCK VALUE TO M
;	FTIC(N,M),N>0,M<0	SAME AS ABOVE BUT 1 TICK ONLY


FTIC:	FPMP			;GET ARG1 AS INTEGER
	.WORD	FSUB+DIRECT	;SUBTRACT 32K SO RANGE -32K TO +32K
	.WORD	F32K
	.WORD	FINT		;THEN GET INTO AC
	ADD	#100000,AC	;THEN ADD BACK THE 32K SO OFLOW WON'T HURT
	MOV	AC,-(SP)	;AND SAVE IT
	SORTC			;TEST FOR ANOTHER ARG
	RTPAR
	ONEARG			;IF NOT, GO WAIT  OR RETURN TIME
	EVAL.X			;, GET 2ND
	FPMP
	.WORD	FINT
	BIC	#177770,(SP)	;ARG1 IS THE RATE,  MOD 8
	ASL	(SP)		;SHIFT RATE TO BITS 1 THRU 3
	BEQ	1$
	CMPB	(SP),#6		;IF >100,000 HZ
	BGE	1$
	MOV	#6,(SP)		;SET TO 10,000 HZ
1$:	TST	AC		;IF INTERVAL ARG WAS POSTITIVE
	BLT	NOTM1
	NEG	AC		;MAKE IT NEGATIVE
	BIS	#400,(SP)	;SET FOR REPEATED INTERVAL
NOTM1:	MOV	(SP),@CKSR	;SET UP STATUS
	MOV	(SP)+,TEMP	;IF 0 RATE,
	BIC	#177761,TEMP	;LEAVE RATE BITS
	BEQ	STOPC		;IF RATE 0, GO SET CLOCKER
	MOV	AC,@CKBUFF	;GIVES INTERVAL
	.IF	DF,CRT
	BEQ	NOINT		;ON 0 INTERVAL, DON'T DO NEXT CALCULATION
	MOV	#PARAM,R2	;POINT TO PARAMETER TABLE
	ADD	#12.,R2		;PARAM 12, INTERVAL VALUE
	MOVB	(R2),R2		;GET INTERVAL VALUE
	BNE	1$
	INC	R2		;INTERVAL OF 1 IF PARAM=0
1$:	ASR	TEMP		;TEMP EQUALS 3, 4, OR 5
	SUB	#5,TEMP		;IF RATE 5,
	BEQ	USERAT		;USE THIS INTERVAL
	JSR	PC,X10		;ELSE, RATE*10
	INC	TEMP		;IF RATE 3,
	BEQ	USERAT
	JSR	PC,X10		;*10 AGAIN
USERAT:	CLR	TEMP		;CLEAR COUNTER
1$:	INC	TEMP		;DIVIDE BY INTERVAL
	ADD	AC,R2
	BGE	1$
2$:	MOV	TEMP,TCOUNT	;PUT THIS AS TICKS BETWEEN DISPLAYS
	MOV	#1,CURCNT	;CAUSE DISP. PASS NEXT TICK
	.ENDC
NOINT:	.IF	NDF,$PAPER
	JSR	PC,GETSLT	;LOOK UP IN SLOT TABLE
	BEQ	CKTHER		;0 BACK MEANS ALREADY THERE
	MOV	#400,12(PTR)	;WITH FREE SLOT, SET LINE NUMBER
	MOV	CKVEC,16(PTR)	;VECTOR ADDRESS
	MOV	CKSR,6(PTR)	;STATUS REG.
	CLR	10(PTR)		;AND WORD TO LOAD INTO REGISTER
CKTHER:	.ENDC
	MOV	#CLKINT,@CKVEC ;SET INTERRUPT VECTOR
	.IF	NDF,$PAPER
	MOV	#340,@CKPR	 ;SET PRIOITY
	.ENDC
	.IF	DF,$PAPER
	MOV	#0,@CKPR	;SET PRIORITY 0 FOR CLOCK
	.ENDC
	BIS	#40101,@CKSR	;START CLOCK: BOTH INTERRUPTS+GO+REPEAT
	MOV	CLOCKER,AC	;RETURN CURRENT CLOCK
	BR	CLKBAK

STOPC:	NEG	AC
	MOV	AC,CLOCKER	;ON STOP, SET CLOCKER
	.IF	NDF,$PAPER
	JSR	PC,GETSLT	;LOOK UP CLOCK SLOT
	BNE	CLKBAK		;IF NONE THERE, DO NOTHING
	CLR	12(PTR)		;ELSE, CLEAR IT OUT
	.ENDC
	BR	CLKBAK		;RETURN NEW CLOCKER VALUE

	.IF	NDF,$PAPER
;GETSLT GOES THROUGH THE INTERRUPT ENTRY TABLE LOOKING FOR EITHER
;A FREE SLOT OR A SLOT CONTAINING THE CLOCK VECTOR.  IF
;IT FINDS A FREE SLOT IT RETURNS ITS ADDRESS AND THE C BIT CLEAR.
;IF IT FINDS A CLOCK SLOT, IT RETURNS ITS ADDRESS AND THE C BIT
;SET.  IF THE ENTRY TABLE IS FULL, AND CONTAINS NO CLOCK ENTRY
;IT CAUSES AN ERROR

GETSLT:	MOV	#I.SLOT,PTR	;POINT AT SLOT TABLE
	MOV	#MAXTSK,AC	;SET COUNTER
7$:	TST	12(PTR)		;SEE IF FREE
	BNE	12$
	MOV	PTR,TEMP		;SAVE ADDRESS OF A FREE SLOT
12$:	CMP	16(PTR),CKVEC	;IF SLOT CONTAINS CLOCK INTERRUPT
	BEQ	SETF		;SKIP THE INSERT
	ADD	#20,PTR		;IF NOT, INDEX
	DEC	AC		;COUNT IT OUT
	BGT	7$		;AND GO TO NEXT SLOT
	MOV	TEMP,PTR	;IF NO CLOCK ENTRY, SEE IF CLEAR SLOT
	BNE	SETF		;IF SO RETURN ITS ADDRESS
	ERROR+201+39.+39.	;IF NONE FREE, ERROR
SETF:	RTS	PC
	.ENDC



	.IF	DF,CRT
X10:	ASL	R2		;SAVE R2*2
	MOV	R2,-(SP)	;ON STACK
	ASL	R2
	ASL	R2
	ADD	(SP)+,R2	;ADD TO *8
	RTS	PC

	.ENDC

ONEARG:	MOV	(SP)+,TEMP	;GET THE ARG

RETTIM:	MOV	TEMP,AC		;ELSE RETURN TIME
	NEG	AC
	ADD	CLOCKER,AC	;- THE ARGUMENT
	BR	CLKBAK
	.SBTTL		FDLY ROUTINE

;	FDLY(N)		WAIT N TICKS, THEN RETURN 0
;	FDLY(N,M)		CONTINUALLY EVALUATE ARGUMENT M UNTIL
;				EITHER IT BECOMES >0 OR N TICS EXPIRE
;				WHICHEVER FIRST, THEN RETURN M'S LAST
;				VALUE
;	FDLY(0,M)		RETURN THE NUMBER OF TICKS MINUS M
;				THAT THE PREVIOUS FUNCTION EVALUTION
;				TOOK BEFORE COMPLETION

FDLY:	FPMP			;GET WAIT ARGUMENT
	.WORD	FINT
	MOV	AC,-(SP)	;SAVE IT
	MOV	AXOUT,(PC)+	;SAVE ADDR OF 2ND ARG.
FUN2:	.WORD	0		;(ADDR.OF 2ND ARG.)
	SORTC			;IF ONLY 1 ARGUMENT,
	RTPAR
	WAITJ			;GO WAIT
WAITFN:	EVAL.X			;GET SECOND ARGUMENT
	FPMP
	.WORD	FINT
	MOV	(SP)+,TEMP	;RETRIEVE 1ST ARG
	BEQ	RETLAT		;=0 THEN GO  RETURN LATENCY
	JSR	PC,WAIT		;ELSE, WAIT FOR AC TO GO FUNC TO GO >0
	BR	CLKBAK		;AND RETURN ITS VALUE

WAITJ:	MOV	(SP)+,TEMP	;RETRIEVE WAIT ARG
	CLR	AC		;SET AC ZERO
	JSR	PC,WAIT		;THEN WAIT FOR AC TO GO POSITIVE (IT WON'T)
	MOV	CLOCKER,AC	;AND RETURN TIMER
	BR	CLKBAK

WAIT:	MOV	TEMP,(PC)+	;AND SAVE AS DONE COUNT
DUNTIM:	.WORD	0		;(FINAL TICS)
	MOV	CLOCKER,(PC)+	;SAVE CLOCK AT START
STIME:	.WORD	0		;(CLOCK AT START)
LOOPW:	MOV	CLOCKER,(PC)+	;GET CURRENT CLOCKER
LATEN:	.WORD	0		;(COUNT OF TIME LEFT TO WAIT)
	SUB	STIME,LATEN	;GET TICKS ELAPSED
	TST	AC		;2ND ARG >=0?
	BGT	DUNW		;IF SO, WAIT DONE. RETURN ITS VALUE
	CMP	LATEN,DUNTIM	;IF JIG UP,
	BGE	DUNW		;GO RETURN <0 VALUE
	CMP	FUN2,AXOUT	;IF ONLY 1 ARGUMENT
	BEQ	LOOPW		;KEEP WAITING FOR TIMER
	MOV	FUN2,AXOUT	;ELSE, RE-GET 2MD ARG
	EVAL.X
	FPMP
	FINT
	BR	LOOPW		;AND CHECK IT VALUE
DUNW:	RTS	PC

RETLAT:	NEG	AC		;ON FTIC(0,N) RETURN LATENCY
	ADD	LATEN,AC	;-N

CLKBAK:	FPMP
	FLOAT			;RETURN AC
	TST	AC		;IF AC<0
	BGE	1$
	FPMP
	.WORD	FADD+DIRECT	;ADD 64K TO MAKE POSITIVE RETURN
	.WORD	F32K
	.WORD	FADD+DIRECT
	.WORD	F32K
1$:	RTS	PC

F32K:	.WORD	44000		;FLOATING 32K
	.WORD	000000
	.WORD	0
	.WORD	0
	.SBTTL		CLOCK INTERRUPT HANDLER


;CLOCK INTERRUPT HANDLER
;THIS ROUTINE JUST INCREMENTS THE CLOCK AND SETS
;IT TO 0 IF IT BECOMES NEGATIVE.

CLKINT:	.IF	NDF,$PAPER
	.INTEN	0		;SET PRIORITY 0
	.ENDC
	INC	(PC)+		;INC CLOCKER
CLOCKER: .WORD	0		;(CLOCKER; CURRENT TICS)
	.IF	DF,CRT
	TST	CURCNT		;IF DISPLAY COUNTER NON-0
	BEQ	NODISP
	DEC	CURCNT		;DECREMENT IT
	BNE	NODISP		;IF IT GETS TO 0
	JSR	PC,DISP		;GO DO A DISPLAY PASS
NODISP:	.ENDC
	.IF	NDF,$PAPER
	RTS	PC
	.ENDC
	.IF	DF,$PAPER
	RTI
	.ENDC

	.IF	DF,CRT
TCOUNT:	.WORD	0		;NUMBER OF INTERRUPTS IN 1/20TH SECOND
CURCNT:	.WORD	0		;CURRENT NUMBER EXECUTED SINCE LAST INTERRUPT
	.ENDC
	.IF	DF,TOI
	.SBTTL		FTOI ROUTINE

	.IF	NDF,$PAPER
	.GLOBL	FTOI
	.ENDC


	.IF	NDF,TIMES
	TIMES=8.		;SET DEFAULT NUMBER OF VECTORS SAVABLE
	.ENDC

	.IF	DF,$PAPER
	FTOIS=TIMES*9.+270
	FB=FB-4			;EXTEND TABLE UP
	.=FB			;POINT TO BASE OF FUNCTION TABLE
	.WORD	0,0		;END TABLE WITH TWO 0'S
	.WORD	FTOI
	.WORD	14105

	FS=FS+FTOIS
	.=FTOP-FS
	.ENDC



;FTOI RETURNS THE TIME OF INTERRUPT TO THE CALLER.
;THE CALLER FIRST CALLS FTOI AFTER SETTING UP AN ENTRY USING
;FINT.  FTOI STEALS ITS VECTOR AND DIRECTS THE INTERRUPT FIRST TO
;ITS OWN PRE-PROCESSING ROUTINE IN WHICH IT SAVES THE TIME OF THE
;INTERRUPT.  A CALL TO FINT IN THE FOCAL INTERRUPT ROUTINE
;WILL RETURN THE TIME OF THE LAST INTERRUPT THORUGH THAT VECTOR

;	FORMAT			FUNCTION
;FTOI(+VEC)		STEAL THIS VECTOR, RETURN CURRENT AR11 TIME
;FTOI(-VEC)		RETURN THIS VECTOR, RETURN TIME
;FTOI(VEC,N)		RETURN TIME OF INTERRUPT MINUS N

FTOI:	FPMP
	.WORD	FINT		;GET VECTOR
	JSR	PC,LUKVEC	;NEG OR POS, LOOK IT UP
	MOV	TEMP,-(SP)	;AND OFFSET
	MOV	AC,-(SP)	;SAVE VECTOR
	SORTC			;THEN TEST FOR ANOTHER ARG
	RTPAR
	ALTER			;IF NOT, GO ALTER TABLES
	EVAL.X			;IF SO, GET 2ND ARG
	FPMP
	.WORD	FSUB+DIRECT
	.WORD	F32K
	.WORD	FINT
	ADD	#100000,AC
	TST	(SP)+		;AND NO NEED FOR VECTOR
	MOV	(SP)+,TEMP	;GET OFFSET BACK
	BGE	RETIME
RET0:	CLR	AC
ABAK:	FPMP
	.WORD	FLOAT
IGNORE:	RTS	PC

RETIME:	NEG	AC		;ON TIME RETURN, SUB 2ND ARG
	ASL	TEMP
	ADD	TTABL(TEMP),AC	;FROM INTERRUPT TIME
	JMP	CLKBAK		;GO MAKE TIME POSITIVE

ALTER:	MOV	(SP)+,AC	;IF NEGATIVE VECTOR,
	BLT	UNDO		;GO UNDO A SLOT
	MOV	(SP)+,TEMP	;ELSE, GET OFFSET
	BGE	RET0		;IF ALREADY THERE, ABORT RETURN 0
	CLR	TEMP		;ELSE, FIND VACANT SLOT
1$:	TSTB	VTABL(TEMP)
	BEQ	GOSLOT
	INC	TEMP
	CMP	TEMP,#TIMES
	BLT	1$
	BR	ABAK		;IF NONE, RETURN 0
GOSLOT:	MOVB	AC,VTABL(TEMP)	;ELSE, INSERT VECTOR
	ASL	TEMP		;WORD OFFSET
	MOV	(AC),ATABL(TEMP);INSERT ADDRESS FROM V.
	MOV	#PREINT,(AC)	;AND INTERRUPT ADDR. TO V.
	ASL	TEMP
	SUB	TEMP,(AC)	;AND OFFSET INTO ROUTINE
	MOV	CLOCKER,AC	;GET CLOCK
	ASR	TEMP
	MOV	AC,TTABL(TEMP)	;AND MAKE IT TIME WORD
	BR	ABAK		;AND RETURN IT

UNDO:	NEG	AC		;MAKE VECTOR POSITIVE
	MOV	(SP)+,TEMP	;ON UNDO, GET OFFSET
	BLT	IGNORE		;IF NO ENTRY, INGORE
	ASL	TEMP
	MOV	ATABL(TEMP),(AC);AND RESTORE ITS INT. ADDRESS
	CLRB	VTABL(TEMP)	;CLEAR ENTRY
	RTS	PC



LUKVEC:	MOV	AC,-(SP)	;GET VECTOR
	BGE	1$		;>0
	NEG	(SP)
1$:	CLR	TEMP		;CLEAR POINTER
VSRCH:	CMPB	VTABL(TEMP),(SP)	;MATCH?
	BEQ	GOTONE		;THEN GO RETURN OFFSET
	INC	TEMP		;ELSE, LOOK ON
	CMP	TEMP,#TIMES	;TO ALL 8 SLOTS
	BLE	VSRCH
	NEG	TEMP		;ON NOT FOUND, RETURN <0
GOTONE:	TST	(SP)+
	RTS	PC

	.SBTTL		INTERRUPT PROCESSOR

;TOI PREPROCESSES DEVICE INTERRUPTS.
;THE ENTRY POINT DETERMINES WHICH OF THE 8 TABLE ENTRIES CAUSED
;THE INTERRUPT.  TOI PUTS THE CURRENT CLOCK IN THAT ENTRY'S
;CLOCK WORD, THEN JUST JUMPS TO WHERE THE INTERRUPT WOULD HAVE
;GONE BY GETTING ITS FORMER ADDRESS FROM THE ENTRY'S ADDRESS
;WORD.

	.REPT	TIMES-1
	INC	INTENT
	.ENDM
PREINT:	MOV	TEMP,-(SP)	;SAVE A REGISTER
	MOV	INTENT,TEMP	;AND GET INDEX OF ENTRY POINT
	ASL	TEMP		;WORD OFFSET
	MOV	CLOCKER,TTABL(TEMP) ;INSERT TIME
	MOV	ATABL(TEMP),RTI	;FOR RETURN ADDRESS
	MOV	(SP)+,TEMP
	CLR	(PC)+		;CLEAR COUNTER FOR NEXT TIME
INTENT:	.WORD	0
	JMP	@RTI		;CONTINUE ON
RTI:	.WORD	0

VTABL:	.REPT	TIMES		;VECTOR ADDRESSES
	.BYTE	0
	.ENDM
TTABL:	.REPT	TIMES		;TIMES
	.WORD	0
	.ENDM
ATABL:	.REPT	TIMES		;REGISTER ADDRESSES
	.WORD	0
	.ENDM

	.ENDC			;END OF FTOI
	.ENDC			;END OF FTIC


	.IF	DF,FNS
	.SBTTL	FFNS FUNCTION

	.IF	NDF,$PAPER
	.GLOBL	FFNS
	.ENDC

	.IF	DF,$PAPER
	FFNSS=16		;SIZE OF FUNCTION
	FB=FB-4			;EXTEND TABLE UP
	.=FB			;POINT TO BASE OF FUNCTION TABLE
	.WORD	0,0		;END TABLE WITH TWO 0'S
	.WORD	FFNS
	.WORD	13553

	FS=FS+FFNSS		;INCREASE TOTAL FUNCTION LENGTH
	.=FTOP-FS		;SET START OF FUNCTION
	.ENDC
	.SBTTL		FFNS ROUTINE

;ARGUMENT EVALUATION FUNCTION
;THIS FUNCTION EVALUATES ONE ARGUMENT AFTER ANOTHER UNTIL IT
;REACHES THE LAST ARGUMENT WHOSE VALUE IT RETURNS.

FFNS:	SORTC		;ANOTHER ARGUMENT?
	RTPAR
	LAST		;IF NOT, GO RETURN
	EVAL.X		;ELSE, EVAL IT
	BR	FFNS	;AND GO ON TO NEXT ARGUMENT
LAST:	RTS	PC

	.ENDC

	.IF	DF,BIT
	.SBTTL	FBIT FUNCTION

	.IF	NDF,$PAPER
	.GLOBL	FBIT
	.ENDC

	.IF	DF,$PAPER
	FBITS=200
	FB=FB-4		;EXTEND TABLE UP
	.=FB
	.WORD	0,0
	.WORD	FBIT
	.WORD	13430

	FS=FS+FBITS	;INCREASE TOTAL FUNCTION LENGTH
	.=FTOP-FS	;SET START OF FUNCTION
	.ENDC
	.SBTTL		FBIT ROUTINE

;FBIT ENABLES LOGICAL MANIPULATION OF 16-BIT VALUES.  THE FIRST
;ARGUMENT TO FBIT SUPPLIES THE ORGINAL OPERAND.  EACH SUCCEEDING PAIR
;OF ARGUMENTS SPECIFIES AN OPERATION (FIRST ARGUMENT OF PAIR) AND AN
;OPERATOR.  THE POSSIBLE OPERATIONS ARE:
;	CODE		OPERATION
;	0		SET BIT NUMBER SPECIFIED BY OPERATOR
;	1		OR
;	2		AND
;	3		XOR
;
;IN ADDITION THE NEGATIVE OF THE LAST THREE CODES FIRST COMPLEMENTS
;THE OPERATOR BEFORE PERFORMING THE OPERATION.  THE RESULT OF EACH
;LOGICAL OPERATION BECOMES THE OPERAND FOR THE NEXT OPERATION IN THE
;LIST.  THE FINAL OPERAND IS RETURNED.

FBIT:	FPMP			;GET VALUE
	.WORD	FINT
	MOV	AC,-(SP)	;ONTO STACK
GETCOD:	SORTC			;IF NO MORE PAIRS,
	RTPAR
	DONEL			;QUIT
	EVAL.X			;ELSE, GET CODE
	FPMP
	.WORD	FINT
	MOV	AC,-(SP)	;ONTO STACK FOR RE-ENTRANCY
	EVAL.X			;THEN GET ARGUMENT VALUE
	FPMP
	.WORD	FINT
	TST	(SP)		;IF CODE 0,
	BNE	WORDL
	MOV	AC,TEMP		;GET BIT NUMBER
	MOV	#1,(SP)		;SET TO CODE FOR 'AND'
	MOV	(SP),AC	;AND CONVERT ARG. BIT TO A VALUE
BLOOP:	DEC	TEMP		;BY SHIFTING A BIT LEFT
	BLT	WORDL		;TILL VALUE REACHED
	ASL	AC
	BR	BLOOP

WORDL:	MOV	(SP),TEMP	;WITH VALUE IN AC, GET FUNC
	BGE	1$		;AND MAKE IT POSITIVE
	NEG	TEMP
1$:	ASL	TEMP		;*2 FOR OFFSET INTO TABLE
	BIC	#177771,TEMP	;ALLOW OFFSETS 2,4,6
	JSR	PC,@LOGIC(TEMP)	;DO LOGIC SUBROUTINE: VALUE BACK IN R2
	TST	(SP)+		;TEST FUNCTION SIGN
	BGT	GETCOD
	COM	(SP)		;IF NEGATIVE, DO A 'NOT' TO VALUE
	BR	GETCOD		;GO GET NEXT PAIR

DONEL:	MOV	(SP)+,AC	;THEN ALL PAIRS DONE, RETURN FINAL VALUE
	FPMP
	FLOAT
	RTS	PC

;DISPATCH TABLE TO LOGIC ROUTINES

	LOGIC=.-2		;LOWEST CODE IS 2
	.WORD	ORL		;CODE 1, OR
	.WORD	ANDL		;CODE 2: AND
	.WORD	XOR		;3: XOR

ANDL:	JSR	PC,AND		;TO AND, DO AND TO R2
	MOV	R2,4(SP)	;AND PUT THIS IN FIRST VALUE
	RTS	PC

ORL:	BIS	AC,4(SP)	;TO OR, JUST SET BITS IN VALUE
	RTS	PC

XOR:	JSR	PC,AND		;TO XOR, GET AND TO R2
	BIS	AC,4(SP)	;THEN GET THE OR (ALL BITS SET IN EITHER)
	BIC	R2,4(SP)	;AND CLEAR ALL COMMON BITS
	RTS	PC

AND:	MOV	6(SP),R2	;TO 'AND', GET 1ST VALUE
	MOV	AC,TEMP		;AND ARGUMENT VALUE
	COM	TEMP		;GET ALL UNSET BITS IN ARG
	BIC	TEMP,R2		;AND CLEAR THEM IN VALUE
	RTS	PC		;RETURN 'AND' IN R2


	.ENDC			;END OF FBIT
	.IF	DF,VT11
	.IF	NDF,$PAPER

	.SBTTL	VT11 FUNCTIONS

	.GLOBL	FVT,FSTA,FDIS,FVEC,FMOV,FSET,FPT,FTXT,FSPC,FCLR,FSCR,FLP
	.GLOBL	FXCO,FYCO,FSKP


	ENAB=3124		;ENABLE BITS+INTENSITY 4

; THE FOLLOWING DEFINE GT40 INSTRUCTIONS USED BY DNEW
	DNOP=164000		;DISPLAY NOP
	DSTP=173400		;DISPLAY STOP, WITH INTERRUPT
	DSTA=170000		;LOAD STATUS REGISTER A
	DJMP=160000		;DISPLAY JUMP(DESTINATION FOLLOWS IN FILE)
	DPT=114000		;POINT MODE
	DCHR=100000		;CHARACTER MODE
	DVEC=110000		;LONG VECTOR MODE

	BELL=7			;^G RINGS THE BELL
	SHIN=16			;SHIFT-IN TO SPECIAL CHARACTER
	SHOUT=17		;SHIFT-OUT OF SPECIAL CHARACTERS
	LOK=TEMP		;MAKE LOK A GENERAL REGISTER

; GT DEVICE REGISTERS:

	.IF	NDF,VTREG
	VTREG=172000
	.ENDC

	GTP=VTREG
	GTSTA=GTP+2		;GT STATUS
	GTXCO=GTSTA+2		;GT X COORDINATE
	GTYCO=GTXCO+2		;GT Y COORD

	.IF	NDF,VTVEC
	VTVEC=320
	.ENDC

	STPAD=VTVEC		;STOP INTERRUPT ADDRESS
	LPAD=STPAD+4		;LITE PEN IN. ADDRESS
	.SBTTL		FVT ROUTINE

;FVT TURNS THE DISPLAY ON AND OFF AND ALLOCATES/DEALLOCATES
;THE DISPLAY FILE.  IT CALCULATES THE NUMBER OF BLOCKS NECESSARY
;TO SATISFY THE REQUESTED NUMBER OF LOCS AND REQUESTS THEM.  IT
;THEN LINKS TO THE RT11 DISPLAY HANDLER, THEN
;SETS UP ITS OWN LIGHT PEN VECTOR.

FVT:	FPMP			;GET ON/OFF ARG
	.WORD	FINT
	MOV	AC,-(SP)	;SAVE IT
	SORTC			;IF NO BUFFER ARG,
	RTPAR
	ONARG			;GO TURN DISPLAY
	.REMOV	LOK0		;REMOVE PREVIOUS FILE
	.UNLNK			;UNLINK
1$:
	EVAL.X			;ELSE, GET SIZE OF BUFFER
	MOV	#3,IDENT	;GET RID OF ANY PREVIOUS DFILE
	CLRM
	FPMP			;THEN GET NUMBER OF LOKS
	.WORD	FMUL+DIRECT	;*6 FOR WORD LENGTH
	.WORD	FP6
	.WORD	FINT
	TST	AC		;ON 0 COUNT
	BEQ	NOBUF		;EXIT NOW
	ADD	#777+4,AC	;THEN MAKE SURE IT GIVES ENOUGH BLOCKS
	SWAB	AC		;AND CONVERT TO BLOCKS
	BIC	#177400,AC
	ASR	AC
	MOV	AC,-(SP)	;SAVE AS LENGTH IN BYTES
	SWAB	(SP)
	ASL	(SP)
	MOV	AC,-(SP)	;SEND BLOCKS AS ARGUMENT
	REQM			;TO REQUEST MEMORY
	MOV	(SP),(PC)+	;THEN SAVE START OF USER'S AREA
LOK0:	.WORD	0		;(ADDRESS OF START OF DFILE)
	MOV	(SP),LPLOK	;AND SAY LAST LITE HIT AT LOK 0
	MOV	(SP)+,LOK	;SET UP ARGUMENT
	MOV	(SP)+,AC	;RETRIEVE LENGTH IN BYTES OF FILE
	CMP	-(AC),-(AC)	;LESS 4 FOR FINAL DELIMETER
	FPMP			;INTO FLAG
	.WORD	FLOAT
	.WORD	FDIV+DIRECT	;/6 FOR TOTAL LOCS
	.WORD	FP6
	.WORD	FINT		;AND INTEGERIZE IT
	ASL	AC		;AC*6
	MOV	AC,-(SP)
	ASL	AC
	ADD	(SP)+,AC
	ADD	LOK,AC		;ADD START OF FILE TO GET LAST WORD
	MOV	AC,(PC)+	;SAVE AS END OF FILE
TXTPTR:	.WORD	0		;(END OF DISPLAY FILE)
	JSR	PC,TJUMPS	;AND DNOP WHOLE FILE
	MOV	#DSTP,(LOK)+	;END WITH STOP INTERRUPT
	CLR	(LOK)+		;AND 0
	.LNKRT			;DO POINTERS AGAIN
	.SCROL	#STAB		;SET SCROLLING
ONARG:	.INSRT	LOK0		;INSERT ADDRESS OF FILE
NOBUF:	TST	(SP)+		;THEN IF FIRST ARGUMENT 0
	BGT	OFF
	.REMOV	LOK0		;TURN DISPLAY OFF
OFF:	MOV	#LPINT,@LPADR	;SET UP LIGHT PEN VECTOR
	MOV	#340,@LPADR+2
	RTS	PC


;FSTA SET SYNC, ITALICS, AND LIGHT PEN INTENSIFY BY LOADING A LOAD
;STATUS A INSTRUCTION INTO THE SECOND WORD OF THE LOC SPECIFIED AS ITS
;FIRST ARGUMENT.  IT LOADS THE LAST WORD WITH A DNOP AND THE
;FIRST WORD WITH CHARACTER MODE SO THAT FXCO AND FYCO RECOGNIZE A
;NON-COORDINATE LOC.
;	FUNCTION FORMAT		OPERATION
;	FSTA(LOC,M)		LOAD LOC WITH MODE M
;
;	VALUE OF M		MODE
;	  4			SYNC
;	  16			ITALICS
;	  64			LIGHT PEN INTENSIFY

FSTA:	JSR	PC,LOKSET	;GET LOC ARG
	TST	(LOK)+		;POINT TO SECOND WORD
	MOV	LOK,-(SP)	;AND SAVE
	EVAL.X			;GET MODE ARG
	FPMP
	.WORD	FINT
	MOV	(SP)+,LOK	;RETRIEVE ADDRESS
	MOV	#DSTA+250,(LOK) ;SET LOAD STATUS A
	ASL	AC		;SHIFT ARG LEFT 2 BITS
	ASL	AC
	BISB	AC,(LOK)+	;LOAD MODE BITS
	INC	LOK
	MOV	#DNOP,(LOK)	;3RD WORD DNOP
	CMP	-(LOK),-(LOK)	;POINT TO FIRST WORD
	MOV	#DCHR,(LOK)	;SET CHARACTER MODE
	JMP	RETNEW		;AND GOR RETURN LOK+1

	.SBTTL		FVEC, FMOV, FPT, FSET ROUTINES

;FVEC, FMOV, FPT, AND FSET EACH SET GRAPHIC MODE AND VISIBLITY
;THEN FALL THROUGH TO THE SAME CODE WHICH PLUGS A MODE
;WORD FOLLOWED BY TWO VT11 FORMATTED COORDINATES
;INTO THE LOC SPECIFIED BY THE FIRST ARGUMENT.


;FVEC, VISIBLE VECTOR
FVEC:	BIS	#DVEC,MODE	;MODE MAY CONTAIN MODES PUT
				;THERE BY FDIS
	BR	VISI		;GO SET VISIBLE BIT

;FMOV, INVISIBLE VECTOR
FMOV:	BIS	#DVEC,MODE	;ALSO LONG VECTOR
	BR	INV		;BUT INVISIBLE, DON'T SET BIT

;FPT, VISIBLE ABSOLUTE POINT
FPT:	BIS	#DPT,MODE
	BR	VISI

;FSET, INVISIBLE ABSOLUTE POINT
FSET:	BIS	#DPT,MODE
	BR	INV

VISI:	MOV	#40000,HYBITS
	BR	GRALL

INV:	CLR	HYBITS		;HYBITS ALREADY CLEAR, BUT MAKE SURE
GRALL:	JSR	PC,LOKSET	;GET LOKATION OF 1ST COORD (NO STOP)
	MOV	MODE,(LOK)+	;SET MODE
	JSR	PC,PLUGCO	;PUT X COORDINATE INTO FILE
	JSR	PC,PLUGCO	;PUT Y COORDINATE IN
	JMP	RETNEW		;RETNEW STARTS DISPLAY AND EXITS

;PLUGCO PICKS UP THE NEXT ARG, PUTS IT IN DISPLAYABLE
; FORMAT, AND ENTERS IT IN THE CURRENT CELL

PLUGCO:	MOV	LOK,-(SP)	;SAVE LOK ON STACK
	EVAL.X			;GET THE ARG
	FPMP
	.WORD	FINT
	MOV	(SP)+,LOK	;FETCH LOK
	JSR	PC,PUTCO	;PUTCO FORMATS IT INTO AC
	MOV	AC,(LOK)+	;PLUG IT IN
	RTS	PC
	.SBTTL		FTXT ROUTINE

;FTXT WILL INSERT UPTO 4 CHAR.S INTO A LOK..  
; FTXT(LOK,C1,C2,C3,...)
;LESS THAN 4 ARGS INSERTS NULLS; MORE THAN 4 GOES ON TO NEXT LOK..
;FTXT WILL MAKE ALL VALUES >40 BY ADDING 100 TO THEM IF NECESSARY

FTXT:	JSR	PC,LOKSET	;GET LOK. INTO LOK
MORTXT:PUTTXT:	MOV	LOK,-(SP) ;SAVE ADDRESS OF FIRST WORD
	TST	(LOK)+		;POINT TO SECOND WORD
	MOV	#-4,HYBITS	;HYBITS COUNTS OFF 4 CHAR.S
ASCII:	SORTC			;IF NO MORE ARGS,
	RTPAR
	YET			;THEN GO ADD 0'S
	BR	NOTYET

YET:	CLR	AC		;YES, INSERT ZEROES,
	BR	JUST0		;AND STOP GETTING ARG.S

NOTYET:	MOV	LOK,-(SP)	;SAVE LOK AROUND EVAL
	EVAL.X			;GET A CHARACTER
	FPMP
	.WORD	FINT
MAKSUR:	CMPB	AC,#40		;THEN ADD #100 TO VALUES <40
	BGE	DUNASC
	ADD	#100,AC
	BR	MAKSUR
DUNASC:	MOV	(SP)+,LOK	;RETRIEVE LOK
JUST0:	MOVB	AC,(LOK)+	;INSERT THE CHARACTER
	INC	HYBITS
	BLT	ASCII		;GO GET NEXT 4
	MOV	(SP)+,LOK	;AFTER 4 CHARS, GET ADDR OF FIRST WORD
ENDTXT:	MOV	#DCHR,(LOK)	;INSERT TEXT MODE
	BIS	MODE,(LOK)+	;WITH OTHER MODES
	CMP	(LOK)+,(LOK)+	;POINT LOK TO NEXT LOK
	SORTC			;END OF ARGS REAFCHED?
	RTPAR
	DUNCS
	BR	MORTXT		;IF NOT, DO NEXT LOK

DUNCS:	MOV	LOK,AC		;YES, RETURN NEXT LOK
	ADD	#4,AC		;MAKE SURE AC POINTS IN NEXT LOK
	JMP	RETLOK		;VIA XLP CODE


	.SBTTL		FSPC ROUTINE

;FSPC DISPLAYS THE SPECIAL CHARACTERS IN ITS SECOND AND THIRD
;ARGUMENTS.  IT DOES SO BY LOADING THE LOC WITH THE SEQUENCE
;SHIFT-IN, CHAR, CHAR, SHIFT OUT FOR TWO CHARACTERS
;OR SHIFT-IN CHAR SHIFT OUT, SHIFT OUT FOR ONE CHARACTER

FSPC:	JSR	PC,LOKSET	;GET LOK TO LOAD
	TST	(LOK)+		;POINT TO SECOND WORD
	MOV	#SHOUT,-(SP)	;CREATE 3 WORDS ON STACK: OUT
	MOV	(SP),-(SP)
	MOV	#SHIN,-(SP)
	MOV	LOK,-(SP)	;FOLLOWED BY POINTER
	SORTC			;TEST FOR AT LEAST 1 ARG
	RTPAR
	DUNSPC			;IF NOT, GO
	EVAL.X			;ELSE, GET ARG 1
	FPMP
	.WORD	FINT
	MOV	AC,4(SP)	;REPLACE 2ND WORD ON STACK
	SORTC			;TEST FOR 2 ARGS
	RTPAR
	DUNSPC			;IF NOT GO
	EVAL.X			;ELSE, GET THIRD ARG
	FPMP
	.WORD	FINT
	MOV	AC,6(SP)	;AND MAKE ARG THIRD WORD
DUNSPC:	MOV	(SP)+,LOK	;THEN RETRIEVE PPOINTER
	MOV	#3,R2		;COUNT TO THREE
SPCLOP:	MOV	(SP)+,AC	;GET A WORD
	BIC	#177740,AC	;MOD 40
	MOVB	AC,(LOK)+	;INSERT BYTE IN THE LOC
	DEC	R2		;INSERT 3 BYTES
	BGT	SPCLOP
	MOVB	#SHOUT,(LOK)+	;THEN END WITH AN OUT
	SUB	#6,LOK		;POINT LOK TO WORD 1
	BR	ENDTXT		;AND RETURN
	.SBTTL		FSKP ROUTINE

;FSKP LOADS A LOC WITH A JMP TO SOMEHWERE IN THE GRAPHICS FILE.
; FSKP(LOK) INSERTS A JMP TO THE END OF THE FILE.
; FSKP(LOK1,LOK2) INSERTS A JUMP TO LOK2. FOR LOK2<0 IT INSERTS
;	A JUMP TO THE START OF THE FILE.
;THE FIRST WORD OF THE LOADED LOC CONTAINS A MODE WORD WHICH SERVES
;NO OTHER PURPOSE THAN TO CHANGE THE 4 SETTABLE MODES.

FSKP:	JSR	PC,LOKSET	;GET 1ST LOK. INTO LOK
	BIS	#DCHR,MODE	;MAKE MODE INTO CHARACTER MODE WORD
	MOV	MODE,(LOK)+	;INSERT MODE OF JUMP
	TST	(LOK)+		;POINT TO THIRD WORD
	MOV	LOK,-(SP)	;SAVE ADDRESS OF SECOND WORD
	SORTC			;IF NO SECOND ARG,
	RTPAR
	TXTJMP			;INSERT JUMP TO END OF FILE
	EVAL.X			;ELSE, GET 2ND ARG
	FPMP
	.WORD	FMUL+DIRECT
	.WORD	FP6
	.WORD	FINT
	TST	AC		;ON ARG <0,
	BGE	NOTBAK
NOTEXT:	CLR	AC		;JUMP TO START OF FILE
NOTBAK:	ADD	LOK0,AC		;+START OF FILE(LOK0)
	CMP	AC,TXTPTR	;IF 2ND LOK OVERLAPS TEXT,
	BLE	INFILE
TXTJMP:	MOV	TXTPTR,AC
INFILE:	MOV	(SP)+,LOK	;GET LOK FROM STACK
	MOV	AC,(LOK)	;AND INSERT THE JUMP ADDR.(NO 3RD WORD)
	MOV	#DJMP,-(LOK)	;LAST INSERT THE JUMP
	JMP	RETNEW		;DONE, GO RETURN NEXT FREE LOK



	.SBTTL		FDIS ROUTINE

;FDIS WITH ONE NEGATIVE ARGUMENT OR 4 ARGUMENTS
;SETS UP MODE WITH THE SPECIFIED MODES. THE NEXT ENTRY IN THE
;GRAPHICS FILE USES THIS MODE, THEN CLEARS IT.
;FDIS(LINETYPE[0-3],INTENSITY[0-7],BLINK[0-1],L.P.[0-1])
;FDIS(MODEBITS)
;FDIS WITH ONE ARGUMENT GREATER THAN OR EQUAL TO 0 RETURNS THE FIRST WORD
;OF THE LOC SPECIFIED BY THE ARGUMENT.
;FOR ONE ARGUMENT LESS THAN 0 IT TAKES THE LOW 11 BITS OF
;THE ARGUMENT, THOSE CONTAINING THE MODE SETTINGS AND REPLACES
;THE CURRENT MODE WORD WITH THESE.

FDIS:	SORTC			;IF ONLY ONE ARGUMENT,
	RTPAR
	MODEP			;GO PLUG IN THE MODE
	CLR	-(SP)		;ELSE,
	FPMP			;GET LINE TYPE INTO LOW BITS
	.WORD	FINT
	TST	AC		;IF AC >=0,
	BLT	1$
	BIS	#4,(SP)		;SET ENABLE BIT
1$:	BIC	#177770,AC	;MAKE SURE NO OVERFLOW
	MOV	AC,MODE		;ENTER THE LINE TYPE
	EVAL.X			;GET INTENSITY
	FPMP
	.WORD	FINT
	TST	AC
	BLT	2$
	BIS	#2000,(SP)
2$:	SWAB	AC		;PUT IT IN BITS 7,8,9
	ASR	AC
	BIC	#176177,AC	;NO OVERFLOW
	BIS	AC,MODE		;ENTER IN MODE
	EVAL.X			;GET BLINK
	FPMP
	.WORD	FINT
	TST	AC
	BLT	3$
	BIS	#20,(SP)
3$:	TST	AC		;POS HORD MEANS BLINK
	BEQ	NOBLI
	BIS	#10,MODE	;SET BLINK BIT
NOBLI:	EVAL.X			;GET LITE PEN SENSITIVITY
	FPMP
	.WORD	FINT
	TST	AC
	BLT	4$
	BIS	#100,(SP)
4$:	TST	AC
	BEQ	NOLP
	BIS	#40,MODE	;SET LP SENSITIVE BIT
NOLP:	BIS	(SP)+,(PC)+	;SET ALL ENABLE BITS
MODE:	.WORD	0		;(MODE BITS FOR NEXT LOC)
	RTS	PC		;RETURN TO FOCAL

MODEP:	FPMP			;ONE ONE ARG, GET IT
	.WORD	FINT
	TST	AC		;ON ARG>=0,
	BGE	MODBAK		;GO RETURN MODE
	BIC	#174000,AC	;ELSE, LEAVE ONLY 4 MODE TYPES
	MOV	AC,MODE		;AND MAKE IT THE MODE WORD
	RTS	PC

MODBAK:	JSR	PC,LOKGET	;GET LOK
	MOV	(LOK),AC
	FPMP			;RETURN 1ST WORD
	.WORD	FLOAT
	RTS	PC
	.SBTTL		FXCO, FYCO AND FLP ROUTINES

;FXCO AND FYCO RETURN X AND Y COORDINATES OF LOK. SPECIFIED IN CALL

FXCO:	CLR	-(SP)		;SAVE OFFSET OF COORD. IN STACK
	BR	COCO
FYCO:	MOV	#2,-(SP)	;Y COORD. ONE WORD DOWN
COCO:	JSR	PC,LOKGET	;GET LOK. INTO LOK(+4 TO NOT STOP DISPLAY)
	MOV	#-4095.,AC	;SET AC NEGATIVE
	BIT	#10000,(LOK)+	;IF THIS BIT NOT ON IN MODE, THEN JMP OR CHR
	BEQ	OUTCO		;RETURN -4095.
	ADD	(SP), LOK	;WITH OFFSET,LOK POINTS TO COORD
	MOV	(LOK),AC	;GET COORD IN DISPLAY FORMAT
	BIT	#20000,AC	;TEST NEGATIVE BIT
	BEQ	POSOUT		;IF POSITIVE, EVERYTHING OK
	MOV	(LOK),AC	;IF NEG, MAKE INTO A 16 BIT NEGATIVE
	BIC	#60000,AC	;GET RID OF NEG BIT AND VIS-INV BIT,
	NEG	AC		;AND NEGATE
	BR	OUTCO
POSOUT:	BIS	(LOK),AC	;AC=0 ON POS. COORD
	BIC	#40000,AC	;CLEAR VIS-INV. BIT
OUTCO:	TST	(SP)+		;POP OFFSET
	FPMP			;FLOAT COORD INTO FLAC
	.WORD	FLOAT
	RTS	PC		;AND RETURN TO FOCAL


;FLP RETURNS LOK.. OF LAST LP HIT; THE THE LAST LIGHT PEN
;INTERRUPT HAS PUT THE ADRESS OF THIS LOC IN 'LPLOK'.
;IF FLP GETS AN ARGUMENT <=0, IT WAITS FOR A LIGHT PEN
;INTERRUPT TO OCCUR BY CLEARING A FLAG THAT THE INTERRUPT ROUTINE
;SETS.

FLP:	FPMP			;GET ARG
	.WORD	FINT
	TST	AC
	BNE	RETNOW		;ON .EQ. 0,
	CLR	(PC)+		;WAIT FOR LP HIT
LPLOK:	.WORD	0		;(LOC OF LAST L.P. HIT)
RETNOW:	TST	LPLOK		;BEFORE RETURNING
	BEQ	RETNOW
	MOV	LPLOK,AC	;GET ADDRESS
RETLOK:	SUB	LOK0,AC		;MAKE INTO AN OFFSET FROM LOK0
	FPMP			;INTO FLAC
	.WORD	FLOAT
	.WORD	FDIV+DIRECT	;DIVIDED BY 6
	.WORD	FP6
	.WORD	FINT		;INTEGERIZE IT
	.WORD	FLOAT
	RTS	PC		;BACK TO FOCAL


	.SBTTL		FCLR AND FSCR ROUTINES

;FCLR CLEARS THE SCREEN BY INSERTING DNOP'S STARTING AT THE LOC
;SPECIFIED AS ITS FIRST ARGUMENT AND CONTINUING TILL THE LOC
;SPECIFIED AS ITS SECOND ARGUMENT.  FOR NO SECOND ARGUMENT IT CLEARS
;TO THE END OF THE FILE.

FCLR:	JSR	PC,LOKSET	;GET ARG AND STOP DISPLAY
	MOV	LOK,-(SP)	;SAVE STARTING LOK
	SORTC			;IF MORE THAN ONE ARG
	RTPAR
	C1
	EVAL.X			;GET 2ND ARG
	JSR	PC,LOKSET	;CONVERT TO OFFSET IN LOK
	MOV	LOK,AC		;SET UP END ARGUMENT
	BR	C2		;AND GO CLEAR FILE
C1:	MOV	TXTPTR,AC	;IF 1 ARGUMENT, CLEAR TILL END
C2:	MOV	(SP)+,LOK	;GET STARTING ARGUMENT
	JSR	PC,TJUMPS	;CLEAR THE SCREEN UP TO TEXT POINTER
	BR	RETNEW		;RETURN ARG+1 AND START DISPLAY


;FSCR DOES A .SCROLL TO ALTER THE SCROLLING.

FSCR:	FPMP			;GET NUMBER OF LINES
	.WORD	FINT
	MOVB	AC,SLINES	;INTO LINES BYTE
	EVAL.X			;GET INTENSITY
	FPMP
	.WORD	FINT
	MOVB	AC,INTEN	;INTO INTENSITY BYTE
	EVAL.X			;GET Y COORDINATE
	FPMP
	.WORD	FINT
	MOV	AC,YTOP		;INTO Y WORD
	.SCROL	#STAB		;AND SET SCROLLING
	RTS	PC

STAB=.
SLINES:	.BYTE	40.		;(LINES OF SCROLLING)
INTEN:	.BYTE	6		;(INTENSITY OF SCROLLING)
YTOP:	.WORD	1023.		;(TOP Y COORDINATE)

	.SBTTL		UTILITY ROUTINES

;TJUMPS ADDS DNOP'S STARTING AT THE ADDRESS SPECIFIED IN 'LOK' UP
;TO THE ADDRESS SPECIFIED IN 'AC'.

TJUMPS:
NOPLOP:	CMP	LOK,AC
	BLT	MORNOP		;FILLED TO TEXTPTR?
	RTS	PC		;YES, RETURN
MORNOP:	MOV	#DNOP,(LOK)+	;DNOP A WORD
	BR	NOPLOP

;LOKSET GETS LOK ARG INTO NEWLOK, TESTS FOR IN RANGE, MULTIPLIES BY
; 6 AND ADDS START OF FILE. LOK ENDS UP CONTAINING ADDRESS OF CELL

LOKSET:	FPMP			;GET LOK ARG
	.WORD	FINT
	MOV	AC,(PC)+	;WHICH SAVE
NEWLOK:	.WORD	0		;(CURRENT LOK ARGUMENT)
LOKGET:	FPMP			;LOK*6
	.WORD	FMUL+DIRECT
	.WORD	FP6
	.WORD	FABS		;ABS VALUE
	.WORD	FINT
	MOV	AC,LOK		;LOK HAS ADDRESS OFFSET
	ADD	LOK0,LOK	;NOW IT HAS THE ADDRESS OF THE BLOCK
	CMP	LOK,TXTPTR
	BLT	BELOW
TOOBIG:	MOV	TXTPTR,LOK	;ON ABOVE, MAKE LOK=LAST LOK
	SUB	#6,LOK
	NEG	NEWLOK		;MAKE RETURNED LOK NEG. ON ERR
BELOW:	RTS	PC
FP6:	.WORD	40700		;(FLOATING POINT 6)
	.WORD	0
	.WORD	0
	.WORD	0


;PUTCO TURNS AN INTEGER VALUE IN COARG INTO A COORDINATE SUITABLE
; FOR DISPLAY IN AC. HYBITS ALREADY CONTAINS VIS-INV BIT
; CALL BY:	MOV	COORD,AC	;GET COORDINATE
;	JSR	PC,PUTCO

PUTCO:	TST	AC		;ON NEGATIVE COORDINATE,
	BGE	POSCO
	BIS	#20000,HYBITS	;SET NEGATIVE BIT
	NEG	AC		;MAKE POSITIVE
POSCO:	BIS	HYBITS,AC	;PUT IN VIS-INV AND NEG-POS BITS
	CLR	(PC)+		;AND CLEAR HYBITS FOR NEXT TIME
HYBITS:	.WORD	0		;(VIS/INVIS BITS FOR X-COORDINATE WORD)
	RTS	PC


;RETNEW RETURNS THE CALLER HIS LOK ARG PLUS 1

RETNEW:	CLR	MODE		;ONLY USE THE SETTING ONCE
	MOV	NEWLOK,AC	;GET LOK ARG
	INC	AC		;+1 FOR RETURN
	FPMP
	.WORD	FLOAT
	RTS	PC		;RETURN TO FOCAL




	.SBTTL		LIGHT PEN INTERRUPT ROUTINE

;LPINT HANDLES LIGHT PEN INTERRUPTS.  THESE OCCUR WHENEVER A LINE
; USER DIFINED AS LP SENSITIVE GETS HIT.
; THE LP INTERRUPT ROUTINE SIMPLY TAKES THE COORDS OF THE HIT AND 
; PUTS THEM IN LOK 0 AND TAKES THE ADDRESS OF THE HIT AND PUTS IT
; INTO LPLOK.

LPINT:	MOV	AC,-(SP)	;SAVE REGISTERS
	MOV	LOK,-(SP)
	MOV	LOK0,LOK	;ON CHAR MODE OR JUMP IN LOK0,
	MOV	(LOK)+,AC
	BIC	#163777,AC	;(BITS 11 AND 12 NOT SET)
	BEQ	NOLPCO		;DON'T INSERT
	MOV	@GTX,AC	;ELSE, GET X COORDINATE OF HIT
	BIT	#40000,(LOK)	;TEST WHETHER COORDS IN LOK 0 NOW
				;ARE VISIBLE
	BEQ	INV0
	BIS	#40000,AC	;IF NOT, SET INV BIT IN
				;NEW X COORDINATE
INV0:	MOV	AC,(LOK)+	;INSERT THE LP HIT COORDINATES
	MOV	@GTY,AC	;GET GTY ,
	BIC	#176000,AC	;RID OF CHARACTER REGISTER BITS
	CMP	AC,#1400	;AND MAKE SURE NOT ABOVE SCREEN
	BLT	ONPIC
	MOV	#1377,AC
ONPIC:	MOV	AC,(LOK)	;MOVE Y COORD IN NOW
NOLPCO:	MOV	@GTPC,LPLOK	;NOW SAVE PC AT TIME OF HIT
	MOV	#1,@GTPC	;RESTART THE DISPLAY WHERE IT LEFT OFF
	MOV	(SP)+,LOK	;RESTORE REGISTERS
	MOV	(SP)+,AC
	RTI			;AND RETURN




	.SBTTL		ADDRESS AND VECTOR PATCH AREA

GTPC:	.WORD	GTP		; DISPLAY PC
GTSR:	.WORD	GTSTA		;DISPLAY DSTATUS REGISTER
GTX:	.WORD	GTXCO		;X COORDINATE
GTY:	.WORD	GTYCO		;Y COORDINATE

STPADR:	.WORD	STPAD		;STOP VECTORE
STPPRI:	.WORD	STPAD+2		;STOP PRIORITY
LPADR:	.WORD	LPAD		;LIGHT PEN VECTOR
LPPRI:	.WORD	LPAD+2		;LIGHT PEN PRIORITY

	.ENDC
	.ENDC
	.IF	DF,VT55
	.SBTTL	VT55 FUNCTIONS

	.IF	NDF,$PAPER
	.GLOBL	FGRA,FGRD,FXY,FMRK,FMD0,FMD1,FCUR,FALP
	.ENDC

	.IF	DF,$PAPER
	VT55S=1714		;SIZE OF FUNCTION
	FB=FB-40		;EXTEND TABLE UP
	.=FB			;POINT TO BASE OF FUNCTION TABLE
	.WORD	0,0		;END TABLE WITH TWO 0'S
	.WORD	FGRA
	.WORD	13571
	.WORD	FGRD
	.WORD	13574
	.WORD	FXY
	.WORD	3031
	.WORD	FMRK
	.WORD	13743
	.WORD	FMD0
	.WORD	13620
	.WORD	FMD1
	.WORD	13621
	.WORD	FCUR
	.WORD	13526
	.WORD	FALP
	.WORD	13420

	FS=FS+VT55S		;INCREASE TOTAL FUNCTION LENGTH
	.=FTOP-FS		;SET START OF FUNCTION
	.ENDC

	GON=105			;SET GRAPHICS ON TO 'E' FOR PROTOTYPE
	.IF	NDF,PROTO
	GON=61			;THEN IF PRODUCTION MODEL, SWITCH TO A 1
	.ENDC
	.SBTTL		FXY ROUTINE

;FXY DRAWS A LINE ON THE SCREEN.
;FORMAT: FXY(G,SX,SY,EX,EY,DX)
;	     GRAPH,STARTX,STARTY,ENDX,ENDY,DELTAX
;FXY(G) ERASES GRAPH G
;FXY(G,SX) ERASES POINT X
;FXY(G,SX,SY) DRAWS A POINT AT (SX,SY)
;FXY(G,SX,SY,EX) DRAWS A HORIZONTAL LINE
;FXY(G,SX,SY,EX,EY) DRAWS A LINE
;FXY(G,SX,SY,EX,EY,DX) DRAWS A LINE WITH POINTS EVERY DX

FXY:	MOV	#237.,(PC)+	;INITIALIZE Y'S
SY:	.WORD	0		;(START Y VALUE)
	MOV	#237.,(PC)+
EY:	.WORD	0		;(END Y VALUE)
	CLR	(PC)+		;AND X'S
SX:	.WORD	0		;START X VALUE
	MOV	#512.,(PC)+
EX:	.WORD	0		;(END X VALUE)
	MOV	#1,(PC)+	;AND DX TO 1
DX:	.WORD	0		;(DELTA X)
	FPMP
	.WORD	FINT		;GET GRAPH NUMBER
	DEC	AC		;MAKE AC 0 OR 1
	MOV	AC,-(SP)
	JSR	PC,GETARG	;IF NO MORE ARGS,
	BR	DOLINE		;GO CLEAR GRAPH

	MOV	AC,SX		;ELSE, MAKE IT START X
	MOV	AC,EX		;AND END X
	JSR	PC,GETARG	;GET ARG: IF NO MORE,
	BR	DOLINE		;GO CLEAR AN X VALUE

	MOV	AC,SY		;ELSE, START Y
	MOV	AC,EY		;AND END Y
	JSR	PC,GETARG	;GET ARG: IF NO MORE,
	BR	DOLINE		;GO CLEAR A POINT

	MOV	AC,EX		;ELSE, END X
	JSR	PC,GETARG	;GET ARG: IF NO MORE,
	BR	DOLINE		;GO CLEAR FROM SXTO EX

	MOV	AC,EY		;ELSE, END Y
	JSR	PC,GETARG	;GET ARG: IF NO MORE,
	BR	DOLINE		;GO DRAW LINE DELTA 1

	MOV	AC,DX		;ELSE, DELTA X
DOLINE:	MOV	EX,AC		;GET EX-SX
	SUB	SX,AC
	BEQ	ZENT		;IF NO DIFFERENCE, GO
	FPMP			;ELSE, STORE AS FLOATING
	.WORD	FLOAT
	.WORD	FPUT+DIRECT
	.WORD	EXSX
	MOV	EY,AC		;GET EY-SY
	SUB	SY,AC
	FPMP			;INTO FLAC
	.WORD	FLOAT
	.WORD	FDIV+DIRECT	;GET (EY-SY)/(EX-SX)
	.WORD	EXSX
	.WORD	FPUT+DIRECT	;AND SAVE RESULT
	.WORD	EXSX
ZENT:	MOV	SX,(PC)+	;GET CURRENT X
CX:	.WORD	0		;(CURRENT X)
	MOV	SY,(PC)+	;AND Y
CY:	.WORD	0		;(CURRENT Y)
LOOPL:	MOV	CX,TEMP		;SET X
	JSR	PC,STARTX
	MOV	CY,TEMP		;AND PLOT A Y
	MOV	(SP),AC		;ON GRAPH
	JSR	PC,YPT
	ADD	DX,CX		;GET NEW X
	MOV	CX,AC		;GET CX-SX
	SUB	SX,AC
	FPMP			;INTO FLAC
	.WORD	FLOAT
	.WORD	FMUL+DIRECT	;*THE RATIO
	.WORD	EXSX
	.WORD	FINT		;GET RESULT, THE NEW Y
	ADD	SY,AC		;CY=SY+(CX-SX)*(EY-SY)/(EX-SX)
	MOV	AC,CY
	CMP	CX,EX		;AND LOOP TILL DONE
	BLE	LOOPL
	TST	(SP)+		;RID GRAPH NUMBER
	RTS	PC		;ELSE RETURN

EXSX:	.WORD	0,0,0,0		;(4 WORD FLOATING VALUE)

	.SBTTL		FGRD ROUTINE

;FGRD PLOTS A GRID ON THE SCREEN.
;FORMAT: FGRD(VN,VX,VD,HN,HX,HD)
;	      VERTICAL LINES,STARTX,DELTAX,HOR LINES,STARTY,DELTAY
;FGRD(VN) PLOTS VN LINES FROM 0 TO 512
;FGRD(VN,VX) PLOTS VN LINES FROM VX TO 512
;FGRD(VN,VX,VD) PLOTS VN LINES FROM VX WITH VD BETWEEN EACH
;FGRD(0,1 TO 3 ARGS) DOES AS ABOVE FOR HORIZONTAL LINES FROM 0 TO 236.

FGRD:	FPMP			;GET 1ST ARG
	.WORD	FINT
	TST	AC		;IF IT=0
	BEQ	NOX		;GO PROCESS HORIZONTAL
	MOV	AC,-(SP)	;SAVE 1ST ARG
	MOV	#114,-(SP)	;ELSE, SAY VERT COMING
	JSR	PC,SENDF	;SEND FUNCTION CODE

	MOV	(SP)+,AC	;RESTORE 1ST ARG
	MOV	#511.,SIZE	;SET FOR HORIZONTAL SCREEN SIZE
	JSR	PC,MAT		;THEN PROCESS THESE 3 ARGS
	SORTC			;NEXT, TEST IF DONE
	RTPAR
	VER3			;IF SO, QUIT
NOX:	MOV	#104,-(SP)	;ELSE, SAY HORIZONTAL COMING
	JSR	PC,SENDF	;SEND FUNCTION CODE
	EVAL.X			;GET ARG
	FPMP
	.WORD	FINT
	MOV	#235.,SIZE	;SET FOR VER. SCREEN SIZE
	JSR	PC,MAT		;AND PROCESS THESE THREE
VER3:	RTS	PC

MAT:	MOV	AC,-(SP)	;ARG1 GIVES TOTAL LINES
	JSR	PC,GETARG	;GET ARG: IF NO MORE,
	BR	A1		;GO PLOT THIS LINE
	MOV	AC,(PC)+		;AND SAVE IT
CUR:	.WORD	0		;(CURRENT COORDINATE VALUE)
	JSR	PC,GETARG	;GET ARG: IF NO MORE,
	BR	A2		;GO PLOT TO END OF SCREEN
	MOV	AC,(PC)+
DELTA:	.WORD	0		;(DISTANCE BETWEEN LINES)
DOGR:	MOV	#20,AC		;SET FOR VISIBLE LINE
	TST	(SP)		;IF COUNT =0, ALL DONE
	BEQ	DUNGR
	BGT	LINON		;IF >0, LINES ON
	CLR	AC		;ELSE, SET FOR LINES OFF
	INC	(SP)		;AND INC COUNT
	BR	LINOFF
LINON:	DEC	(SP)		;IF POS COUNT, DEC IT
LINOFF:	MOV	CUR,TEMP	;GET CURRENT X
	JSR	PC,DATA		;PLOT IT
	ADD	DELTA,CUR	;ADD DELTAX
	BR	DOGR		;AND DO SOME MORE
DUNGR:	TST	(SP)+		;RID COUNT
	RTS	PC		;DONE

A1:	CLR	CUR		;SET START X TO 0

A2:	MOV	(PC)+,AC	;FIGURE DELTA TO END OF SCREEN
SIZE:	.WORD	0		;(SIZE OF SCREEN)
	SUB	CUR,AC		;GIVEN COUNT AND START
	DEC	(SP)		;SET TO LINES-1 FOR DIVISION
	BEQ	DUNSUB		;IF ONE LINE DELTA DOESN'T MATTER
	CLR	TEMP
SUBL:	SUB	(SP),AC
	BLT	DUNSUB
	INC	TEMP
	BR	SUBL

DUNSUB:	INC	(SP)		;RESTORE LINE COUNT
	MOV	TEMP,DELTA	;SAVE THE DELTA
	BR	DOGR		;AND GO DRAW


	.SBTTL		FMRK ROUTINE

;FMRK PLOTS AND ERASES MARKERS
;FORMAT: FMRK(G,X,ON/OFF)
;FMRK(G,X) TURNS THE MARKER AT X OF GRAPH G ON
;FMRK(G,X,ON/OFF) TURNS THE MARKER AT X ON OR OFF(ON/OFF=1 OR 0)

FMRK:	FPMP
	.WORD	FINT
	DEC	AC		;MAKE GRAPH 0 OR 1
	BIC	#177776,AC
	ASL	AC		;*8 FOR PROPER BIT
	ASL	AC
	ASL	AC
	ADD	#103,AC		;TO MAKE FUNCTION VALUE
	MOV	AC,-(SP)	;AND SET IT UP TO VT55
	JSR	PC,SENDF	;SEND FUNCTION CODE
	EVAL.X			;GET COORINATE ARG
	FPMP
	.WORD	FINT
	MOV	AC,-(SP)	;SAVE COORDINATE
	SORTC			;THEN IF A 3RD ARG,
	RTPAR
	ONMRK
	EVAL.X
	FPMP			;GET IT AS ON/OFF
	.WORD	FINT
	TST	AC		;0 MEANS OFF
	BEQ	OFFMRK		;IN WHICH CASE SET AC=0
ONMRK:	MOV	#20,AC		;FOR <>0, SET #20 BIT IN AC
OFFMRK:	MOV	(SP)+,TEMP	;RETRIEVE COORDINATE
	JSR	PC,DATA		;SEND DATA TO VT55
	RTS	PC		;THAT'S ALL


	.SBTTL		FMD0 AND FMD1 ROUTINES


;FUNCTIONS FMD0 AND FMD1
;FORMAT: FMD0(D,P,H)
;		DISPLAY ON/OFF,POINTS ON/OFF,HISTOGRAMS ON/OFF
;D CAN TAKE THE VALUE 0 (OFF) OR 1 (ON)
;P CAN TAKE THE VALUES 0(BOTH OFF), 1 (GRAPH 1 ON), 2(GRAPH 2 ON)
;	OR 3 (BOTH ON)
;H CAN TAKE THE SAME AS P
;
;FORMAT:FMD1(I,HV,M)
;	     INIT,HORIZONTAL/VERTICAL,MARKERS
;I CAN TAKE THE VALUE 1 (INIT) OR 0 (DON'T INIT)
;HV CAN TAKE VALUE 0 (H AND V OFF), 1 (V ON), 2 (H ON),OR 3 (BOTH ON)
;M TAKES THE SAME VALUES AS P ABOVE

FMD0:	MOV	#101,-(SP)	;SET COMMAND TO MODE 0
	JSR	PC,SENDF	;SEND FUNCTION CODE
	MOV	#MODE0,TEMP	;AND POINT TO MODE BYTES
	JSR	PC,GET3		;GET 3 ARGS IN THEM
	MOV	MODE0+2,-(SP)	;GET 3RD ARG, HISTOGRAMS
	ASL	(SP)		;SHIFT TO PROPER BITS
	ASL	(SP)
	BISB	MODE0+1,(SP)	;SET HISTOGRAM ON/OFF BITS
	ASL	(SP)		;SHIFT ALL BITS
	TSTB	MODE0		;AND DISPLAY BIT
	BEQ	NOD
	INC	(SP)
NOD:	BISB	#40,(SP)	;SET PRINTING BIT
	MOV	#1,AC		;AND SEND
	JSR	PC,SEND
	RTS	PC


FMD1:	MOV	#111,-(SP)	;SET FOR MODE1 LOAD
	JSR	PC,SENDF	;SEND FUNCTION CODE
	MOV	#MODE1,TEMP	;POINT TO MODE1 BYTES
	JSR	PC,GET3		;GET 3 ARGUMENTS
	MOV	MODE1+1,-(SP)	;GET 2ND ARG, MARKER ON/OFF
	ASL	(SP)		;INTO PROPER BITS
	ASL	(SP)
	BISB	MODE1+2,(SP)	;SET HOR/VER ON/OFF
	TSTB	MODE1		;THEN SET INIT BIT
	BEQ	NOD
	BIS	#20,(SP)	;SET INIT BIT IF ASKED FOR
	BR	NOD
MODE0:	.BYTE	0,0,0		;MODE0: DISPLAY,POINTS,HISTOGRAMS
MODE1:	.BYTE	0,0,0		;MODE1: INIT,HOR/VER,MARKERS

;ROUTINE GET3 GETS UP TO 3 ARGUMENTS AND PUTS EACH ONE STARTING AT
;THE BYTE POINTED TO BY TEMP, MOD 4.  FOR ARGUMENTS<0, IT DOES NOT
;ALTER THE CORRESPONDING BYTE.

GET3:	FPMP			;GET 1ST ARG
	.WORD	FINT
	MOV	#3,-(SP)	;COUNT 2 MORE
UNDUN3:	TST	AC		;IF ARGUMENT < 0
	BLT	OLD		;LEAVE OLD VALUE OF THIS MODE
	MOVB	AC,(TEMP)	;OTHERWISE, CHANGE IT
	BICB	#374,(TEMP)+	;MOD 4
OLD:	MOV	TEMP,-(SP)	;SAVE ADDRESS TO PUT THEM
	JSR	PC,GETARG	;GET NEXT
	BR	DUN3		;QUIT IF NO MORE
	MOV	(SP)+,TEMP	;ELSE, RETRIEVE CURRENT ADDRESS
	DEC	(SP)		;DO UP TO 3
	BGT	UNDUN3
DUNG:	TST	(SP)+		;THEN RID COUNTER
	RTS	PC		;AND RETURN

DUN3:	TST	(SP)+
	BR	DUNG

	.SBTTL		UTILITY ROUTINES

;ROUTINE Y TAKES THE VALUE IN AC AS THE GRAPH WHICH IT SHIFTS INTO
;BIT 3 AND ADDS 102 TO CREATE THE FUNCTION ADD A Y TO ONE OF THE TWO
;GRAPHS.  IT SENDS THIS, IF NECESSARY, THEN SENDS THE DATA IN TEMP AS THE Y VALUE TO
;SEND.

YPT:	BIC	#177776,AC
	ASL	AC		;SHIFT GRAPH TO BIT 3
	ASL	AC
	ASL	AC
	ADD	#102,AC		;AC CONTAINS GRAPH, MAKE FUNCTION
	MOV	AC,-(SP)	;AND SEND IT OUT
	JSR	PC,SENDF	;SEND FUNCTION CODE
	CLR	AC		;THEN SEND THE DATA
	JSR	PC,DATA
	INCB	CURX		;INCREMENT X BECAUSE VT55 
	RTS	PC

;ROUTINE DATA DIVIDES THE VALUE IN TEMP INTO TWO BYTES AND
;PUSHES THEM ONTO THE STACK.  EACH BYTE CONSISTS OF 5 BITS FROM
;THE VALUE IN TEMP, WITH THE SIXTH BIT SET TO MAKE A PRINTING
;CHARACTER OF EACH.  THE VALUE IN AC IS ALSO SET INTO THE FIRST
;BYTE PUSHED ON THE STACK (THE HIGH ORDER BYTE).  THE CALLING ROUTINE
;SETS AC TO EITHER 0 OR 20.  THE #20 BIT ON CURSOR COORDINATE OUTPUT INDICATES
;WHETHER TO SET OR CLEAR THE CURSOR.

DATA:	MOV	TEMP,-(SP)	;GET DATA
	ASR	(SP)		;HIGH BYTE
	ASR	(SP)
	ASR	(SP)
	ASR	(SP)
	ASR	(SP)
	BIC	#177740,(SP)	;LOW 5 BITS
	BIS	#40,(SP)	;SET PRINTING BIT
	BIS	AC,(SP)		;SET BIT 4, IF AC HAS IT SET
NOSET:	BIC	#177740,TEMP	;THEN GET LOW BITS
	BIS	#40,TEMP
	MOV	TEMP,-(SP)	;WHICH GO OUT FIRST
	MOV	#2,AC		;SEND THEM BOTH
	JSR	PC,SEND
	RTS	PC


STARTX:	CMP	TEMP,(PC)+	;IS ARG ALREAD X?
CURX:	.WORD	0		;(CURRENT X)
	BEQ	XOK		;IF NOT,
	MOV	#110,-(SP)	;SET CURRENT X
	MOV	TEMP,CURX	;CHANGE CURRENT X
	JSR	PC,SENDF	;SEND FUNCTION CODE
	CLR	AC		;SEND NEW X
	JSR	PC,DATA
XOK:	RTS	PC


SEND:	MOV	(SP)+,(PC)+	;SAVE RETURN ADDR
RET:	.WORD	0		;(RETURN ADDRESS)
	MOV	CHAR,R2		;SAVE CHAR
SL:	MOV	(SP)+,CHAR	;GET A CHARACTER FROM STACK
	OUTCH			;SEND IT OUT
	DEC	AC		;TILL COUNT EXHAUSTED
	BGT	SL
	MOV	R2,CHAR		;RESTORE CHAR
	JMP	@RET


;SENDF SENDS THE FUNCTION CODE ON THE STACK IF NECESSARY

SENDF:	MOV	(SP)+,(PC)+	;SAVE RETURN
RETUF:	.WORD	0		;(RETURN ADDRESS)
	CMP	(SP),(PC)+	;IF REQUESTED FUNC CURRENT,
FUNC:	.WORD	0		;(FUNCTION LAST SENT)
	BEQ	NONEED
	MOV	(SP),FUNC	;SET NEW FUNCTION
	MOV	#1,AC		;SAY 1 CHARACTER
	JSR	PC,SEND		;SEND IT
	BR	BAKF
NONEED:	TST	(SP)+		;IF NO SEND, POP THE FUNCTION
BAKF:	JMP	@RETUF		;RETURN VIA JUMP


	.SBTTL		CURSOR CONTROL ROUTINE

;FUNCTION FCUR
;FORMAT: FCUR(C,L,A,B,...)
;FCUR(C) SHIFTS C CHARACTERS RIGHT OR LEFT
;FCUR(C,L) SHIFTS L LINES UP OR DOWN AND C CHARACTERS RIGHT OR LEFT
;FCUR(C,L,A,B,...) SHIFT THE CURSOR THEN PLOTS VERTICALLY DOWNWARD THE
;		   CHARACTERS SPECIFIED BY THE TRAILING ARGUMENTS

FCUR:	FPMP			;GET FIRST ARG
	.WORD	FINT
	MOV	AC,-(SP)		;SAVE COUNT
LFTC:	TST	(SP)		;TEST FOR LINES TO GO
	BEQ	NOC		;NO LINE CHANGE, IF 0 ARG
	BLT	NXTC
	DEC	(SP)		;DEC COUNT
	MOV	#103,-(SP)	; >0 MEANS SPACE RIGHT
	MOV	#33,-(SP)
	MOV	#2,AC
	BR	COUT

NXTC:	INC	(SP)		;INC COUNT
	MOV	#10,-(SP)	;<0 MEANS LEFT
	MOV	#1,AC
COUT:	JSR	PC,SEND		;SEND IT OUT
	BR	LFTC

NOC:	SORTC			;TEST FOR ANOTHER ARG
	RTPAR
	NOL
	EVAL.X			;GET  NEXT ARG
	FPMP			;GET FIRST ARG
	.WORD	FINT
	MOV	AC,(SP)
SCUR:	TST	(SP)		;TEST FOR LINES TO GO
	BEQ	NOL		;NO LINE CHANGE, IF 0 ARG
	BGT	UPL
	INC	(SP)		;DEC COUNT
	MOV	#101,-(SP)	;ELSE >0 MEANS DOWN A LINE
	MOV	#33,-(SP)
	MOV	#2,AC
	BR	LOUT

UPL:	DEC	(SP)		;DEC COUNT
	MOV	#12,-(SP)
	MOV	#1,AC
LOUT:	JSR	PC,SEND		;SEND IT OUT
	BR	SCUR

NOL:	TST	(SP)+		;RID COUNTER

FLOP:	JSR	PC,GETARG	;GET NEXT VALUE
	BR	DUNLAB
	MOV	#10,-(SP)	;PUSH DOWN AND LEFT
	MOV	#12,-(SP)
	MOV	AC,-(SP)	;SET TO SEND CHARACTER FIRST
	CMP	(SP),#40	;MAKE VALUE TRANSITION
	BGE	INR
	ADD	#100,(SP)
INR:	MOV	#3,AC
	JSR	PC,SEND
	BR	FLOP		;AND LOOP



	.SBTTL		GRAPHICS ON/OFF AND FALP ROUTINES

;FUNCTION FGRA
;FORMAT FGRA(ON/OFF)
;FGRA(ON/OFF) TURNS GRAPHICS ON (1) OR OFF(0)

FGRA:	MOV	#GON+1,-(SP)	;SET TO TURN GRAPHICS OFF
	FPMP
	.WORD	FINT
	TST	AC		;THEN IF ON REQUESTED,
	BEQ	GRENT
	DEC	(SP)		;SET ON COMMAND
	BR	GRENT		;GO SEND ALTMODE TOO


FALP:;FUNCTION FALP
;FORMAT FALP(N)
;FALP SENDS OUT AN ESCAPE FOLLOWED BY ITS ARGUMENT
	FPMP
	.WORD	FINT
	MOV	AC,-(SP)
GRENT:	MOV	#33,-(SP)
	MOV	#2,AC
	JSR	PC,SEND
DUNLAB:	RTS	PC


	.SBTTL		GETARG ROUTINE

;GETARG GETS THE NEXT ARGUMENT AND RETURNS TO CALL +4.
;ON LAST ARG IT RETURNS TO CALL+2. 

GETARG:	SORTC
	RTPAR			;TEST FOR ANOTHER ARG
	LARG			;LAST ARG
	EVAL.X			;ELSE, GET ARG
	FPMP
	.WORD	FINT
	ADD	#2,(SP)		;AND RETURN TO CALL+2
LARG:	RTS	PC



	.ENDC
	.IF	DF,CRT!SAM!TIC

	.SBTTL	REGISTER AND VECTOR ADDRESSES

	.IF	NDF,$PAPER
	.GLOBL	ADSR		;GLOBALLED FOR LISTING
	.ENDC

	.IF	DF,$PAPER
	FS=FS+40		;ALLOW ROOM FOR ADDRESSES
	.=FTOP-FS
	.ENDC

ADSR:	.WORD	ADSTA		;ADDRESS OF A/D STATUS
ADHI:	.WORD	ADSTA+1		;A/D STATUS HI BYTE
ADBUFF:	.WORD	ADBUF		;A/D BUFFER ADDRESS
CKSR:	.WORD	CKSTA		;ADDRESS OF CLOCK STATUS
CKBUFF:	.WORD	CKBUF		;ADDRESS OF CLOCK BUFFER
DSR:	.WORD	DSTA		;DISPLAY STATUS
X:	.WORD	XC		;X COORDINATE
Y:	.WORD	YC		;Y COORDINATE
DMAREG:	.WORD	DMAADR		;DMA REGISTER

ADVEC:	.WORD	ADV		;A/D VECTOR
ADPR:	.WORD	ADP
CKVEC:	.WORD	CKV		;CLOCK VECTOR
CKPR:	.WORD	CKP	

	.ENDC

	.IF	DF,$PAPER
	FS=FS+2
	.=FTOP-FS
	.ENDC

RTPAR:	.BYTE	211,0		;RIGHT PARENTHESIS LIST

	.IF	DF,$PAPER
	.SBTTL	SET TOP OF CORE
	.IF	DF,CRT!SAM!BUF
	FS=FS+174		;ADD SIZE OF BUFALC
	.ENDC
	FSTRT=FTOP-FS		;START ADDRESS OF FUNCTIONS=
				;CORE SIZE LESS STACK, LOADER,
				;FUNCTION SIZE

	.=BOTTOM
	.WORD	FSTRT		;INSERT THIS IN BOTTOM


	.IF	DF,CRT!SAM!BUF
	.SBTTL	PAPER TAPE BUFFER ALLOKATION ROUTINE

	.=FSTRT			;THIS ROUTINE AT BASE OF FUNCTION AREA

BUFALC:	MOV	AC,-(SP)	;SAVE AC
	ERASEV
	MOV	(SP)+,AC	;RESTORE AC
	ASL	TEMP		;GET ID OFFSET
	ASL	TEMP
	SUB	#6,TEMP		;-2(ID 1) OR 2(ID 2)
	CMP	B0(TEMP),BOTTOM	;IF THIS BUFFER'S BOTTOM AT BOTTM,
	BNE	ATBOT
	MOV	T0(TEMP),BOTTOM ;SET BOTTOM TO ITS TOP, ELIMINATING IT
ATBOT:	MOV	#FSTRT,B0(TEMP)	;THEN SET THIS BUFFERTO CURRENT TOP
	MOV	#FSTRT,T0(TEMP)
	ASL	AC		;MAKE WORD COUNT A BYTE COUNT
	BNE	NOTZER
ADBAK:	MOV	B0(TEMP),AC	;RETURN BASE OF THIS BUFFER
	RTS	PC

NOTZER:	MOV	#FSTRT,R2	;ON ALLOKATION, GET ABSOLUTE TOP
	SUB	AC,R2		;LESS REQUESTED SIZE
	NEG	TEMP		;POINT TO OTHER BUFFER
	CMP	R2,T0(TEMP)	;IF ITS BOTTOM ABOVE REQUESTED BOTTOM
	BLT	BELOW
	NEG	TEMP		;POINT BACK TO REQUESTER
	MOV	#FSTRT,T0(TEMP)	;SET ITS TOP TO ABSOLUTE TOP
SETBOT:	MOV	R2,B0(TEMP)	;SET ITS BOTTOME TO REQUESTED BOTTOM
	BR	ADBAK		;AND RETURN BASE

BELOW:	MOV	B0(TEMP),R2	;ELSE, GET OTHER BASE
	NEG	TEMP		;POINT BACK TO THIS
	MOV	R2,T0(TEMP)	;MAKE ITS TOP BASE OF TOHER
	SUB	AC,R2		;SUBTRACT SIZE FROM THIS
	CMP	R2,BOTTOM-2	;MAKE SURE NEW BOTTOM NOT INTO TEXT
	BLE	ERR
	CMP	R2,BOTTOM-4	;OR DIRECT COMMAND
	BLE	ERR
	MOV	R2,BOTTOM	;IF NOT, SET NEW BOTTOM FOR FOCAL
	BR	SETBOT		;AND MAKE THIS BUFFER PERMANENT
ERR:	CLR	AC		;IF ERROR, SET ERROR
	BR	ATBOT		;AND GO DELTE BUFFER

B1:	FSTRT
B0:T1:	FSTRT
T0:B2:	FSTRT
T2:	FSTRT
	.ENDC			;END OF BUFALC
	.ENDC			;END OF PAPER TAPE CONDITIONAL


	.END