*20
/TISA (TIME INDEPENDENT
/SPECTRUM ACQUISITION)
/MULTIPLE DEVICES INTERRUPT DRIVEN
/MOVING WINDOW DISPLAY
/CURSOR AND X-Y DECIMAL READ OUT
/USES QANDA FOR SET UP MODE
/SUPP0RTS UP TO 32K OF CORE
	LODSYM
	LISTAPE -1
	PMODE		/INTERRUPT
	*1		/DISPATCH
	JMP I .+1	/P MODE
	INTP
BETA1,	0		/BETAS FOR LOAD
BETA2,	0		/ROUTS
BETA3,	0
	*10
INIPTR,	0		/PTRS FOR TABLE
ADPTR,	0		/SETUP
			/OF INITIAL VAL
	*20
ADMESS,	0		/MESSAGE PTR
			/FOR TYPE OUT
			/ROUTINES
KBDBUF,	0		/HOLDS LAST
			/KEYBOARD CHAR
TTYFLG,	0		/HOLDS LAST
			/TTY CHAR
			/=0 IF NONE
QUEIN,	0		/PTR TO TTY QUE
			/FOR IN COMING
			/MESSAGES
QUEOUT,	0		/PTR FOR OUT
			/GOING MESS
QUECNT,	0		/HOLDS NUMBER
			/OF UNTYPED
			/MESSAGES IN
			/TTY QUE
STATUS,	0		/HOLDS CLOCK
			/BITS FROM CLSA
DVTYP,	0		/TELLS WHETHER
			/A DEVICE IS
			/ANALOG OR
			/ENCODED
			/4000=ANALOG
			/0XXX=ENCODED
KINPUT,	INPUT		/PTR TO INPUT
			/ROUT
CDF0,	CDF 0
MAXCDF,	0
MINCDF,	CDFMIN
MINADR,	ADRMIN		/BUFFER BOUNDS
YCUR,	0		/Y COORD
			/OF CURSOR
DEVNUM,	0		/-NUM OF DV
			/AT RUN TIME
KDADD,	DADD		/CALL TO DBL
			/PREC ADD
	*41		/L MODE
	2		/INTERRUPT
	JMP I .+1	/DISPATCH
	INTL
DBLLO,	0		/DBL PREC
DBLHI,	0		/AC
ARGLO,	0		/DBL PREC
ARGHI,	0		/ARG
			/ALSO =
			/XCURLO,XCURHI
			/CURSOR X COORD
TEMPLO,	0
TEMPHI,	0
CNTR,	0
BCNTR,	0
BUFPTR,	0		/FOR MOVING
			/WINDOW DISP
LIMPTR,	0		/PTR TO ARGS
			/FOR SR XYGET
BCDPTR,	0		/PTR TO BCD VAL
			/FOR SR XYGET
RADPTR,	0		/PTR TO PWRS OF 
			/10 FOR OCTAL
			/TO DECIMAL SR
CURCDF,	0
MAXDVN,	DVNMAX		/= -NUM OF DEV
			/TISA WILL
			/SUPPORT
KCLEN,	0377		/GOES TO CLEN
			/INT ON OVF
			/CHAN 1,2,3
KDIG,	DIGCHK		/CALL TO SR TO
			/CHK QANDA ANS
			/BUFER FOR 
			/NUMERIC INPUT
KMUL10,	MUL10		/CALL TO DECMAL
			/TO OCT CVERT
KIDLE,	IDLE		/CALL TO IDLE
			/LOOP
SELDV0,	0		/DEVICE SELECT
SELDV1,	0		/WORDS
SELDV2,	0
SELDV3,	0
SELDV4,	0
HSWIT0,	7777
HSWIT1,	7777
HSWIT2,	7777
HSWIT3,	7777
HSWIT4,	7777
SELPTR,	SELDV0
KHLTMS,	HLTMS		/CAL SR TO PUT
			/HALT MESS IN
			/TTY QUE
KGOMS,	GOMS		/CALL GO MESS
MODE,	0		/MODE WORD 0=
			/PAUSE 7777=A\D
TEMP,	0
KQUPUT,	QUPUT		/CALL SR TO PUT
			/A MESS IN QUE
KINI,	INISTR-1	/TOP INIT TABLE
KBLKCT,	BLKCNT		/PTR TO -NUM OF
			/TBLKS IN BUF
KLAST,	LAST		/ENTRY OF INIT
			/TABLE
AAAP0,	0		/1ST UNUSED PG
			/0 CORE LOC
	*200		/L MODE INTRUPT
INTL,	DCA ASAVE
	RAR
	DCA LSAVE
	TAD 40		/MAKE LINC JMP
	AND P1777
	TAD P6000
	DCA RTNJMP
	LINC		/SET UP LDF LIF
	LMODE		/FOR INTERRUPT
	IOB		/RTN
	6234		/RIB
	STA I		/SAVE IB
	0
	ROL 2		/POSITION LDF
			/BITS 
	PDP
	PMODE
	AND P37
	TAD ANLDF
	DCA RTNLDF
	TAD .-6
	RTR		/POSITION LIF
	RAR		/BITS
	AND P37
	TAD ANLIF
	DCA RTNLIF
	JMP SERVE	/SERVICE INTRUP
INTP,	DCA ASAVE	/P MODE INTRUP
	RAR
	DCA LSAVE
	CMA		/7777 FOR PMODE
			/0000 FOR LMODE
SERVE,	DCA INTMOD	/INTERRUPT
	CLSK		/CLOCK ?
	SKP
	JMP TISA	/YES SERVICE
			/DEVICES
TIRTN,	CLA CLL
	KSF		/KEYBOARD ?
	JMP CHKTTY
	KRB		/YES GET CHAR
	DCA KBDBUF
CHKTTY,	TSF		/TTY ?
	JMP INTOUT	/NO EXIT
	TCF		/CLR FLAG
	TAD I ADMESS	/NXT CHAR
	SNA		/MORE TO TYPE ?
	JMP .+3		/NO
	TLS
	ISZ ADMESS	/SET PTR FOR
			/NEXT CHAR
	DCA TTYFLG	/SET TTY FLAG
			/0 MEANS TTY
			/NOT BUSY
INTOUT,	TAD LSAVE	/RTN FROM
	RAL		/INTERRUPT
	TAD ASAVE
	ISZ INTMOD	/P OR L MODE ?
	JMP OUTL	/L MODE
	RMF
	ION
	JMP I 0
OUTL,	LINC
	6		/DJR
RTNLIF,	0
RTNLDF,	0
	500		/IOB
	ION
RTNJMP,	0
			/DATA
			/ACQUISITION
			/SERVICE
			/DEVICES
TISA,	CLSA		/SAVE
	DCA STATUS	/CLOCK BITS
	TAD STATUS	/CHK DV0
	AND SELDV0	/SELECT WD DV0
	SNA		/READY ?
	JMP DV1		/NO GO TO DV1
	DCA DVTYP	/SAVE TYPE
	JMS I KINPUT	/CALL INPUT
			/PARAM LIST
			/DEVICE 0
	100 XAXDV0	/X AXIS SAM
	100 YAXDV0	/Y AXIS SAM
SFDV0,	0		/SAM
			/FREQ (VAR)
KSFDV0,	0		/SAM
			/FREQ (FIXED)
HIDV0,	0		/15 BIT BUFFER
			/ADDR B9-B11
			/OF HI ORD
			/IS DATA FLD
LODV0,	0		/12 BIT ADDR 
			/WITHIN DATA
			/FIELD
OSDV0,	0		/OLD
			/X AXIS SAM
ELODV0,	0		/LAST
EHIDV0,	0		/DATA ADDR
	JMP DV1		/HERE TO
			/CALL DV1
			/HERE TO HLT
			/DEVICE 0
HLTDV0,	DCA SELDV0	/0 DESELECTS
			/A DEVICE
	DCA HSWIT0	/SET HALT SWIT
DV1,	TAD STATUS
	AND SELDV1	/SELECT WD DV1
	SNA		/READY ?
	JMP  I KDV2	/NO GO TO DV2
	DCA DVTYP	/SAVE TYPE
	JMS I KINPUT	/CALL INPUT
			/PARAM LIST
			/DEVICE 1
	100 XAXDV1	/X AXIS SAM
	100 YAXDV1	/Y AXIS SAM
SFDV1,	0		/SAM
			/FREQ (VAR)
KSFDV1,	0		/SAM
			/FREQ (FIXED)
HIDV1,	0		/15 BIT BUFFER
			/ADDR B9-B11
			/OF HI ORD
			/IS DATA FLD
LODV1,	0		/12 BIT ADDR
			/WITHIN DATA
			/FIELD
OSDV1,	0		/OLD
			/X AXIS SAM
ELODV1,	0		/LAST
EHIDV1,	0		/DATA ADDR
	JMP  I KDV2	/HERE TO
			/CALL DV2
			/HERE TO HLT
			/DEVICE 1
HLTDV1,	DCA SELDV1	/0 DESELECTS
			/A DEVICE
	IAC		/SET HALT SWIT
	DCA HSWIT1
	JMP I KDV2	/NXT DEVICE
INTMOD,	0
ANLIF,	600
ANLDF,	640
P37,	37
LSAVE,	0
ASAVE,	0
KDV2,	DV2
P6000,	6000
P1777,	1777
	*400
DV2,	TAD STATUS	/CHK DV2
	AND SELDV2	/SELECT WD DV2
	SNA		/READY ?
	JMP DV3		/NO GO TO DV3
	DCA DVTYP	/SAVE TYPE
	JMS I KINPUT	/CALL INPUT
			/PARAM LIST
			/DEVICE 2
	100 XAXDV2	/X AXIS SAM
	100 YAXDV2	/Y AXIS SAM
SFDV2,	0		/SAM
			/FREQ (VAR)
KSFDV2,	0		/SAM
			/FREQ (FIXED)
HIDV2,	0		/15 BIT BUFFER
			/ADDR B9-B11
			/OF HI ORD
			/IS DATA FLD
LODV2,	0		/12 BIT ADDR
			/WITHIN DATA
			/FIELD
OSDV2,	0		/OLD
			/X AXIS SAM
ELODV2,	0		/LAST
EHIDV2,	0		/DATA ADDR
	JMP DV3		/HERE TO
			/CALL DV3
			/HERE TO HLT
			/DEVICE 2
HLTDV2,	DCA SELDV2	/0 DESELECTS
			/A DEVICE
	CLL IAC RAL	/SET HALT SWIT
	DCA HSWIT2
DV3,	TAD STATUS
	AND SELDV3	/SELECT WD DV3
	SNA		/READY ?
	JMP DV4		/NO GO TO DEV4 
	DCA DVTYP	/SAVE TYPE
	JMS I KINPUT	/CALL INPUT
			/PARAM LIST
			/DEVICE 3
	100 XAXDV3	/X AXIS SAM
	100 YAXDV3	/Y AXIS SAM
SFDV3,	0		/SAM
			/FREQ (VAR)
KSFDV3,	0		/SAM
			/FREQ (FIXED)
HIDV3,	0		/15 BIT BUFFER
			/ADDR B9-B11
			/OF HI ORD
			/IS DATA FLD
LODV3,	0		/12 BIT ADDR
			/WITHIN DATA
			/FIELD
OSDV3,	0		/OLD
			/X AXIS SAM
ELODV3,	0		/LAST
EHIDV3,	0		/DATA ADDR
	JMP DV4		/HERE TO
			/CALL DV4
			/HERE TO HLT
			/DEVICE 3
HLTDV3,	DCA SELDV3	/0 DESELECTS
			/A DEVICE
	STL IAC RAL	/SET HALT SWIT
	DCA HSWIT3
DV4,	TAD STATUS
	AND SELDV4	/SELECT WD DV4
	SNA		/READY ?
	JMP I EXIT	/NO EXIT 
	DCA DVTYP	/SAVE TYPE
	JMS I KINPUT	/CALL INPUT
			/PARAM LIST
			/DEVICE 4
	100 XAXDV4	/X AXIS SAM
	100 YAXDV4	/Y AXIS SAM
SFDV4,	0		/SAM
			/FREQ (VAR)
KSFDV4,	0		/SAM
			/FREQ (FIXED)
HIDV4,	0		/15 BIT BUFFER
			/ADDR B9-B11
			/OF HI ORD
			/IS DATA FLD
LODV4,	0		/12 BIT ADDR
			/WITHIN DATA
			/FIELD
OSDV4,	0		/OLD
			/X AXIS SAM
ELODV4,	0		/LAST
EHIDV4,	0		/DATA ADDR
	JMP  I EXIT	/HERE TO
			/EXIT
			/HERE TO HLT
			/DEVICE 4
HLTDV4,	DCA SELDV4	/0 DESELECTS
			/A DEVICE
	CLL IAC RTL	/SET HALT SWIT
	DCA HSWIT4
	JMP I EXIT
EXIT,	TIRTN
D,	IOF		/D KEY
	LINC		/START DIAL
	LMODE
	AXO
	LIF 2
	JMP DIAL
	PMODE		/P KEY
P,	TAD I KPOLAR	/POLARITY WD
	CMA		/FLIP SPECTRUM
	DCA I KPOLAR
	TAD I KPOLAR	/IS SPECTRUM
	SZA CLA		/INVERTED ?
	JMP .+3
	TAD NORMS	/NO NORM MESS
	SKP		/TO QUE
	TAD INVMS	/YES INVERT
			/MESS TO QUE
KEYRTN,	JMS I KQUPUT
ZXIT,	JMP I .+1	/CROSS PAGE
	OPKRTN		/RTN
F,	TAD I KFREO	/F KEY
	CMA		/COM FREEZE WD
	DCA I KFREO
	TAD I KFREO	/IS SPECTRUM
	SZA CLA		/FROZEN ?
	JMP .+3
	TAD MOTMS	/NO MOTION
	SKP		/MESS TO QUE
	TAD FRMS	/YES FREEZE
	JMP KEYRTN	/MESS TO QUE
S,	TAD MODE	/S KEY
	SZA CLA		/PAUSE MODE ?
	JMP ZXIT	/NO IGNORE S
	IOF		/YES CALL QA
	JMP I KSETUP	/SETUP ROUTS
W,	TAD MODE	/W KEY
	SZA CLA		/PAUSE MODE ?
	JMP ZXIT	/NO IGNORE W
	JMP I KWRIT	/YES CALL
			/WRITE ROUTS
KFREO,	FREEZE
KPOLAR,	POLAR
MOTMS,	MSMOT
FRMS,	MSFR
NORMS,	MSNOR
INVMS,	MSINV
KSETUP,	SETUP
KWRIT,	WRIT
	*600		/GET INPUT FROM
INPUT,	0		/DEVICE K
			/GET PARAMETER
			/LIST FROM CALL
	TAD I INPUT
	DCA SAMX	/X AXIS SAM
	ISZ INPUT
	TAD I INPUT
	DCA SAMY
	ISZ INPUT
	TAD INPUT	/PTR TO
	DCA FREQ	/SAMPLING FREQ
			/LAST COUNT
			/(VAR)
	ISZ INPUT
	TAD INPUT	/PTR TO
	DCA KFREQ	/SAM FREQ
			/(FIXED)
	ISZ INPUT	/PTR TO
	TAD INPUT	/BUFFER
	DCA CDFVAL	/CDF BITS
	ISZ INPUT	/PTR TO
	TAD INPUT	/BUFFER
	DCA ADDR	/ADDR
	ISZ INPUT
	TAD INPUT
	DCA OLDSAM	/PTR TO OLDSAM
	ISZ INPUT
	TAD I INPUT	/PTR TO LAST
	DCA ENDLO	/DATA ADDR
	ISZ INPUT
	TAD I INPUT
	DCA ENDHI
	ISZ INPUT	/FIRST RTN IS
			/JMP TO DV K+1
			/2ND IS HLT DVK
	TAD DVTYP	/ANALOG
	SPA CLA		/OR ENCODED ?
	JMP ANALOG
ANARTN,	ISZ  I FREQ	/READY TO SAM
			/Y AXIS ?
	JMP I INPUT	/NO GO TO
			/DV K+1
	TAD I KFREQ	/RESET FREQ
	DCA I FREQ	/FOR NXT PASS
	TAD I ADDR
	DCA HOLD	/BUFFER ADDR
	TAD I CDFVAL	/SETUP CDF
	CLL RAL
	RTL
	TAD CDF0
	DCA .+1
	0		/CDF N
	LINC
SAMY,	0		/SAM Y AXIS
	2		/PDP
	DCA I HOLD	/PUT IN DATA
			/BUFFER
	CDF 0		/RESTORE FLD 0
	TAD ENDLO	/DVK IS FINI
			/WHEN CURRENT
	TAD I ADDR	/ADDR
	SZA CLA		/(CDFVAL,ADDR)
	JMP NFDVK
	RAL
	TAD ENDHI	/=TERMINAL ADDR
			/(ENDHI,
	TAD I CDFVAL	/ENDLO)
	SZA CLA
	JMP NFDVK
	ISZ INPUT	/FINI DV K
	JMP I INPUT
NFDVK,	CLL IAC		/ADV CURRENT
	TAD I ADDR	/ADDR
	DCA I ADDR
	RAL
	TAD I CDFVAL
	DCA I CDFVAL
	JMP I INPUT	/NORMAL RTN
ANALOG,	LINC
SAMX,	0		/SAM X AXIS
	2		/PDP
	TAD P1000	/MAKE POS
	DCA NEWSAM
	TAD I OLDSAM	/CHK FOR 1 BIT
	CIA		/INCREASE
	TAD NEWSAM
	SMA SZA		/X AXIS READY ?
	JMP CHGSAM	/YES
	TAD MAXDRP	/CHK FOR
	SPA CLA		/TOO FAR ?
	ISZ INPUT	/YES ADV TO
			/HALT RTN
	JMP I INPUT	/NO GO TO DVK+1
CHGSAM,	CLA		/UPDATE
	TAD NEWSAM	/OLDSAM
	DCA I OLDSAM
	JMP ANARTN	/NOW CHK Y
			/AXIS
MAXDRP,	DRPMAX		/MAX X AX DROP
NEWSAM,	0
P1000,	1000
OLDSAM,	0
ADDR,	0
CDFVAL,	0
ENDLO,	0
ENDHI,	0
KFREQ,	0
FREQ,	0
HOLD,	0
	*1000
MESCHK,	0		/TTY CHK
	TAD QUECNT	/IS QUE EMPTY ?
	SNA CLA
	JMP I MESCHK	/YES XIT
	TAD I ADMESS	/NO IS A MESS
	SZA CLA		/IN PROCESS ?
	JMP I MESCHK	/YES XIT
	TAD TTYFLG	/NO IS  A CHAR
	SZA CLA		/IN PROCESS ?
	JMP I MESCHK	/YES XIT
	TAD I QUEOUT	/NO NEXT MESS
	DCA ADMESS	/TO BATTERS
			/BOX
	TAD QUEOUT	/ADV QUEOUT TO
	ISZ QUEOUT	/NEXT MESS
	TAD ENQUE	/IF AT END OF
	SZA CLA		/QUE ADV TO GO
	JMP .+3		/DO NOT COLLECT
			/$200
	TAD STQUE
	DCA QUEOUT
	STA		/BACK UP COUNT
	TAD QUECNT
	DCA QUECNT
	TAD I ADMESS	/KICK OFF 1ST
	ISZ ADMESS	/CHAR
	TLS		/INTERRUPTS
			/WILL CARRY THE
			/BALL FROM HERE
	DCA TTYFLG	/SET FLAG TTY
			/IS BUSY
	JMP I MESCHK
			/INPUT MESS
QUPUT,	0		/TO QUE
	DCA QSAVE	/SAVE ADDR
	TAD QUECNT	/CHK FOR QUE
	TAD QUEMAX	/FULL
	SNA		/1 SLOT LEFT ?
	JMP TBUSY	/YES INPUT BUSY
			/MESS
	SMA CLA		/FULL ?
	JMP I QUPUT	/YES INHIBIT MS
	TAD QSAVE	/NO INPUT MESS
INMESS,	DCA I QUEIN	/TO QUE
	TAD QUEIN	/IS QUEIN AT
	TAD ENQUE	/GO ?
	SZA CLA
	JMP .+4
	TAD STQUE	/YES COLLECT
	DCA QUEIN	/$200
	SKP
	ISZ QUEIN	/ADV PTR
	ISZ QUECNT	/ADV COUNT
	JMP I QUPUT
TBUSY,	CLA		/PUT BUSY
	TAD BUSYMS	/MESS IN QUE
	JMP INMESS
QUEMAX,	STRQUE-ENDQUE	/-MAX NUM OF
			/MESS+1
BUSYMS,	MSBUSY		/ADDR OF BUSY
			/MESS
STQUE,	STRQUE
ENQUE,	-ENDQUE
QSAVE,	0
DOMTP,	0		/WRITE TAPE
	TAD I KBLKCT	/-NUM TO DO
	DCA QSAVE
	TAD ARGHI
	DCA TPINST
	TAD ARGLO
	DCA TPWORD
	TAD LDFSTR
	DCA TPLDF
MTPLOP,	LINC
	LMODE
TPLDF,	0		/LDF N
TPINST,	0		/MTP INST
TPWORD,	0		/MBLK\TBLK
	JMP TPWAIT
	CLR		/LINK BIT
	LDA I		/ADV TBLK, MBLK
	1001
	LAM
	TPWORD
	BCL I
P7K,	7000
	AZE		/TBLK WRAP ?
	JMP GOODY	/NO
	CLR		/LINK
	ADD P7K		/BU MBLK
	LAM
	TPWORD
	AZE		/END OF DF ?
	JMP BYMBLK	/NO
GOODY,	LZE I		/MBLK WRAP
			/AROUND ?
	JMP BYMBLK	/NO
	LDA		/YES RESET
	TPWORD		/MBLK
	BSE I
	4000
	STC TPWORD
	ADD TPLDF	/ADV LDF
	ADA I
	1
	STC TPLDF
BYMBLK,	PDP
	PMODE
	ISZ QSAVE	/DONE ?
	JMP MTPLOP	/NO
	LINC
	LMODE
	LDA
	TPINST
	BCL I
	7767		/U BIT
	ADA I
	CHK
	STC .+1
	0		/STOP TAPE
	270
	JMP TPWAIT
	ESF
	LDA I		/AND CLR XOB
	EXTMTP		/U BITS
	AXO
	PDP
	PMODE
	JMP I DOMTP
	LMODE
TPWAIT,	PDP
	PMODE
	JMS I KIDLE
	LINC
	LMODE
	DJR
	STD
	JMP TPWAIT
	JMP 0
	PMODE
LDFSTR,	FIRLDF
	PAGE
KEYBRD,	0		/KEYBOARD SR
	TAD KBDBUF	/GOT A CHAR ?
	SNA
OPKRTN,	JMP I KEYBRD	/NO XIT
	DCA CHAR	/SAVE
	DCA KBDBUF	/CLR BUF
	TAD CHRTAB	/START OF TABLE
	DCA CHRPTR
CHRLOP,	TAD I CHRPTR	/SEARCH FOR
	CIA		/MATCH
	TAD CHAR
	ISZ CHRPTR	/ADV PAST JMP
	SNA CLA
	JMP MATCH
	ISZ CHRPTR	/ADV TO NXT CHR
	JMP CHRLOP
MATCH,	TAD I CHRPTR	/LOAD A JMP
	DCA .+1		/SERVE VIA
	0		/JMP INST
CHRTAB,	KBDTAB
CHRPTR,	0
/KEYBOARD LOOKUP TABLE FORMAT IS:
/LOCA,	 ASCII CODE OF DEFINED CHAR
/LOCA+1, JMP TO ROUT FOR CHAR
/THE LOC CHAR IS IN TABLE SO IF NONE
/MATCH THE DEFAULT CASE IS JMP I KEYBRD
KBDTAB,	304		/D
	JMP I KD	/START DIAL
	210		/CNTRL\H
	JMP CTRLH	/HLT ALL DVS
	310		/H
	JMP H		/HALT
	320		/P
	JMP I KP	/POLARITY
	306		/F
	JMP I KF	/FREEZE
	307		/G
	JMP G		/GO
	323		/S
	JMP I KS	/SETUP
	327		/W
	JMP I KW	/WRITE TAPE
	303		/C
	JMP C		/CALL CATACAL
	315		/M
	JMP M		/CALL MAGSPY
	314		/L
	JMP L		/CALL LOADER
			/NUMERIC ARGS
			/FOR H AND G
	260		/0
	JMP NUM
	261		/1
	JMP NUM
	262
	JMP NUM
	263
	JMP NUM
	264
	JMP NUM
CHAR,	0		/DEFAULT CASE
	JMP I KEYBRD
KP,	P
KF,	F
KD,	D
KS,	S
KW,	W
			/CTRLH KEY
CTRLH,	TAD MODE	/=0 FOR PAUSE
			/=7777 FOR A\D
	SNA CLA		/PAUSE MODE ?
	JMP I KEYBRD	/YES IGNORE
			/CTRLH
	DCA MODE	/SET MODE TO
			/PAUSE
	CLEN		/DISABLE ALL
			/CLOCK
			/INTERRUPTS
	DCA SELDV0
	DCA SELDV1	/DESELECT
	DCA SELDV2	/ALL DEVICES
	DCA SELDV3
	DCA SELDV4
	TAD HLTALL	/PUT MESS
	JMS I KQUPUT	/IN QUE
	JMP I KEYBRD
			/H AND G SET A
			/SWITCH TO WAIT
			/FOR A 2ND CHAR
H,	CMA		/SET FOR 2ND
	DCA HSWIT	/H AND G CANNOT
	DCA GSWIT	/BOTH BE SET
	JMP I KEYBRD
G,	CMA		/SET FOR 2ND
	DCA GSWIT
	DCA HSWIT
	JMP I KEYBRD
NUM,	TAD CHAR	/NUM KEY
	AND PP17	/STRIP ASCII
	DCA TEMP
	TAD TEMP	/CHK FOR
	TAD DEVNUM	/UNDEFINED
	SMA CLA		/DEV NUM
	JMP I KEYBRD	/ILLEGAL XIT
	TAD HSWIT	/IS 2ND ARG
	SNA CLA		/FOR H ?
	JMP .+3		/NO CHK G
	DCA HSWIT	/YES CLR SWIT
	JMP I KHALT	/GO TO HALT SR
	TAD GSWIT	/IS IT G ?
	SNA CLA
	JMP I KEYBRD	/NO XIT
	DCA GSWIT	/YES CLR SWIT
	JMP I KGO	/GO TO GO SR
C,	TAD MODE	/C KEY
	SZA CLA		/PAUSE MODE ?
	JMP I KEYBRD	/NO IGNORE C
	LINC		/YES LOAD
	6000+CATA	/CATACAL
M,	TAD MODE	/M KEY
	SZA CLA		/PAUSE MODE ?
	JMP I KEYBRD	/NO IGNORE M	
	LINC		/YES LOAD
	6000+MAG	/MAGSPY
L,	TAD MODE	/L KEY
	SZA CLA		/PAUSE MODE ?
	JMP I KEYBRD	/NO XIT
	IOF		/YES GET PROG
	LINC		/NAME TO BE
	LMODE		/LOADED
	LIF 2
	JMP LOAD
	PMODE
HLTALL,	ALLHLT
HSWIT,	0
GSWIT,	0
KHALT,	HALT
PP17,	17
KGO,	GO
			/HERE TO HALT
			/A DEVICE
	PAGE
HALT,	TAD TEMP	/HOLDS DV NUM
			/TO BE HALTED
	TAD SELPTR	/PTR TO 1ST
			/SELECT WORD
			/THEY OCCUR
			/SEQUENTIALLY
	DCA ATEMP
	TAD I ATEMP	/IS DEVICE
	SNA CLA		/HALTED ?
	JMP I KEYXIT	/YES IGNORE
			/HALT COMMAND
	DCA I ATEMP	/0 T0 SELECT
			/WORD
			/PUT HALT
	JMS I KHLTMS	/MESS IN QUE
	JMP I KEYXIT
GO,	TAD TEMP	/START A DEVICE
	TAD SELPTR	/GET ADDR OF
	DCA ATEMP	/SELECT WORD
	TAD I ATEMP	/IS THE DV IN
	SZA CLA		/A\D MODE ?
	JMP I KEYXIT	/YES IGNORE
			/GO COMMAND
			/PUT GO MESS
	JMS I KGOMS	/IN QUE
	TAD TEMP	/GET ADDR OF
	TAD TIVAL	/DV GO VALUES
	DCA FROM
	TAD I FROM
	DCA FROM
	TAD TEMP	/GET PTR TO
	TAD TIADR	/WHERE THEY
	DCA TO		/GO
	TAD I TO
	DCA TO
	CLL CMA RTL	/-3
	TAD TEMP	/RELATIVE TO
	SMA SZA CLA	/SAM 10 ?
	CLL IAC RTL	/(4) NO SAM 20
	TAD ASAM	/AC=SAM 10 OR
			/SAM 14
	TAD TEMP	/SETUP 1ST SAM
	DCA INISAM
	TAD TEMP	/CLR HLT SWIT
	TAD HLTPTR
	DCA TEMP
	CMA
	DCA I TEMP
	TAD M5		/TRANSFER 5
	DCA TEMP	/VALUES FROM
			/TABLE
	IOF		/INTERUPTS OFF
			/UNTIL DV IS
			/SELECTED
GOLOP,	TAD I TO	/GET AN ADDR
	DCA ATEMP	/SAVE
	TAD I FROM	/GET A VALUE
	DCA I ATEMP	/STORE
	ISZ FROM	/ADV PTRS
	ISZ TO
	ISZ TEMP	/DONE 5 ?
	JMP GOLOP
	TAD I TO	/GET ADDR OF
	DCA ATEMP	/OLDSAM
	LINC
INISAM,	0		/SAM X AXIS
	2		/PDP
	TAD PL1000	/MAK +
	DCA I ATEMP	/STORE INITIAL
			/SAM
	TAD KCLEN	/ENABLE ALL
	CLEN		/CLOCK
			/INTERUPTS
	CLA
	TAD MODE
	SPA CLA
	JMP .+3
	TAD ADMS
	JMS I KQUPUT
	STA		/SET A\D MODE
	DCA MODE
	ION		/DV IS READY
	JMP I KEYXIT
ADMS,	MSAD
KEYXIT,	OPKRTN
ATEMP,	0
TIVAL,	VALTAB
FROM,	0
TO,	0
TIADR,	ADRTAB
ASAM,	0110		/SAM 10
M5,	-5
PL1000,	1000
HLTPTR,	HSWIT0
	LMODE
CATA,	LDA I		/LOAD CATACAL
	CATPTR-1
	JMP LOADER
MAG,	LDA I		/LOAD MAGSPY
	MAGPTR-1
	JMP LOADER
KLOAD,	LDF 2		/LOAD PRGM X
	SET I BETA1	/GET NAME FROM
	LODPTR-HBIT	/QANDA ANS BUF
	SET I BETA2
	ANSWER+2000
LODLOP,	LDH I BETA2	/FROM QA
	AZE I
	COM		/SET 0 TO 77
	SHD I
	QAEOL1		/END OF NAME
	JMP GETU	/YES GET UNIT
	STH I BETA1	/TO LOD TABLE
	JMP LODLOP
GETU,	LDH I BETA2	/UNIT WD
	BCL I
	7770
	STA I BETA1
	LDA I
	LODPTR-1
LOADER,	STC BETA2	/PUT PROG AND
	IOB		/UNIT IN E6
			/TABLE FOR
			/LOADER
			/ARG IS IN AC
	6002		/IOF
	AXO		/CLR XOB
	ESF
	LDF 1
	RDC I		/DIAL GRD TAB
	4\314
	SET I BETA1	/E6 TABLE FOR
	2372		/LOADER
	SET I BETA3	/NAME AND UNIT
	-5		/TAKE 5 WORDS
	LDA I BETA2
	STA I BETA1
	XSK I BETA3	/DONE ?
	JMP .-3		/NO
	LDF 2
	RDC I		/GET DIAL
	4\354		/LOADER
	LDF 1
	LIF 2
	JMP 20		/GO LOADER
CATPTR,	0301		/CA
	2401		/TA
	0301		/CA
	1477		/L 77
	0		/UNIT
MAGPTR,	1501		/MA
	0723		/GS
	2031		/PY
	7777
	0		/UNIT
LODPTR,	0		/N
	0		/A
	0		/M
	0		/E
	0		/UNIT
	PMODE		/HERE TO SETUP
			/READ WRITE SR
TPARGS,	0		/GET MTP ARGS
	CLA 		/FROM QANDA
	TAD M10		/SET DIGCHK
	DCA I KUPLIM	/TO ACCEPT
			/OCTAL INPUT
			/ONLY
	DCA TBLK	/CLR TBLK
TPLOP,	JMS I KDIG	/GET 1 DIGIT
	JMP ANONO	/INPUT ERROR
	JMP DUNBLK	/FINI TBLK
	TAD TBLK	/UPDATE
	RTL CLL		/TBLK
	RAL
	DCA TBLK
	JMP TPLOP
DUNBLK,	JMS I KDIG	/GET UNIT
	JMP ANONO	/INPUT ERROR
	CLA		/ONLY 1 ARG
	CLL RAR		/SET U BITS
	LINC
	LMODE
	ADA I
	EXTMTP		/EXT U BITS
	AXO		/TO XOB
	PDP		/NOW PUT LOW
	PMODE		/ORD U BIT
	CLA RTL		/IN BIT 8
	RTL		/OF UNIT WORD
	DCA UNIT
	TAD TBLK
	RTR CLL
	RAR		/POS TO 9 BITS
	DCA TBLK
	ISZ TPARGS	/ADV PAST
ANONO,	CLA		/ERROR RTN
	TAD MM12	/FIX UP
	DCA I KUPLIM	/DIGCHK
	JMP I TPARGS
MM12,	-13		/-12 1S COM
M10,	-11		/-10 1S COM
KUPLIM,	UPLIM
TBLK,	0
UNIT,	0
			/HERE TO READ
			/PARAM INPUT
DORDC,	JMS TPARGS	/GET TBLK, UNIT
	JMP I KRDERR	/INPUT ERROR
	TAD TBLK
	TAD RMBLK
	DCA RDCWD
	TAD UNIT
	TAD ANRDC
	DCA TPRDC
	LINC
	LMODE
	LDF 3
TPRDC,	0		/RDC (U)
RDCWD,	0		/MBLK\TBLK
	STD
	JMP .-1
	LDA I
	20
	ESF		/I/O PRESET
	LDA I
	EXTMTP		/SET
	AXO		/NO PAUSE
	PDP
	PMODE
	CLA
	TAD RDLEN	/LENGTH OF INIT
	DCA CNTR	/TABLE
	TAD KFIRST	/START OF TABLE
	DCA INIPTR
	TAD MINADR	/INPUT STARTS
	DCA ADPTR	/BEG OF BUFFER
	TAD I ADPTR
	DCA I INIPTR
	ISZ CNTR	/DONE ?
	JMP .-3
	TAD I KLAST	/CHK FOR FATAL
	SMA
	JMP I KRDERR
	CIA		/ERROR WRONG
	TAD MAXDVN	/TBLK AND TOO
	SMA SZA CLA	/MANY DEVS
	JMP I KRDERR	/ILLEGAL TBLK
	JMS I KFRESH	/CLR BUFFER
	TAD I KLAST	/-NUM OF DEVS
	JMP I .+1	/GO TO QADUN
	STRRDE		/ROUT
KRDERR,	READ-1
KFIRST,	FIRST-1
ANRDC,	700
RDLEN,	FIRST-LAST-1
WMBLK,	WRMBLK
RMBLK,	RDMBLK
KFRESH,	FRSTR
DOWRC,	JMS TPARGS	/GET TBLK, UNIT
	JMP I KWRERR	/INPUT ERROR
	TAD TBLK
	TAD WMBLK
	DCA ARGLO	/ARG1 FOR
			/SR DOMTP
	TAD UNIT
	TAD AWRI	/ARG2 FOR
	DCA ARGHI	/DOMTP
	JMS I KDOMTP	/WRITE N BLKS
	ION
	JMS I KIDLE
	JMP .-1
AWRI,	726		/WRI I
KDOMTP,	DOMTP
KWRERR,	WRIT
AAAS0,	0
/DISPLAY ROUTINES
/MOVING WINDOW, CURSOR
/X-Y DECIMAL READ OUT
/HELP FRAME
	SCPFLD=2000
	LMODE
	SEGMNT 1	/=SCPFLD/2000
	*17
XCORD,	0		/DIS REGISTER
IDLE,	0		/IDLE LOOP
			/SCOPE, KEYBRD
			/TTY
	6141		/LINC
	SNS I 0		/1 OF 2 DISPS
	JMP DSCHLP	/HELP FRAME
			/DATA BUFFER
	SAM 4		/CURSOR KNOB
	SCR 1		/9 BITS COVERS
			/ALL X VALUES
	PDP		/MAKE +
	PMODE		/WHEN CURCNT
	TAD P401	/GOES TO 0
	CIA		/DIS CURSOR
	LINC
	LMODE
	STC CURCNT-SCPFLD
	SET I XCORD
	-1000		/INIT X COORD
			/-1
	SAM 0		/WINDOW KNOB
	SCR 4		/HI ORD 6 BITS
			/DET MOTION +
			/IS FWD -IS BWD
			/APPEARANCE OF
			/MOTION IS
			/GIVEN BY
			/VARYING THE
			/INITIAL ADDR
	SRO I
FREEZE,	7777		/7777 MEANS
			/FREEZE WINDOW
	JMP GODIS-SCPFLD-1
	JMP SETMOT-SCPFLD
	PMODE		/HERE WHEN
			/SCOPE FINI
SCPRTN,	JMS I KKEY	/KEYBOARD
	JMS I KSWI	/INTERNAL HLT
	JMS I KMES	/TTY
	JMP I IDLE
KKEY,	KEYBRD
KMES,	MESCHK
KSWI,	CHKSWI
	LMODE		/DSC HELP
			/SEE HLPTAB
			/FOR FORMAT
DSCHLP,	LDF 2		/GRID TABLE
			/IN LDF 2
	SET I MSPTR	/TO DIAL
	HLPTAB-HBIT	/ENCODED MESS
	SET I VCPTR	/TABLE OF
	VCTAB-1		/VERT COORDS
	SET I HCPTR	/TABLE OF
	HCTAB-1		/HORIZ COORDS
LNNXT,	LDA I VCPTR
	STC VCOORD
	LDA I HCPTR
	STC 1
	LDH I MSPTR	/1ST CHAR OF LN
	SHD I		/IS LN FULL
	FUL1		/SIZE CHARS ?
	JMP SETFUL	/YES
	CLR		/L=0 FOR HAF
	ESF		/SET HAF SIZE
	LDH MSPTR	/RESTORE CHAR
	SKP
CHRNXT,	LDH I MSPTR
	SHD I
	CR1		/END OF LN ?
	JMP LNNXT	/YES
	SHD I		/END OF
	ENDWD1		/MESSAGE ?
	JMP SCPXIT	/YES
	SHD I		/RESET
	CHGHC		/HORIZ COORD ?
	JMP SETHC	/YES
	JMP DSCCHR
	JMP CHRNXT
SETHC,	LDA I HCPTR
	STC 1
	JMP CHRNXT
SETFUL,	LDA I
	200
	ESF		/SET FULL SIZE
	COM
	ROL I 1		/L=1 FOR FULL
	JMP CHRNXT
DSCXY,	LDF 2		/DSC: X=-----
	CLR		/     Y=---
	ESF		/HALF SIZE
	ADD P401-SCPFLD
	STC VCOORD
	SET I MSPTR	/DIAL ENCODED
	DCODEX-HBIT	/MESS
NXTLN,	LDA I
	-20
	ADM
	VCOORD
	SET I 1
	XYHC
INICHR,	LDH I MSPTR	/INIT CHARS
	SHD I
	CR1		/EOL ?
	JMP .+3		/YES
	JMP DSCCHR
	JMP INICHR
	LDH I MSPTR
	SHD I		/DO NOT DSC
	6000		/LEADING 0S
	JMP .-3
	SKP
NXTCHR,	LDH I MSPTR
	SHD I
	CR1		/EOL ?
	JMP NXTLN	/YES
	SHD I
	ENDWD1		/END OF MESS ?
	JMP SCPXIT	/YES
	JMP DSCCHR
	JMP NXTCHR
SCPXIT,	PDP		/RTN
	PMODE
	CLA CLL
	JMP SCPRTN
P401,	401
	*SCPFLD+200	/GET INIT BUF
			/ADDR FOR DISP
			/DELTA X IN AC
SETMOT,	2		/PDP
	CLL
	SPA		/FWD OR BWD ?
	JMP BWDMOT
	TAD BUFLO	/UPDATE 15 BIT
	DCA BUFLO	/ADDR
	RAL
	TAD BUFHI
	DCA BUFHI
	TAD BUFHI	/CHK FOR HI
	CIA		/END WRAP
	TAD MAXCDF	/AROUND
	SMA CLA		/OK ?
	JMP GODIS	/YES
	TAD MINCDF	/RESET LO END
	DCA BUFHI
	TAD MINADR	/NEW ADDR IS
	TAD BUFLO	/REL TO MINADR
	DCA BUFLO
	JMP GODIS
BWDMOT,	TAD BUFLO	/BU ADDR
	DCA BUFLO
	SZL		/UNDER FLOW ?
	JMP CHKADR	/NO
	STA		/YES BU CDF
	TAD BUFHI	/BITS
	DCA BUFHI
CHKADR,	TAD MINCDF
	CIA
	TAD BUFHI
	SMA SZA CLA	/CDF BITS AT
			/LOW END ?
	JMP GODIS	/NO
	TAD MINADR
	CIA
	TAD BUFLO	/ADDR BITS
	SMA		/OK ?
	JMP GODIS	/YES
	DCA BUFLO	/CORRECT ADDR
			/IS IN AC
	TAD MAXCDF	/SET CDF BITS
	DCA BUFHI	/BWD WRAP
	2		/SOMETIMES HERE
			/IN LMODE (PDP)
GODIS,	CLA CLL
	TAD BUFLO	/SET BUFPTR
	DCA BUFPTR	/TO INIT ADDR
	TAD BUFHI	/SET CDF BITS
	DCA CURCDF
	JMS SETCDF	/SET DATA FLD
	TAD M1000	/SET FOR
	DCA BCNTR	/512 POINTS
NXTPNT,	CLA
	TAD I BUFPTR
	LINC
	LMODE
	SCR 1		/SCP MAX IS 9
			/BITS
	SRO I		/7777 INVERTS
POLAR,	0		/SPECTRUM
	COM
	DIS I XCORD
	PDP
	PMODE
	ISZ CURCNT	/READY TO DIS
			/CURSOR
	SKP		/NO
	JMP I KCUR
CURRTN,	ISZ BUFPTR	/CHNG FLDS ?
	SKP		/NO
	JMP FWDCDF
FWDRTN,	ISZ BCNTR	/512 PNTS ?
	JMP NXTPNT	/NO
	JMP I KXYGET	/YES GET
			/X-Y COORDS
FWDCDF,	CLA		/ADV CDF
	ISZ CURCDF
	TAD CURCDF
	CIA
	TAD MAXCDF
	SMA CLA		/WRAP AROUND ?
	JMP BYWRAP	/NO
	TAD MINADR
	DCA BUFPTR
	TAD MINCDF
	DCA CURCDF
BYWRAP,	JMS SETCDF
	JMP FWDRTN
SETCDF,	0		/SET CDF REL
			/TO CURCDF
	TAD CURCDF
	RAL CLL
	RTL
	TAD CDF0
	DCA .+1
	0
	JMP I SETCDF
			/DBL PREC ADD
			/OF
			/(DBLHI,DBLLO)
			/(ARGHI,ARGLO)
			/ANSWER IN
			/(DBLHI,DBLLO)
			/L=0 IF +
			/L=1 IF -
DADD,	0
	CLA CLL
	TAD DBLLO
	TAD ARGLO	/=XCURLO
	DCA DBLLO
	RAL
	TAD DBLHI
	TAD ARGHI	/=XCURHI
	DCA DBLHI
	CLL
	TAD DBLHI
	SPA CLA
	CML
	JMP I DADD
BUFLO,	ADRMIN
BUFHI,	CDFMIN
M1000,	-1000
CURCNT,	0
KCUR,	CURDIS
KXYGET,	XYGET
	*SCPFLD+400	/FIND REL DEV
			/ADDR IN BUFFER
XYGET,	CDF 0		/RESTORE FIELD
	CLA		/HOLDS ADDR OF
	TAD KLIM	/TABLE DEV INFO
	DCA LIMPTR
	STA
	TAD DEVNUM	/- NUM DV 
	DCA CNTR
LIMLOP,	TAD I LIMPTR	/-ST ADDR
	DCA DBLLO	/FOR DV K
	ISZ LIMPTR	/ADDR TO DBLLO
	TAD I LIMPTR	/CDF BITS
	DCA DBLHI	/TO DBLHI
			/XCOORD IS IN
			/(ARGHI,ARGLO)
	JMS I KDADD	/IS XCOORD GE
	SZL		/ST ADDR DV K ?
	JMP FOUND	/NO ADDR LIMITS
			/HAVE BEEN DET
	TAD DBLLO	/SAVE DIFF FOR
	DCA TEMPLO	/DV K IT IS REL
	TAD DBLHI	/ADDR FOR DV K+1
	DCA TEMPHI
	ISZ LIMPTR	/ADV PTR TO
	ISZ LIMPTR	/NEXT ST
	ISZ LIMPTR	/ADDR
	ISZ CNTR	/SCANNED ALL
			/DEVICES ?
	JMP LIMLOP	/NO
	JMP I .+1	/YES CURSOR IS
	SCPRTN		/IN VOID AREA
			/DO NOT DSC X-Y
FOUND,	DCA DBLLO	/ANSWER IS IN
	DCA DBLHI	/TEMPLO,TEMPHI
			/CLR DBL AC
	STA CLL RTL	/BU PTR (-3)
	TAD LIMPTR	/TO DEVICE
	DCA LIMPTR	/SAM FREQ
	TAD I LIMPTR	/MULT ANSWER
	DCA CNTR	/BY SAM FREQ
	TAD TEMPHI
	DCA ARGHI
	TAD TEMPLO
	DCA ARGLO
	JMS I KDADD
	ISZ CNTR	/DONE ?
	JMP .-2		/NO
			/YES REL OCTAL
			/ADDR NOW IN
			/DBL AC CVERT
			/TO BCD
	ISZ LIMPTR	/ADV TO BCD
	TAD I LIMPTR	/ADDR FOR DV K
	DCA LIMPTR	/(LO TO HI)
			/5 DIGITS
	TAD KBCD	/ADDR OF BCD
	DCA BCDPTR	/ANSWER
	TAD KRAD	/PTR TO
	DCA RADPTR	/DECIMAL RADII
	TAD NEG5
	DCA CNTR
DBLLOP,	TAD I RADPTR	/-100K,-10, HI
	DCA ARGHI
	ISZ RADPTR
	TAD I RADPTR	/-100K,-10, LO
	DCA ARGLO
	ISZ RADPTR
	DCA BCNTR	/COUNTS MULTS
			/OF PWRS OF 10
DBLDEF,	TAD DBLLO	/SAVE LAST
	DCA TEMPLO	/DEFLATE
	TAD DBLHI
	DCA TEMPHI
	JMS I KDADD	/DEFLATE 1 TIME
	ISZ BCNTR
	SNL		/MINUS YET ?
	JMP DBLDEF		/NO CONT
	STA		/CORRECT FOR
	TAD BCNTR	/OFF BY 1
	DCA I BCDPTR	/SAVE
	ISZ BCDPTR
	TAD TEMPLO	/RESET TO
	DCA DBLLO	/LAST VAL
	TAD TEMPHI
	DCA DBLHI
	ISZ CNTR	/DONE BOTH ?
	JMP DBLLOP	/NO
	TAD DBLLO	/UNITS
	DCA I BCDPTR
	LINC
	LMODE
	SET I XCORD	/SET PTR TO
	DCODEX+4	/X-Y TABLE
	PDP
	PMODE
	TAD NEG5	/SET FOR 5
	DCA CNTR	/BCD ADDS
	DCA BCNTR	/HOLDS BCD
			/CARRYS
	JMP I.+1
	BCDLOP		/CONT NXT PAGE
KLIM,	LIMVL0
KBCD,	BCDVAL
KRAD,	RADVAL
NEG5,	-5
			/ADD ABSOLUTE
			/DECIMAL VIA
			/LIMPTR TO
			/DECIMAL XCOORD
			/VIA BCDPTR AND
			/STORE FINAL
			/RESULT IN
			/X-Y TABLE
	*SCPFLD+600
BCDLOP,	CLA CLL
	TAD BCNTR	/CARRY=0,1
	TAD I LIMPTR	/0-11
	TAD I BCDPTR	/0-11
	DCA TEMPLO	/0-23
	TAD TEMPLO	/CHK CARRY
	TAD M12
	SMA		/CARRY ?
	DCA TEMPLO	/YES CORRECT
			/ANSER IS IN AC
	RAL CLA		/L=1 ON CARRY
	DCA BCNTR	/SET CARRY FOR
			/NEXT BCD ADD
	CMA		/RESET PTRS
	TAD BCDPTR
	DCA BCDPTR
	ISZ LIMPTR
	TAD TEMPLO	/ANSWER+60
	TAD P60		/=DIAL CODE
	LINC
	LMODE		/STORE IN
	STH XCORD	/X-Y TABLE
	LDA I		/BU XCORD
	-HBIT
	ADD XCORD
	STC XCORD
	PDP
	PMODE
	ISZ CNTR	/DONE ?
	JMP BCDLOP	/NO
	TAD I BCDPTR	/YES GET 100K
	TAD BCNTR	/DIGIT+CARRY
	TAD P60
	LINC
	LMODE
	STH XCORD
	SET I XCORD	/NOW SET FOR
	DCODEY+1	/Y VALUE
	PDP
	PMODE
	CLL STA RAL	/DO 100S, 10S
	DCA CNTR	/Y BCD CVERT
	TAD PP400	/MAKE Y +
	TAD YCUR
	DCA YCUR
			/Y IS 0-777
YLOP,	TAD I RADPTR	/-100, -10
	DCA ARGLO
	DCA BCNTR
	ISZ RADPTR
	TAD YCUR
	TAD ARGLO	/1 DEFLATE
	ISZ BCNTR	/BCD VALUE
	SMA		/DONE ?
	JMP .-3		/NO
	TAD I RADPTR	/+100, +10
	DCA YCUR	/RESET VALUE
	ISZ RADPTR
	TAD BCNTR	/OFF BY 1
	TAD P57		/60-1
	LINC
	LMODE		/DIAL CODE
	STH I XCORD	/TO X-Y TABLE
	PDP
	PMODE
	CLA
	ISZ CNTR	/DONE ?
	JMP YLOP	/NO
	TAD YCUR	/UNITS
	TAD P60
	LINC		/STORE
	LMODE		/THE TABLE
	STH I XCORD	/IS FINALLY
	JMP DSCXY	/READY
			/HERE TO
	PMODE		/DIS CURSOR
CURDIS,	DCA YCUR	/Y COORD
	RDF
	CLL RAR
	RTR
	DCA XCURHI	/X COORD HI
	TAD BUFPTR
	DCA XCURLO	/X COORD LO
	IAC
	DCA TEMPHI	/DELTA V +,-1
	TAD CURLEN	/CURSOR IS VERT
	DCA CNTR	/LN OF LENGTH
			/=C(CURLEN)
	TAD MAXCUR	/IF Y COORD
	TAD YCUR	/TOO HI CURSOR
	SPA SNA CLA	/IS DIS BELOW
			/SPECTRUM
	JMP CURLOP-1
	CMA		/TOO HI SET
	DCA TEMPHI	/DELTA V TO -1
	TAD YCUR
CURLOP,	TAD TEMPHI
	LINC
	LMODE
	DIS XCORD
	PDP
	PMODE
	ISZ CNTR
	JMP CURLOP
	JMP I .+1
	CURRTN
	LMODE
DSCCHR,	ROL 1		/MULT BY 2
	ADA I		/ADDR IS REL
	GRDTAB-1+2000	/TO GRDTAB
	STC GRDPTR
	ADA I
VCOORD,	0
	DSC I GRDPTR
	DSC I GRDPTR
	LDA I		/MAKE HORIZ
P2,	2		/GAP BET CHARS
	LZE		/2 FOR HALF
	ADD P2		/4 FOR FULL
	ADM
	1
	JMP 0
	PMODE
CURLEN,	KURLEN		/=-LENGTH OF
			/CURSOR
MAXCUR,	-377-KURLEN	/MAX Y COORD
			/FOR CURSOR
			/ABOVE SPECTRUM
M12,	-12
P60,	60
PP400,	400
MM4,	-4
P57,	57
	PAGE
MUL10,	0		/DAC*10+AC
	DCA TEMPLO	/TO DAC
	JMS DSCL	/DAC*2
	TAD DBLLO
	DCA ARGLO	/SAVE
	TAD DBLHI
	DCA ARGHI
	JMS DSCL	/YIELDS
	JMS DSCL	/DAC*8
	JMS I KDADD	/+DAC*2=DAC*10
	DCA ARGHI	/NOW ADD NEW
	TAD TEMPLO	/VAL
	DCA ARGLO
	JMS I KDADD	/=DAC*10+AC
	JMP I MUL10
DSCL,	0		/RAL DAC =DAC*2
	CLA CLL
	TAD DBLLO
	RAL
	DCA DBLLO
	TAD DBLHI
	RAL
	DCA DBLHI
	JMP I DSCL
DCIA,	0		/2S COMP OF DAC
	CLA
	TAD DBLHI
	CMA
	DCA DBLHI
	TAD DBLLO
	CIA
	SNA
	ISZ DBLHI
	DCA DBLLO
	JMP I DCIA
DSCL4,	0		/PACK BCD IN
	DCA TEMPLO	/DAC =ROL 4 +AC
	JMS DSCL	/MOVE 4 LEFT
	JMS DSCL
	JMS DSCL
	JMS DSCL
	TAD DBLLO
	TAD TEMPLO
	DCA DBLLO
	JMP I DSCL4
UPACK,	0		/UNPACK DAC
	STA CLL RTL	/PUT IN INITAB
	DCA TEMPLO	/5 VALS 3 IN
	JMP .+4		/DBLLO
			/2 IN DBLHI
PCKLOP,	RTR		/NXT VAL
	RTR		/TO LOW 4 BITS
	DCA DBLLO	/UPDATE
	TAD DBLLO
	AND P17
	DCA I INIPTR	/1 VAL TO TABLE
	TAD DBLLO
	ISZ TEMPLO	/DONE ?
	JMP PCKLOP	/NO
	CLA
	TAD DBLHI	/LAST VALS
	AND P17
	DCA I INIPTR
	TAD DBLHI
	RTR
	RTR
	AND P17
	DCA I INIPTR
	DCA DBLLO	/CLR DAC
	DCA DBLHI
	JMP I UPACK
P17,	17
CHKSWI,	0		/SEE IF TISA
	TAD HSWPTR	/HAS HALTED
	DCA BETA2	/ANY DEVS
	TAD DEVNUM	/-NUM DEFINED
	DCA CNTR
CHKLOP,	TAD I BETA2
	SPA		/TISA HALT ?
	JMP BYHLT	/NO
	DCA TEMP	/HLT MESS
	JMS I KHLTMS	/TO QUE
	CMA		/CLR SWIT
	DCA I BETA2
BYHLT,	CLA
	ISZ BETA2
	ISZ CNTR
	JMP CHKLOP
	JMP I CHKSWI
HSWPTR,	HSWIT0
	PAGE
			/FRESH START
			/CLR BUFFER
			/INIT ALL ARGS
FRSTR,	0
	CLA		/PUT 0S FROM
	TAD MINADR	/MINCDF,MINADR
	DCA ARGLO	/TO MAXCDF,7777
	TAD MINCDF
	DCA CURCDF
CLRLOP,	JMS I KSET	/SET CDF
	DCA I ARGLO	/A 0 TO BUFER
	ISZ ARGLO	/DONE FIELD ?
	JMP .-2		/NO
	ISZ CURCDF	/ADV FLD
	TAD CURCDF
	CIA
	TAD MAXCDF
	SMA CLA		/FINI ?
	JMP CLRLOP	/NO
	CDF 0		/RESET FLD
	DCA BCNTR	/DEV COUNT
	TAD MINADR	/1ST AVAIL
	DCA LSSALO	/BUF ADDR
	TAD MINCDF
	DCA LSSAHI	/=SA DV 0
	TAD KINI
	DCA LSINI
	TAD KENC	/SA ENC TABLE
	DCA LSENC
	JMP I FRSTR
			/INIT ARGS FOR
			/CURRENT DEVICE
RESTR,	0
	CLA
	TAD BCNTR	/=NUM OF
			/DEFINED DVS
	DCA CNTR
	TAD LSSALO	/SA CURN DV
	DCA CURNLO
	TAD LSSAHI
	DCA CURNHI
	TAD LSINI	/PTR TO INITAB
	DCA INIPTR	/CURN DV
	TAD LSENC
	DCA ENCPTR
	DCA DBLLO
	DCA DBLHI
	TAD P4060	/CURN DV NUM
	TAD CNTR	/TO QA TXT FLD
	DCA I KTXT26
	JMP I RESTR
			/INIT ARGS NXT
			/DV REVERSE OF
			/RESTR
NXSTR,	0
	CLA
	TAD CNTR
	DCA BCNTR
	TAD CURNLO
	DCA LSSALO
	TAD CURNHI
	DCA LSSAHI
	TAD INIPTR
	DCA LSINI
	TAD ENCPTR
	DCA LSENC
	JMP I NXSTR
KSET,	SETCDF
INILEN,	INISTR-INIEND-1
LSSALO,	0
LSSAHI,	0
LSINI,	0
KENC,	ENCVAL
LSENC,	0
P4060,	4060
KTXT26,	TXT2+6
KADR,	INIAD-1
CLKCNT,	-2
CLKMOD,	4100
ENCVAL,	0040		/ENABLE CHAN 1
	0010		/"         " 2
	0002		/"         " 3
	0		/MUST HAVE 0
			/HERE
QADUN,	CLA		/DONE SETUP
	TAD CNTR	/NUM OF DEV
	CIA
STRRDE,	DCA DEVNUM
	TAD DEVNUM
	DCA I KLAST	/VERY LAST
			/ENTRY IN
			/TABLE
	TAD DEVNUM
	DCA CNTR	/TRANSFER ALL
	TAD KINI	/INITIAL VALS
	DCA INIPTR
	TAD KADR
	DCA ADPTR
LOP1,	TAD INILEN
	DCA BCNTR
LOP2,	TAD I ADPTR	/1 ADDR
	DCA TEMP	/SAVE
	TAD I INIPTR	/1 VAL
	DCA I TEMP	/STORE
	ISZ BCNTR	/DONE A DEV ?
	JMP LOP2	/NO
	ISZ CNTR	/DONE ALL ?
	JMP LOP1
	TAD CLKCNT	/SET CLOCK FOR
	CLAB		/2 MS COUNT
	CLA		/SET 1MS TICK
	TAD CLKMOD	/AND INTERRUPT
	CLLR		/ON OVERFLOW
	CLA
	DCA QUECNT	/SET TTY QUE
	TAD KSTRQ	/PTRS AND CNT
	DCA QUEIN
	TAD KSTRQ
	DCA QUEOUT
	CMA
	DCA MODE	/SET A/D MODE
	TAD K210	/PUT CNTRL H
	DCA KBDBUF	/IN KEYBRD BUF
	DCA TTYFLG	/SET TTY FOR
	TAD KTTY	/NOT BUSY
	DCA ADMESS	/NO MESSAGES
	ION		/HANG IN IDLE
	JMS I KIDLE	/LOOP TISA WILL
	JMP .-1		/IMMEDIATELY
KTTY,	TTYFLG		/SWITCH INTO
K210,	210		/PAUSE MODE
KSTRQ,	STRQUE
/TISA P1
	SAVSYM 2