/OVRLAY---ASSORTED BASIC EXTENSIONS
/
/
/
/
/
/
/WRITTEN BY: BENSON MARGULIES
/AT:         THE HAVERFORD SCHOOL
/            HAVERFORD, PA 19041
/
/            MR. SAMUEL M.V. TATNALL, DIRECTOR OF COMPUTING
/
/
/
/
/
/
/3/30/77
/
/
/
/
/
/THE INFORMATION IN THIS PROGRAM IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY THE HAVERFORD 
/SCHOOL. THE HAVERFORD SCHOOL ASSUMES NO RESPONSIBILITY FOR ANY ERRORS
/THAT MAY APPEAR IN THIS PROGRAM. HOWEVER, IF YOU CAN CATCH BENSON MARGULIES,
/ANYTHING YOU DO IS BETWEEN YOU AND HIM.
/REVISION INFORMATION
/
/
/VERSION 2 CHANGES
/1. FUNCTION KYI$ WAS ADDED TO KEYIN A STRING
/2. KYI$ AND KYN WERE MODIFIED TO SHARE CODE
/3. CKY WAS ELIMINATED TO FREE AN ENTRY POINT. A KYI$ OR KYN CALL WILL SERVE
/THE SAME PURPOSE.
/4. THE GTL$ FUNCTION WAS ADDED TO RETURN AN ENTIRE LINE AS A STRING
/FROM THE EXTRA TTY.
/5. THE TIM$ FUNCTION WAS ADDED TO ACCESS A REAL TIME CALENDAR CLOCK.
/6. THE FUNCTIONS WERE REARRANGED TO MAKE MORE EFFICIENT USE OF
/THE SPACE AVAILABLE.
/7. THE CRT ROUTINE WAS ADDED TO PROVIDE DIRECT CURSOR ADDRESSING ON
/THE VT-50.
/VERSION 3 CHANGES:
/1. TMO WAS ADDED.
/2. GETL$ FIXED.
/3. VER ALSO ACTIVATES RELAY.
/4. FIX REPLACED TNP.

/SYMBOL DEFINITIONS
/CURRENT VERSION NUMBER
OVRVER=3
/IOT'S FOR EXTRA TTY
/THEY ARE CONSTRUCTED BY TAKING THE DEVICE CODE,
/MULTIPLYING IT BY 10(8),
/AND ADDING IT TO THE IOT CODE.
INDVC=	5		/INPUT DEVICE
OUTDVC=	66		/OUTPUT DEVICE
PTFL=	10^OUTDVC+6000	/RAISE THE EXTRA TTY OUTPUT FLAG
PCLF=	10^OUTDVC+6002	/CLEAR THE EXTRA TTY OUTPUT FLAG
PTLS=	10^OUTDVC+6006	/PRINT CHAR IN AC ON EXTRA TTY&RAISE FLAG
PTSF=	10^OUTDVC+6001	/SKIP ON EXTRA TTY OUTPUT FLAG
PKSF=	10^INDVC+6001	/SKIP ON EXTRA TTY INPUT FLAG
PKCC=	10^INDVC+6002	/CLEAR EXTRA TTY INPUT FLAG
PKRB=	10^INDVC+6006	/READ CHAR. FROM EXTRA TTY
PKRS=	10^INDVC+6004	/READ STATIC
PKIE=	10^INDVC+6005	/ENABLE/DISABLE INTERRUPTS
PSPI=	10^OUTDVC+6005	/SKIP ON INT ENABLE AND IN/OUT FLAG
INTR=	6726		/ENABLE/DISABLE FLOPPY INTERRUPTS
SPI=	6045		/SKIP ON INT ENABLE AND IN/OUT FLAG
CLSK=	6137		/SKIP ON CLOCK FLAG
CLCL=	6136		/CLEAR CLOCK FLAG
CLLE=	6135		/START\STOP THE CLOCK
CKBY=	6172		/SKIP ON CALENDER CLOCK READY
CKRM=	6173		/READ SECS-MINS
CKRH=	6174		/READ HRS, AM/PM
CKRD=	6175		/READ DATE WORD
CKIN=	6167		/ENABLE/DISABLE CALENDER CLOCK INTERRUPT
CSKI=	6177		/SKIP ON CALENDER CLOCK INTERRUPT
DATWD=	7666		/FIELD 1 LOCATION OF SYSTEM DATE WORD
/A TO D CONVERTER IOT'S
DBST=	6570		/SKIP ON DATA ACCEPTED, CLEAR DATA ACCEPTED AND DATA
			/AVAILABLE
DBSK=	6571		/SKIP ON DATA READY(IN)
DBRD=	6572		/READ DATA INTO AC
DBCF=	6573		/CLEAR DATA READY, ISSUE DATA ACCEPTED PULSE
DBTD=	6574		/LOAD AC INTO BUFFER AND SET DATA(OUT) AVAILABLE
DBSE=	6575		/SET INTERRUPT ENABLE
DBCE=	6576		/CLEAR INTERRUPT ENABLE
DBSS=	6577		/ISSUE STROBE PULSE
ZAP=	6017		/ACTIVATE THE OUTPUT RELAY
ACL=	CLA MQA		/THIS ISN'T IN THE SYMBOL TABLE
FIXTAB			/MAKE THIS INVISIBLE
/BRTS	LOCATIONS	FOR BASIC VERSION 3.21
/FAC LOCATIONS
EXP=	44		/EXPONENT
HORD=	45		/HIGH ORDER WORD
LORD=	46		/LOW ORDER WORD
AC1=	41		/FPP OVERFLOW
/OTHER LOCATIONS
TEMP3=	42		/TEMP LOCATION ON PAGE 0 USED IN MPY
MPYLNK=	121		/LINK TO 12X12 BIT INTEGER MULTIPLY
RSEED=	2346		/RANDOM # SEED
K0077=	75		/CONTAINS 77(8)
VECTOR=	0		/INTERRUPT VECTOR
FSTOP1=	161		/LINK TO BRTS ^C HOOK
INTL=	114		/GETS FIRST ARGUMENT TO USER FUNCTION
SAC=	321		/START OF STRING AC
SACPTR=	111		/POINTER TO SAC
STRLEN=	32		/LENGTH OF STRING IN SAC
ARGPRE=	307		/GETS POINTER TO BASIC ARGUMENT
FNORL=	136		/FLOATING NORMALIZE
BSWL=	144		/LINK TO BYTE SWAPPER
FF=	37		/FLOATING MODE SWITCH
FGETL=	134		/FLOATING GET
FPUTL=	135		/FLOATING PUT
FFSUB=	6117		/FLOATING SUBTRACT
IA=	1465		/MAKE "IA" MESSAGE AND STOP EXECUTION
INSAV=	64		/SWITCH TO TELL BRTS WHICH ARG. TO GET
POINTR=	10		/AUTO INDEX LOCATION
OVRLAY=	1530		/LOCATION OF OVERLAY FLAG
LDH=	131		/RETURNS ONE HALFWORD AT A TIME IN AC
LDHRST=	157		/SETS DATA FIELD OF LDH TO 0
LDHINL=	127		/SET'S UP LDH 
FFADD=	6000		/FLOATING ADD
FFMPY=	5600		/FLOATING MULTIPLY
FFSUB=	6117		/FLOATING SUBTRACT
RSEED=	2346		/RANDOM NUMBER SEED
XR0=	10		/AUTOINDEX REGISTERS
XR1=	11
XR2=	12
STH=	130		/LOADS ONE HALFWORD AT A TIME
STHRST=	160		/SETS DATA FIELD OF STH TO 0
STHINL=	126		/SETS UP STH
MODESW=	63		/1 => STRING MODE, 0=> ARITH.
P1SWAP=	156		/SWAP MONITOR INTO/OUT OF WORKING POSITION
XPUT=	122		/PUT A 7 BIT CHAR. IN THE BRTS RING BUFFER
RIGHT=	103		/ESC C=MOVE CURSOR TO RIGHT
HOME=	110		/ESC H=HOME
DOWN=	12		/LINE FEED
ESCAPE=	33		/ESCAPE
ILOOPL=	113		/LINK TO BRTS PROCESSOR
/WHEN A FUNCTION RETURNS TO BRTS THE NEXT INSTRUCTION IS ALWAYS JMP I ILOOPL.
/ALL OF DEC'S OVERLAYS DO THAT INSTEAD OF JMP I ENTRY. I DO LIKEWISE.
/THE FOLLOWING SECTION PROVIDES AN EASY WAY TO LOAD THE
/ENTRY POINTS INTO BRTS.  TO USE IT DO AS FOLLOWS:
/.COM OVRLAY<OVRLAY
/.R ABSLDR
/*SYS:BRTS.SV/I
/*OVRLAY$
/.SA SYS BRTS 0-6777
/.SA SYS BASIC.UF 3400-4577
/ THE ORDER OF THE ROUTINES IN CORE IS UNIMPORTANT, HOWEVER THE ORDER
/OF THE UDEF STATEMENT MUST MATCH THE ORDER OF THE ENTRY POINTS HERE.
/***************    WARNING:    ****************
/DO NOT LOAD BRTS AND BASIC.UF UNDER BATCH. THE RESULTS ARE WILDLY
/UNPREDICTABLE!!
*1560		/LOAD ENTRY POINTS IN BRTS
KYI
KYN
LNT
LCH
FIX
GTL
RAN
SET
STK
REC
CLK
ADC
TIM
CRT
TMO
VER
/THIS PROCEDURE PLACES THE USER FUNCTIONS INTO THE BRTS CORE IMAGE
/WHERE THE ARITHMETIC FUNCTIONS USUALLY RESIDE. SINCE
/BRTS MAINTAINS A FLAG AT LOCATION OVRLAY THAT TELLS IT WHICH OVERLAY
/IS IN CORE AT ANY TIME, BRTS WILL ATTEMPT TO ACCESS THOSE ROUTINES
/WITHOUT READING IN BASIC.AF.  THIS, OF COURSE, WOULD BE DISASTEROUS,
/SO THE FOLLOWING PATCHES BRTS TO EXPECT BASIC.UF TO BE INITIALLY IN CORE.
*OVRLAY
	3		/THREE INDICATES USER FUNCTION
*3400		/THIS IS THE BEGINING OF THE BRTS USER OVERLAY SPACE.
/THESE SUBROUTINES ARE CODED FOR A SYSTEM WITH AN EXTRA TTY CONNECTED
/TO A KL8J INTERFACE OR ANYTHING ELSE WITH EQUIVALENT IOT'S.
/TO USE THESE YOU MUST USE A UDEF STATEMENT LIKE THIS:
/0 UDEF KYI$(U),KYN(U),LNT(C),LCH(C$,E),FIX(V),GTL$(D),RAN(V),SET(L)
/1 UDEF STK(V),REC(D),CLK(T),ADC(N,R),TIM$(D),CRT(X,Y),TMO(T),VER(D)
/FUNCTIONS OF THE FORM QQQ$ RETURN STRINGS.
/ U=	UNIT		[0 FOR CONSOLE; 1 FOR EXTRA TTY]
/ C=	CHARACTER	[ASCII CODE(7 BITS)]
/ C$=	CHR. STRING	[BASIC STRING]
/ E=	RETURN		[0 FOR NO <CR><LF>; 1 FOR A <CR><LF>]
/ D=	DUMMY		[IGNORED]
/ L=	LOCATION	[LOCATION IN COMMON STORAGE PUSHDOWN LIST]
/ V=	VALUE		[BASIC NUMBER]
/ T=	TICKS		[NUMBER OF CLOCK TICKS]
/ N=	CHANNEL		[A TO D CHANNEL]
/ R=	RANGE		[RANGE MODE FOR A TO D]
/ X=	X		[X COORDINATE]
/ Y=	Y		[Y COORDINATE]
/
/
/	THESE ROUTINES ARE CODED ACCORDING TO SEVERAL GUIDLINES.
/ 1.	SINCE BASIC IS SO SLOW ANYWAY SPACE IS A HIGHER PRIORITY THAN SPEED,
/	WITHIN REASON.
/ 2.	SINCE BASIC, UNLIKE FORTRAN, REQUIRES ALL ARGUEMENTS TO BE EXPLICIT,
/	THE NUMBER OF ARGUEMENTS TO ANY ROUTINE SHOULD BE MINIMIZED. THAT IS,
/	THE USE OF ONE ENTRY WITH MULTIPLE FUNCTIONS SELECTED BY AN EXTRA ARG.
/	IS DISCOURAGED.  AS THE 16 ENTRY POINTS FILL UP, HOWEVER, THE USE OF A
/	"FUNCTION" ARG. MAY BECOME UNAVOIDABLE.
/&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
/ $ $ $ $ $ $ $ HERE GO THE FUNCTIONS!!!!!
/******************** KEYIN A CHARACTER WITHOUT WAITING FOR A <CR>
FLAG,			/REUSE THE ENTRY
KYI,	0
/THIS SUBROUTINE CHECKS FOR A CHARACTER IN THE BUFFER AND
/RETURNS IT. IF NO CHARACTER IS PRESENT IT RETURNS A NULL STRING(LENGTH 0).
/CALL WITH:
/10 Q$=KYI$(X)
/WHERE X IS ZERO IF YOU WANT TO READ FROM THE CONSOLE,
/OR ONE IF YOU WANT TO READ FROM THE EXTRA TTY.
	CLA IAC		/GET A 1
	DCA	MODESW	/AND SET TO STRING MODE
	SKP		/SKIP THE ENTRY POINT FOR KYN
/******************** KEYIN A CHARACTER CODE *************
MASK,
KYN,	0		/NUMERIC RETURN ENTRY
/THIS "FUNCTION" RETURNS THE FULL 7 BIT NUMERIC VALUE OF THE
/KEY'D IN CHAR. CALL WITH:
/10 C=KYN(W)\REMEMBER THAT W =0 FOR THE CTY AND 1 FOR THE EXTRA TTY
	TAD	HORD	/BASIC PUTS FIRST ARG. IN FAC
	SZA CLA		/CHECK IF ITS ZERO
	TAD	(INDVC^10-30	/DIFFERENCE BETWEEN INDVC & CONSOLE IOT CODE
	TAD	(30	/IF ARG. WAS ZERO WE GET CONSOLE, ELSE WE GET EXTRA TTY
	TAD	(6001	/MAKE KSF TYPE INSTRUCTION
	DCA	SKIPIT	/PUT IT INTO RIGHT SPOT
	DCA	FLAG	/FLAG INDICATES WHETHER A CHAR. WAS READ
	TAD	SKIPIT	/GET IT BACK SO WE CAN MAKE KRB TYPE INSTRUCTION
	TAD	(5	/6XX6=6XX1+5...SO WE ADD FIVE
	DCA	READIT	/PUT IT AWAY
SKIPIT,	.		/KSF TYPE INSTRUCTION GOES HERE
	JMP	NOCHAR	/IF THERE ISN'T A CHAR DON'T BOTHER TO READ IT
	ISZ	FLAG	/SET FLAG TO INDICATE THAT WE READ A CHAR
READIT,	.		/KRB TYPE INSTRUCTION GOES HERE
NOCHAR,	AND	(177	/CHOP TO 7 BITS
	MQL		/SAVE THE CHAR IN MQ
	MQA		/AND RESTORE IT
	JMS	FFLOT	/PUT IT IN FAC IN CASE WE CAME FROM KYN
	MQA		/RESTORE THE CHARACTER
	JMS I	BSWL	/SWAP BYTES TO PUT CHAR INTO HIGH BYTE
	DCA I	(SAC	/AND PUT IT IN SAC
	TAD	KYI	/GET THE FLAG
	CIA		/STRLEN IS -#
	DCA	STRLEN	/TELL BASIC WHETHER WE READ
	JMP I	ILOOPL	/AND RETURN

/*************** GET A RANDOM INTEGER *******************
/THIS FUNCTION RETURNS A RANDOM INTEGER
/CALL WITH:
/10 N=RAN(B)\REMEMBER
RAN,	0		/REAL RANDOM NUMBER GENERATOR
	DCA	FF	/USE MODE 1
	TAD I	(RSEED	/GET RANDOM SEED
	DCA	TEMP3	/PUT IN AS MULTIPLICAND
	TAD	K0077
	JMS I	MPYLNK	/MULTIPLY
	DCA I	(RSEED	/NEW RANDOM
	TAD I	(RSEED	/RESTORE
	CLL RAR
	DCA	XR1	/ITS AUTO-INDEX BUT I DON'T DO INDIRECT
	DCA	XR0	/SO USE THE FIRST 3 FOR FLOATING TEMP
	RAR		/GET BACK LAST BIT
	DCA	XR2	/USE ALL 12
	JMS I	(FFADD	/ADD ONE
	FONE
	JMS I	(FFMPY	/AND MULTIPLY BY RANDOM #
	XR0
	JMS I	INTL	/FIX IT
	JMS	FFLOT	/THEN FLOAT THE INTEGER
	JMP I	ILOOPL	/DONE

/*************** SET THE COMMON STORAGE POINTER *****************
COUNT,
SET,	0
/THE COMMON STORAGE SYSTEM MANAGES A PUSHDOWN STACK IN FIELD COMFLD.
/COMFLD SHOULD BE SET TO THE HIGHEST FIELD IN YOUR SYSTEM.
	COMFLD=30
/OS/8 MUST BE RESTRICTED TO THE REMAINING CORE WITH THE .CORE X
/MONITOR COMMAND. THE SET(N) CALL SETS THE STACK POINTER TO
/STORE THE NEXT BASIC FLOATING POINT WORD IN STACK LOCATION N, WHERE N CAN
/RANGE FROM ZERO TO 1364(10). SET IS USUALLY USED TO INITIALIZE A 
/STACK, I.E. 10 Q=SET(0), BUT IT CAN ALSO BE USED TO MANAGE COMMON STORAGE
/ON A RANDOM ACCESS BASIS.
	JMS I	INTL	/GET THE ARG
	DCA	RECPNT	/STASH IT
	TAD	RECPNT	/AND GET IT BACK
	RAL		/ARG*2
	SZL		/OVER 7777(8)?
	JMP I	(IA	/YES; CRASH
	TAD	RECPNT	/ARG*2+ARG=ARG*3
	SZL		/OVER 7777(8)?
	JMP I	(IA	/YES
	CDF	COMFLD	/SET DATA FIELD
	DCA I	(0	/AND STORE POINTER
	CDF
	JMP I	ILOOPL	/THEN RETURN

/ % % % % % % % % % % % % % % % % % % % % % % %
/		# STK #
/ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @
/*************** PUSH A NUMBER ONTO THE COMMON STACK ****************
RECPNT,
STK,	0
/CALL WITH:
/10 Q=STK(N)\REMEMBER THAT N IS THE NUMBER TO BE STORED. AN ATTEMPT
/TO PUSH TOO MUCH DATA ONTO THE STACK WILL RESULT IN AN "IA" ERROR.
	CDF	COMFLD	/SET FIELD TO COMMON STORAGE
	CLA CLL
	TAD I	(0	/GET POINTER
	TAD	(3	/CHECK TO MAKE SURE WE DON'T GO OVER TOP
	SZL CLA		/WELL?
	JMP I	(IA	/WITHIN 3 WORDS OF TOP EQUALS TOO MUCH STUFF
	TAD I	(0	/GET THE POINTER
	DCA	POINTR	/PUT IN AUTOINDEX
	TAD	EXP	/GET EXPONENT
	DCA I	POINTR	/AND STORE
	TAD	HORD	/GET HIGH ORDER WORD
	DCA I	POINTR	/AND STORE
	TAD	LORD	/AND LOW ORDER
	DCA I	POINTR	/AND STASH
	TAD	POINTR	/GET POINTER
	DCA I	(0	/AND STASH
	CDF
	JMP I	ILOOPL	/RETURN

/$ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $
/		# REC #
/& & & & & & & & & & & & & & & & & & & &
/*************** POP A NUMBER OFF THE COMMON STORAGE STACK ***************
REC,	0		/THIS ROUTINE POPS DATA OFF OF THE STACK.
/AN ATTEMPT TO RECALL BELOW THE BOTTOM OF THE STACK WILL RESULT IN A AN
/"IA" MESSAGE. CALL WITH:
/N=REC(0)\REMEMBER THAT THE ARGUMENT IS IRRELEVANT
	CDF	COMFLD	/SET FIELD TO COMMON STORAGE
	CLA CLL
	TAD I	(0	/GET POINTER
	SNA		/MAKE SURE WE AREN'T AT THE BOTTOM 
	JMP I	(IA	/YES WE ARE; GENERATE "IA" AND CRASH
	DCA	RECPNT	/PUT IT IN POINTER
			/(NOT AUTOINCREMENT BECAUSE WE HAVE TO DECREMENT)
	TAD I	RECPNT	/GET LOW ORDER WORD
	DCA	LORD
	JMS	DEC	/DECREMENT RECPNT
	TAD I	RECPNT	/GET HIGH ORDER MANTISSA
	DCA	HORD
	JMS	DEC	/DECREMENT POINTER
	TAD I	RECPNT	/GET EXPONENT
	DCA	EXP
	JMS	DEC	/DEC. AGAIN BECAUSE THE AUTO-INCREMENT INCREMENTS FIRST
	TAD	RECPNT	/GET POINTER
	DCA I	(0
	CDF
	JMP I	ILOOPL	/AND RETURN
DEC,	0		/THIS ROUTINE DECREMENTS LOCATION RECPNT
	STA		/START WITH A -1
	TAD	RECPNT
	DCA	RECPNT
	JMP I	DEC
FFLOT,	0		/ROUTINE TO FLOAT A 12 BIT FIXED POINT INTEGER
	DCA	HORD	/PUT NUMBER IN FAC
	DCA	LORD	/CLEAR LOW ORDER WORD
	TAD	(13	/DECIMAL POINT IS 13(8) BITS OVER
	DCA	EXP	/SO THATS THE EXPONENT
	JMS I	FNORL	/NORMALIZE IT
	JMP I	FFLOT	/AND RETURN
PAGE
/<>	<>	<>	<>	<>	<>	<>	<>	<>	<>
/			LNT FUNCTION
/<>	<>	<>	<>	<>	<>	<>	<>	<>	<>
/****************** PRINT A 7 BIT CHARACTER ON THE EXTRA TTY **************
CHECK,			/RECYCLE THAT EMPTY ENTRY POINT!
LNT,	0		/THIS FUNCTION IS IDENTICAL TO THE PNT
/FUNCTION IN BASIC EXCEPT THAT IT PRINTS THE CHARACTER ON THE EXTRA TTY.
/CALL WITH:
/10 Q=LNT(A)\REM WHERE A CONTAINS THE ASCII CODE OF THE DESIRED CHAR.
	JMS I	INTL	/GET THE CHARACTER
	JMS 	LPUT	/PRINT THE CHAR
	JMP I	ILOOPL	/AND RETURN

/<> <> <> <> <> <> <> <> <> <> <> <> <> 
/		# LCH #
/>< >< >< >< >< >< >< >< >< >< >< >< ><
/****************** PRINT A BASIC STRING ON THE EXTRA TTY ****************
COUNTR,			/RECYCLE THE ENTRY
LCH,	0		/THIS FUNCTION ACCEPTS A STRING ARGUMENT AND PRINTS IT
/ON THE EXTRA TTY.  THE CALL IS AS FOLLOWS:
/10 Q=LCH(A$,A)\REM IF A<>0 THEN <CR><LF> IS PRINTED; ZERO GIVES NO <CR><LF>
/IS OUTPUT AFTER THE STRING
	JMS	LPUT	/RAISE EXTRA TTY FLAG
	TAD	STRLEN	/-THE LENGTH
	SNA 		/IF ZERO CKECK FOR <CR><LF> REQUEST AND LEAVE
	JMP	CRLF	/IT WAS ZERO
	DCA	COUNTR	/PUT THE NEGATIVE LENGTH IN A COUNTER
	TAD	(SAC	/GET A POINTER TO THE SAC
	CLL		/CLEAR LINK => LDH WILL GET LEFT HALF
	JMS I	LDHINL	/TELL LDH TO FETCH SAC ONE BYTE AT A TIME
	JMS I	LDHRST	/SET LDH TO FETCH FROM FIELD ZERO
LOOP,	JMS I	LDH	/GET A BYTE
	JMS	SIXTO7	/EXPAND TO 7 BITS
	JMS	LPUT	/PRINT
	ISZ	COUNTR	/DONE THEM ALL?
	JMP	LOOP	/NO
CRLF,	JMS I	INTL	/GET THE ARG
	SNA CLA 	/IS IT NONZERO?
	JMP I	ILOOPL	/THIS IS WHAT BRTS DOES ANYWAY SO I DO IT NOW
	TAD	(15	/<CR>
	JMS	LPUT	/PRINT IT
	TAD	(12	/<LF>
	JMS	LPUT
	JMP I	ILOOPL	/THIS IS WHAT BRTS DOES ANYWAY SO I DO IT NOW
/######	LPUT	######
LPUT,	0		/THIS  SUBROUTINE PRINTS A CHARACTER ON THE EXTRA TTY
	AND	(177	/MAKE IT SEVEN BITS
	PTLS		/PRINT THE CHARACTER
	PTSF		/IS THE FLAG UP?
	JMP	.-1	/NO; GO AROUND AGAIN
C7600,	7600		/CLA AND A LINK TO THE MONITOR
	JMP I	LPUT	/AND RETURN
/######	SIXTO7	######
SIXTO7,	0		/THIS ROUTINE EXPANDS SIX BIT DATA TO 7 BITS
	DCA	CHECK
	TAD	CHECK
	TAD	(-40	/IS THE CHARACTER GREATER THAN 40?
	SPA CLA 
	TAD	(100	/IF < THAN 40 ADD 100; ELSE 6 BITS = 7 BITS
	TAD	CHECK	/ADD IN THE CHARACTER
	JMP I	SIXTO7	/THEN RETURN

/************************ FIX ***********************************
/FIX(A) CONVERTS A NUMBER A, IN THE RANGE OF 0 TO 4095 INTO AN INTEGER.
/EXAMPLE:
/10 X=FIX(A)
/
EXTRA,			/RECYCLE THE ENTRY POINT
FIX,	0
	JMS I	INTL	/FIX IT
	JMS  I	(FFLOT	/NORMALIZE IT
	JMP I	ILOOPL	/AND RETURN
/	$	$	$	$	$	$	$	$
/			GTL$ FUNCTION
/	$	$	$	$	$	$	$	$
/*************** GET A LINE FROM THE EXTRA TTY *******************
/THIS FUNCTION FETCHES AN ENTIRE LINE FROM THE EXTRA TTY.
/IT ECHOS AS YOU TYPE, AND RESPONDS TO CTRL/U BY CANCELING THE LINE,
/PRINTING A <CR><LF>, AND LISTENING FOR A NEW LINE.
/TYPING MORE THAN 72 CHARACTERS(NOT INCLUDING <CR>)HAS THE SAME EFFECT.
/A CTRL/C WILL RETURN YOU TO THE BASIC EDITOR.
/CALL WITH:
/L$=GTL$(0)\REMEMBER THAT THE STRING MUST BE DIM'ED TO SUFFICIENT LENGTH
	DECIMAL		/WE NEED A CONSTANT OR 2 IN DECIMAL
	N73=	-73
	P73=	73
	OCTAL		/BUT DONT MUNG UP THE RADIX
GTL,	0
	JMS	LPUT	/START UP ECHO
GST,	CLA CLL		/CLEAR AC JUSTINCASE AND LINK FOR STH LEFT
	JMS I	STHRST	/SET STH TO FIELD ZERO
	TAD	(SAC	/SIDE STORE OF FIRST HALFWORD
	JMS I	STHINL	/AND SET STH TO HALF WORD STORE IN SAC
	TAD	(N73	/MAX OF 72 CHARACTERS PLUS <CR>
	DCA	STRLEN	/USE THIS TO PREVENT LINE OVERFLOW
GTCHR,	PKSF		/WAIT FOR A CHARACTER
	JMP	.-1	/LOOP FOR IT
	PKRB
	AND	(177	/CHOP TO 7BITS
	MQL
	MQA		/SAVE & RESTORE
	JMS	LPUT	/AND ECHO
	ACL		/RESTORE AGAIN
	TAD	(-3	/IS IT A CONTROL C?
	SNA CLA		/WELL?
	JMP I	FSTOP1	/ABORT THRU NORMAL CHANNELS
	ACL		/ONCE AGAIN
	TAD	(-25	/CNT/U?
	SNA CLA		/WELL?
	JMP	CNTU	/YUP
	ACL		/AND AGAIN
	TAD	(-15	/CR?
	SNA CLA		/??????
	JMP	CR	/SO GO
	ACL		/AND AGAIN
	AND	K0077	/SIXBITS
	JMS I	STH	/PUT IT IN SAC
	ISZ	STRLEN	/INC THE COUNTER
	JMP	GTCHR	/AND GO FOR ANOTHER
	JMP	CNTU	/IF IT REACHED ZERO WE GOT TOO MANY CHARACTERS
CR,	TAD	STRLEN	/-73+#=#-73
	TAD	(P73	/#-73+73=#
	CIA		/STRLEN STORES A NEGATIVE LENGTH
	DCA	STRLEN
	IAC		/NEED A ONE
	DCA	MODESW	/IN MODESW TO REMAIN A STRING.
	JMP	CRLF+3	/BORROW <CR><LF> AT END OF LCH
CNTU,	TAD	(15	/CR
	JMS	LPUT
	TAD	(12	/LF
	JMS	LPUT
	JMP	GST	/TRY FOR ANOTHER STRING
/******************* COUNT CLOCK TICKS TO DELAY
STASH,		/BY USING ILOOPL WE GET THE ENTRY AS STORAGE
CLK,	0		/THIS ROUTINE WAITS FOR THE REQUIRED NUMBER OF CLOCK TICKS
/AND THEN RETURNS.  CALL WITH:
/10 Q=CLK(H)\REM H IS THE NUMBER OF TICKS
/A CALL TO A USER FUNCTION FORCES BASIC TO DUMP THE TERMINAL RING BUFFER
/TO FACILITATE THAT I HAVE ALLOWED A CALL TO CLK WITH AN ARG. OF ZERO.
/THE RESULT OF THIS CALL IS TO DUMP THE BUFFER AND RETURN IMMEDIATELY.
	JMS I	INTL	/GET THE NUMBER OF TCKS
	SNA		/DID HE REQUEST ZERO WAIT?
	JMP I	ILOOPL	/RETURN ON ZERO WAIT
	CIA
	DCA	STASH	/PUT IT IN COUNTER
	CLCL		/CLEAR CLOCK FLAG
LOOPC,	CLSK		/IS THE FLAG UP?
	JMP	.-1	/NO; WAIT SOME MORE
	CLCL		/YES; CLEAR THE FLAG,
	ISZ	STASH	/AND CHECK THE COUNT
	JMP	LOOPC	/NOT ENOUGH YET
	JMP I	ILOOPL	/ENOUGH, RETURN
	PAGE

/		# ADC #
/:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;:;
/****************** DRIVE THE A TO D CONVERTER *****************
CHAN,			/BY USING ILOOPL WE FREE THE ENTRY ENTIRELY
ADC,	0		/THIS ROUTINE READS FROM AN A TO D CONVERTER
/CALL WITH:
/10 D=ADC(C,M)\REMEMBER THAT C IS THE CHANNEL AND M IS THE RANGE MODE
	DBST		/CLEAR OLD CONDITIONS
	NOP		/IT SKIPS BUT WE DON'T CARE BECAUSE WE WON'T READ
			/ THE CONDITIONS OUT FOR A WHILE
	DBCF		/CLEAR DATA(IN) READY FLAG
	JMS I	INTL	/GET THE FIRST ARGUMENT
	AND	(17	/CHANNEL RANGES FROM 0 TO 17(8)
	DCA	CHAN	/PUT IT AWAY
	IAC		/GET ONE IN AC
	DCA	FF	/TELL BRTS TO USE FLOATING POINT MODE TWO(ADDRESS IN AC)
	DCA	INSAV	/WE WANT ARG. 0
			/(FIRST IN LIST OTHER THAN THE ONE IN THE FAC)
	JMS I	(ARGPRE	/ARGPRE WHICH SETS FIELD
			/ AND GETS ADDRESS OF ARG. IN AC
	JMS I	FGETL	/NOW LOAD IT INTO FAC
	.		/THIS LOCATION IS UNUSED IN MODE TWO
	JMS I	INTL	/FIX THE SECOND ARG. INTO FAC
	AND	(3	/MODE CAN RANGE FROM 0 TO 3
	DCA	STOR	/SAVE THE RANGE
	TAD	STOR	/AND GET IT BACK
	CLL;RTL;RTL	/CHANNEL IN BITS 8-11; MODE IN BITS 6-7
	TAD	CHAN	/CONSTRUCT WHOLE WORD
	DBTD		/SEND WORD TO A TO D AND TELL IT TO LOOK AT IT
	DBST		/CLEAR DATA AVAILABLE IF S1-4="NOT ON"
	NOP		/IT WAS A SKIP
	DBSS		/SEND STROBE
	DBSK		/IS THE INCOMING DATA READY?
	JMP	.-1	/NO; GO AROUND AGAIN
	DBRD		/YES; READ IT INTO AC(JAM TRANSFER)
	CMA		/CONVERTER LOGIC IS INVERTED
	DBCF		/TELL IT THAT WE HAVE READ THE DATA
	DCA	DATA	/STORE IT FOR A WHILE
	DCA	FF	/SET THE FPP BACK TO MODE 1
	TAD	STOR	/GET MODE WORD
	RAR		/MOVE EVEN VS. ODD BIT TO LINK
	CLA		/GET RID OF STUFF IN AC
	TAD	DATA	/GET BACK WORD
	SZL		/EVEN OR ODD MODE
	JMP	ODD	/ITS ODD SO DONT COMPLEMENT THE SIGN
	RAL		/MOVE SIGN TO LINK
	CML RAR		/COMPLEMENT AND SHIFT BACK
	JMS I	FFLOTL	/
	JMP	EVEN	/AND SKIP THE WEIRD FLOATER
ODD,	CLL		/THERE'S A ONE IN THE LINK SINCE THE MODE WAS ODD
FLOT12,	RAR		/THE SIGN BIT ISN'T A SIGN BIT!!!
	DCA	HORD	/FIRST 11 BITS GO IN HIGH ORDER
	RAR		/THEN RECOVER THE LSB
	DCA	LORD	/AND PUT IT IN LOW ORDER
	TAD	(14	/GET THE EXPONENT
	DCA	EXP	/AND STORE THAT
	JMS I	FNORL	/NOW NORMALIZE---& WERE DONE
EVEN,	CLA CLL CMA RTL	/GET A -3
	TAD	STOR	/GET THE WORD BACK
	SNA CLA		/MODE THREE, PERHAPS?
	JMP	MODE3	/YES
	TAD	STOR	/MODE ZERO
	SNA CLA		/WELL?
	JMP	MODE0	/YES
	JMS I	(FFMPY	/MODES ONE AND TWO SHARE A CONSTANT
	KP10		/BOTH ARE 10 VOLT SCALES(1=0TO10,2=-5TO+5)
	JMP I	ILOOPL	/RETURN
MODE3,	JMS I	(FFMPY	/MODE3= 0TO5
	KP5
	JMP I	ILOOPL	/RETURN
MODE0,	JMS I	(FFMPY	/MODE ZERO =-10TO+10
	KPM10
	JMP I	ILOOPL
KP10,	7770		/10.24/4096=.0025
	2436
	5605
KP5,	7767		/5.12/4096=.00125
	2436
	5605
KPM10,	7771		/20.48/4096=.005
	2436
	5605
FFLOTL,	FFLOT	/LINK TO FFLOT
/**************** MOVE THE CRT CURSOR TO X,Y
STOR,
CCOUNT,
CRT,	0
	JMS	EOUT	/MAKE AN <ESC>
	TAD	(HOME	/ESC H= HOME
	JMS I	XPUT	/LET BASIC PRINT IT
	TAD	HORD	/CHECK FOR NEGATIVE
	SPA		/WELL?
	JMP	DOWNER	/YES
	JMS I	INTL	/GET X
	SNA		/IF ZERO DON'T BOTHER
	JMP	DOWNER	/TO DO X
	CIA		/NEGATE
	DCA	CCOUNT	/AND DEPOSIT
CCLP,	JMS	EOUT	/ESC C=ONE RIGHT
	TAD	(RIGHT	/A C
	JMS I	XPUT	/PUT IT INTO RING BUFFER
	ISZ	CCOUNT
	JMP	CCLP
DOWNER,	CLA IAC		/ONE IN FF=MODE 2
	DCA	FF
	DCA	INSAV	/WE WANT ARG 0 OF LIST(ITS THE 2ND ARG)
	JMS I	(ARGPRE	/GET THE ADRESS AND SET THE FIELD
	JMS I	FGETL	/GET THE ARG
	.		/UNUSED IN MODE 2
	TAD	HORD	/CHECK AGAIN
	SPA		/WELL
	JMP I	ILOOPL	/YUP--SET TO ZERO
	JMS I	INTL	/FIX Y
	SNA		/IF ZERO
	JMP I	ILOOPL	/WE'RE DONE
	CIA		/NEGATE
	DCA	CCOUNT	/INTO COUNTER
CLP2,	TAD	(DOWN
	JMS I	XPUT	/PRINT A <LF>
	ISZ	CCOUNT
	JMP	CLP2
	JMP I	ILOOPL
DATA,
EOUT,	0		/PRINT AN ESCAPE SEQUENCE
	CLA CLL		/JUSTINCASE
	TAD	(ESCAPE	/ESCAPE
	JMS I	XPUT	/PRINT IT
	JMP I	EOUT
PAGE
/\	/\	/\	/\	/\	/\	/\	/\
/			TIM$ FUNCTION
/\	/\	/\	/\	/\	/\	/\	/\
/****************** RETURN THE TIME ******************
/THIS FUNCTION RETURNS AN 11 CHARACTER STRING WITH THE 
/CURRENT TIME. SINCE THE MAXIMUM UNDIM'ED STRING LENGTH IS 10 BE SURE TO
/DIM THE STRING. CALL WITH:
/10 Q$=TIM$(0)\REMEMBER THE ARG IS IRRELLEVENT----OR
/10 PRINT TIM$(0)\IF YOU JUST WANT TO PRINT IT OUT
TIME,
TIM,	0
	CKRD		/READ DATE WORD
	SNA CLA		/IF NO CLOCK WE WILL GET 0
	JMP	NODATE	/NO CLOCK
	JMS I	P1SWAP	/SWAP MONITOR INTO WORKING POSITION
	JMS	CWAIT	/FIRST DATE WORD COULD BE HASH SO WE WAIT
	CKRD		/AND READ AGAIN
	CDF	10	/DATE WORD IS IN FIELD 1
	DCA I	(DATWD	/PUT DATE WORD AWAY
	CDF		/BACK TO FIELD 0
	JMS I	P1SWAP	/AND RETURN MONITOR TO MOTHBALLS
	JMS I	STHRST	/SET HALFWORD STORE TO FIELD 0
	TAD	(SAC	/GET LOCATION OF SAC
	CLL		/LINK=0 => LEFT HALF FIRST
	JMS I	STHINL	/SET UP STH FOR SAC
	JMS	CWAIT	/WAIT FOR CLOCK TO BE READY
	CKRH		/GET HOURS & AM/PM
	DCA	TIME	/STORE IT TO SAVE AM/PM
	TAD	TIME
	AND	(17	/4 BITS FOR HOURS
	JMS	TYPEN	/AND PRINT IT INTO SAC
	TAD	(72	/THATS A COLON
	JMS I	STH	/PUT IT IN SAC
	JMS	CWAIT	/WAIT FOR READY
	CKRM		/GET MIN. & SECS.
	DCA	ATEMP	/SPARE LOCATION ON THE PAGE
	TAD	ATEMP
	RTR;RTR;RTR	/GET MINS.
	AND	K0077	/6BITS
	JMS	TYPEN	/AND PUT IN SAC
	TAD	(72	/THATS A COLON
	JMS I	STH	/PUT IT IN SAC
	TAD	ATEMP	/GET SECS. BACK
	AND	K0077	/6BITS
	JMS	TYPEN	/WRITE THEM OUT
	TAD	(40	/A SPACE
	JMS I	STH	/<SPACE>AM/PM
	TAD	TIME	/GET BACK AM/PM
	RTR;RTR;RAR	/AM/PM BIT IS IN LINK
	CLA IAC		/1 IS A SIXBIT "A"
	SZL		/0=> AM
	TAD	(17	/20 IS SIXBIT P
	JMS I	STH	/PUT IT AWAY
	TAD	(15	/15 IS SIXBIT M
	JMS I	STH	/SO WE STASH THAT
	TAD	(-13	/OCTAL # OF CHARACTERS
	DCA	STRLEN	/TELL BASIC HOW LONG THE STRING WAS
	CLA IAC		/NEED A ONE
	DCA	MODESW	/IN MODESW TO RETURN A STRING
NODATE,	JMP I	ILOOPL	/AND RETURN
TYPEN,	0		/DECODE OCTAL TO DECIMAL
	DCA	TEMP
	DCA	DIGIT1
	DCA	DIGIT2
TENS,	TAD	TEMP
	SNA		/TEST FOR ZERO
	JMP	OUTN
	TAD	(-12
	SPA
	JMP	ONES
	DCA	TEMP
	ISZ	DIGIT1
	JMP	TENS
ONES,	CLA
	STA		/START WITH -1
	TAD	TEMP
	SPA
	JMP	OUTN
	DCA	TEMP
	ISZ	DIGIT2
	JMP	ONES
OUTN,	CLA
	TAD	DIGIT1
	TAD	(60
	JMS I	STH
	TAD	DIGIT2
	TAD	(60
	JMS I	STH
	JMP I	TYPEN
DIGIT1,	0
DIGIT2,	0
CWAIT,	0		/WAIT FOR CLOCK READY
	CKBY		/CLOCK READY?
	JMP	.-1	/NO
	CLA CLL		/ITS NOT A JAM TRANSFER.....
	JMP I	CWAIT

/<><><><><><><><><><><><> VER <><><><><><><><>><>><><>
/VER(D) RETURNS THE VERSION NUMBER FOR BASIC.UF.
/IT IS ALSO USED TO ACTIVATE A RELAY ON THE CLOCK BOARD.
/THIS RELAY CAN BE USED TO TRIGGER THE MAGNETOMETER, FOR EXAMPLE.
ATEMP,	0
TEMP,
VER,	0
	ZAP		/KLUDGE!!!!!!!!!!
	TAD	(OVRVER
	JMS I	(FFLOT
	JMP I	ILOOPL
PAGE

/[][][][][][][][][][][][][]  TMO  [][][][][][][][][][][][][]
/TMO(A) IS AN ELAPSED TIME COUNTER. THE TIME IS SET AND THE CLOCK STARTED
/BY CALLING WITH A NON-ZERO ARGUMENT REPRESENTING TICKS OF THE REAL-TIME
/CLOCK. TMO OPERATES IN THE BACKGROUND USING INTERRUPTS, THUS THE MAIN
/PROGRAM CAN PROCEED WHILE TMO KEEPS TRACK OF ELAPSED TIME.
/TO TEST TMO FOR COMPLETION OF THE TIME-OUT, CALL IT WITH A "0" ARGUMENT.
/TMO RETURNS A VALUE OF "0" IF STILL TICKING, AND "1" IF TIMED-OUT.
/A NEGATIVE ARGUMENT CANCELS TMO OPERATION, THUS TURNING OFF INTERRUPTS.
/(INTERRUPTS ARE ALSO TURNED OFF FOLLOWING NORMAL COMPLETION OF THE TMO CYCLE.)
/TICKS ARE IN HUNDRETHS OF SECONDS AND LIMITED TO 4095 TICKS (40.95 SECS.).
/
TMO,	0		/TIME OUT FUNCTION
	DCA	FF	/THEY ALL USE MODE 1
	TAD	HORD	/GET MANTISSA
	SPA CLA		/NEGATIVE = KILL TIMEOUT
	JMP	TABORT	/SO GO KILL TIME OUT
	TAD	HORD	/FOR -1, 0 OR POS INTEGER HORD IS SUFFICIENT
	SNA CLA		/NEW TIME OUT OR OLD?
	JMP	OLD	/OLD
	DCA	TFLAG	/CLEAR TMO FLAG
	KIE		/DISABLE KEYBOARD INTERRUPTS
	PKIE		/AND LPT INTERRUPTS
	INTR		/AND DISK INTERRUPTS
	CKIN		/AND CALENDAR CLOCK INTERRUPTS
	DBCE		/AND ADC INTERRUPTS
	JMS I	INTL	/GET COUNT
	CIA		/NEGATE IT
	DCA	TCOUNT	/AND SAVE IT
	TAD	INS	/GET FIRST LOC
	DCA	VTRANS	/AND SET UP JMP I SERVE
	TAD	INS+1	/GET THE SECOND
	DCA	VPOINT	/AND STASH IT
	IAC		/GET A ONE
	CLLE		/TO ENABLE CLOCK INTERRUPT
	DCA	FHOOK	/SET HOOK FLAG
	TAD I	FSTOP2	/SAVE BRTS LOCATION...
	DCA	SHOOK	/WHERE HOOK GOES
	TAD	HOOK	/GET MY HOOK TO THEIR HOOK
	DCA I	FSTOP2	/PLACE IT
	CLCL		/CLEAR FLAG
	ION		/TURN ON INTERRUPT
	JMP I	ILOOPL	/AND RETURN
TABORT,	IOF
	DCA	TFLAG	/KILL FLAG AND SHUT OFF INTERRUPT
	CLLE		/STOP CLOCK INTERRUPT
	JMS	UNHOOK	/REMOVE HOOK
	JMP I	ILOOPL
SERVE,	DCA	SAVAC	/SAVE AC
	GTF		/GET THE FLAGS
	DCA	SAVFL	/AND SAVE THEM
	CLSK		/WAS IT A CLOCK INTERRUPT
	JMP	INTRST	/NO--IGNORE IT AND CLEAR ALL INTERRUPT FLAGS
	CLCL		/KILL FLAG
	ISZ	TCOUNT	/INCREMENT COUNT AND SKIP ON TIME OUT
	JMP	INTOUT	/NO---GO AROUND AGAIN
	CLA IAC
	DCA	TFLAG	/SET TIME OUT DONE FLAG
	CLLE		/TURN OFF CLOCK
	JMS	UNHOOK	/REMOVE HOOK
	TAD	SAVFL	/GET FLAGS
	RTF		/RESTORE FLAGS
	CLA		/CLA; BUT INTERRUPTS ARE STILL ENABLED
	IOF		/TURN OFF INTERRUPTS BEFORE QUITTING
	RMF		/RESTORE FIELDS
	TAD	SAVAC	/RESTORE AC
	JMP I	VECTOR	/RETURN
INTRST,	CAF		/SHOULD I ABORT JOB INSTEAD?
INTOUT,	TAD	SAVFL	/GET BACK FLAGS
	RTF		/RESTORE LINK, FIELDS, FLAGS
	CLA		/CLEAR AC
	TAD	SAVAC	/RESTORE AC
	RMF		/RESTORE FIELDS
	JMP I	VECTOR	/AND RETURN
STOP,	IOF		/ON ^C KILL INTERRUPTS
	CLA
	JMS	UNHOOK	/REMOVE HOOK
	JMP I	FSTOP	/AND RETURN
OLD,	TAD	TFLAG
	JMS I	(FFLOT
	JMP I	ILOOPL
TFLAG,	0		/TIME OUT FLAG
TCOUNT,	0		/-TIMER COUNT
SAVAC,	0		/SAVED AC
SAVFL,	0		/SAVED FLAGS
FONE,	1		/FLOATING "ONE"
	2000
	0
SHOOK,	0
FHOOK,	0		/HOOK FLAG
FSTOP,	563
FSTOP2,	564
	INS=	.	/THIS IS WHERE THEY START
	HOOK=	.+2	/HOOK LINK GOES INTO 564
	RELOC	1	/THESE THREE GO DOWN ON TO PAGE ZERO
VTRANS,	JMP I	VPOINT	/CONTROL TRANSFERS TO HERE
VPOINT,	SERVE		/AND IT COMES OUT HERE
	RELOC	564	/
LINK,	STOP
	RELOC
UNHOOK,	0		/REMOVE MY HOOK
	TAD	FHOOK
	SNA CLA		/HOOK IN PLACE?
	JMP I 	UNHOOK	/NO, DON'T MESS UP BRTS
	TAD	SHOOK
	DCA I	FSTOP2
	DCA	FHOOK	/RESET HOOK FLAG
	JMP I UNHOOK
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$