.TITLE	KIM-1 ENHANCEMENT PROM ... THIS IS PUBLIC DOMAIN
;
;
; It looks like it is by Rene Vega of Detroit September 1976
;
;	THE CODE HEREIN IS RENDERED PUBLIC DOMAIN
;	WITH THE RESTRICTION THAT ALL CREDITS MUST
;	REMAIN IN ANY SOURCE COPIES.
;
;	CONVERTED TO ASM BY RICHARD CINI, 5/20/2016
;	AND MADE CHANGES TO COMPILE UNDER TASM/TASM64.
;
;
;	SYSTEM EQUATES...
;
AK	.EQU	$1EFE
AK0	.EQU	$1F3D
NMIT	.EQU	$1C1C
IRQT	.EQU	$1C1F
GETKEY	.EQU	$1F6A
SCANDS	.EQU	$1F1F
DISPZ	.EQU	$185C
DISPF	.EQU	$1929
VEB	.EQU	$17EC
INTVEB	.EQU	$1932
UPAD	.EQU	$1702		; USER PIA A SIDE DATA.
UPBD	.EQU	$1702
UPBDD	.EQU	$1703
SAD	.EQU	$1740
PADD	.EQU	$1741
SBD	.EQU	$1742
PBDD	.EQU	$1743
CLK1T	.EQU	$1744
CLK8T	.EQU	$1745
CLK64T	.EQU	$1746
CLKKT	.EQU	$1747
CLKRDI	.EQU	$1747
CLKRDT	.EQU	$1746
SAL	.EQU	$17F5
SAH	.EQU	$17F6
EAL	.EQU	$17F7
EAH	.EQU	$17F8
ID	.EQU	$17F9
INCVEB	.EQU	$19EA
CHKL	.EQU	$17E7
CHKH	.EQU	$17E8
CHKHI	.EQU	$F6
CHKSUM	.EQU	$F7
INL	.EQU	$F8
INH	.EQU	$F9
POINTL	.EQU	$FA
POINTH	.EQU	$FB
TEMP	.EQU	$FC
TMPX	.EQU	$FD
CHAR	.EQU	$FE
MOIDE	.EQU	$FF
CHKT	.EQU	$194C
PCL	.EQU	$EF
PCH	.EQU	$F0
PREG	.EQU	$F1
SPUSER	.EQU	$F2
INITS	.EQU	$1E88
GETCH	.EQU	$1E5A
OUTCH	.EQU	$1EA0
DETCPS	.EQU	$1C2A
SAVX	.EQU	$17E9
CURDIG	.EQU	$E8		; CURRENT DIGIT FOR NXTDIG RTN.
LEDS	.EQU	$E9		; SIX DIGITS E9 TO EE.
INCPT	.EQU	$1F63
TABLE	.EQU	$1FE7
START	.EQU	$1C4F
PACKT	.EQU	$1A00
;
;	GIO VECTOR EQUATES
;
TTYIN	.EQU	$1780
TTYOUT	.EQU	$1783
TTYSYN	.EQU	$1786
TAPIN	.EQU	$1789
TAPOUT	.EQU	$178C
TAPSYN	.EQU	$178F
LOADER	.EQU	$1792
DUMPER	.EQU	$1795
VUTAPE	.EQU	$1798
CMPTAP	.EQU	$179B
ERROR	.EQU	$179E
X2SEG7	.EQU	$17A1
DSPLED	.EQU	$17A4
NPUL	.EQU	$17A7
TIMG	.EQU	$17AB
;
;
;
;	THE FOLLOWING ROUTINES MAY BE ENTERED VIA THE
;	"GO" KEY ON THE KEYPAD.
;
;	FC00 - SUPRTP - KIM CASSETTE HIGH SPEED DUMP.
;	FE3B - COMPTP - ROUTINE TO COMPARE A KIM FORMAT
;			CASSETTE WITH CONTENTS OF MEMORY.
;	FE46 - VIEWTP - ROUTINE TO LOOK AT A KIM FORMAT
;			CASSETTE WITHOUT ALTERING MEMORY.
;	FE4F - LOADTP - ROUTINE TO LOAD A BLOCK IN KIM
;			AUDIO CASSETTE FORMAT.
;	FCEA - LDSYS  - ROUTINE TO LOAD MULTIPLE BLOCKS
;			INTO MEMORY REGARDLESS OF THE ID
;			NUMBERS ON THE TAPE. UPON LOADING A
;			BLOCK THAT BEGINS AT $EF, THE
;			ROUTINE JUMPS TO ($EF).
;
;
;
;
;
	.ORG	$FC00
;
;	THIS IS SUPERTAPE! FAST FUMP ROUTINE.
;	FROM JIM BUTTERFIELD, TORONTO -- OCT 1976
;
;	THE TAPE  IMPUT ROUTINES AND LED DRIVER RTNS
;	ARE COURTESY OF TOM MARCHANT, DETROIT -- AUG76
;
;	THE REST OF THE STUFF IS MINE
;	BENE' VEGA, DETROIT -- SEP76
;
;
SUPRTP	JSR	DUMPT		;CALL SUPERTAPE! ROUTINE.
	JMP	DISPZ		;PUT ZEROES IN DISP AND  QUIT.
;
DUMPT	CLD
	JSR	MTRON		;TURN ON CASSETTE MOTOR.
	LDA	#$AD		;OPCODE LDA.
	STA	VEB
	JSR	INTVEB		;SET UP VEB
	LDA	#$27
	STA	SBD		;SET OUTPUT PORT BIT7
	LDA	#$BF
	STA	PBDD		;OPEN THE CHANNELS.
	LDX	#100		;SEND 100...
	LDA	#$16		;...SYN CHARS.
	JSR	HIC
	LDA	#$2A		;SEND ASTERISK.
	JSR	TAPOUT
	LDA	ID
	JSR 	OUTBT		;THEN THE ID.
	LDA	SAL
	JSR	OUTBTC		;START ADDR LOW.
	LDA	SAH
	JSR	OUTBTC		;START ADDR HIGH.
DUMPT4	JSR	VEB		;GET DATA BYTE.
	JSR	OUTBTC		;AND SEND IT.
	JSR	INCVEB		;TO THE NEXT ADDRESS.
	LDA	VEB+1
	CMP	EAL
	LDA	VEB+2
	SBC	EAH
	BCC	DUMPT4		;MORE TO DUMP.
	LDA	#$2F		;SEND / (END OF DATA.)
	JSR	TAPOUT
	LDA	CHKL
	JSR	OUTBT
	LDA	CHKH		;SEND CHECKSUM BYTES.
	JSR	OUTBT
	LDX	#2		;SEND TWO...
	LDA	#$04		;EOT CHARS.
	JSR	HIC
	JSR	MTROFF		;MOTOR OFF.
	RTS			;DONE....
;
;
HIC	STX	TEMP		;COUNT
HIC1	PHA
	JSR	TAPOUT		;SEND CHAR.
	PLA			;...AND BRING IT BACK
	DEC	TEMP
	BNE	HIC1		;SEND IT AGAIN.
	RTS
;
;
OUTBTC	JSR	CHKT		;COMPUTE CHECKSUM.
OUTBT	PHA			;SAVE THE CHAR.
	LSR	A
	LSR	A
	LSR	A
	LSR	A		;GET TOP NYBBLE.
	JSR	HEXOUT		;WRITE THEM IN EXTERNAL HEX.
	PLA
;
;
HEXOUT	AND	#$0F		;CLEAN OUT TOP NYBBLE.
	CMP	#$0A		;CHANGE TO ASCII BY...
	CLC			;ADDING
	BMI	HEX1
	ADC	#$07		;$37 IF A TO F.
HEX1	ADC	#$30		;$30 IF NUMERIC.
	JMP	TAPOUT
OUTCHT	LDY	#8		;FOR THE EIGHT BITS TO SEND.
	STY	TMPX
TRY	LDY	#2		;SEND THREE UNITS...
	STY	CHAR		;STARTING AT 3600 HERTZ.
ZON	LDX	NPUL,Y		;NUMBER OF HALF CYCLES.
	PHA			;SAVE CHAR
ZON1	BIT	CLKRDI		;WAIT FOR PREVIOUS OP TO
	BPL	ZON1		;COMPLETE.
	LDA	TIMG,Y		;GET THE TIME TO THE...
	STA	CLK1T		;...NEXT PULSE ($7E OR $CE)
	LDA	SBD
	EOR	#$80		;TOGGLE OUTPUT PORT.
	STA	SBD
	DEX			;HAVE WE SENT ALL THE CYCLES?
	BNE	ZON1		;NOPE, SEND ANOTHER ONE.
	PLA			;GET BACK THE CHAR.
	DEC	CHAR		;DECR UNIT COUNT.
	BEQ	SETZ
	BMI	ROUT		;NONE LEFT? QUIT.
	LSR	A		;GET NEXT BIT.
	BCC	ZON		;...AND IF IT'S A ONE...
SETZ	LDY	#0		;SWITCH TO 2400 HERTZ.
	BEQ	ZON		;UNCONDITIONAL BRANCH
ROUT	DEC	TMPX		;ONE LESS BIT.
	BNE	TRY		;ANY MORE? GO BACK.
	RTS
;
;	FREQUENCY/DENSITY CONTROLS
;	ARE IN THE TRANSFER VECTOR AREA.
;
;
;
;	ENTER HERE VIA RESET INTERRUPT.
;
RSTINT	LDX	#$FF
	TXS			;INIT STACK PTR.
	STX	SPUSER		;INIT USER'S STACK PTR.
	JSR	INITS		;SSYTEM INITIALIZATION.
	PHP			;GET CLEAN PROC REG.
	PLA
	STA	PREG		;INIT USER'S PREG.
	LDX	#7
INITM	LDA	ITBL-1,X	;INITIALIZE INT VECTORS.
	STA	$17F8,X
	DEX
	BNE	INITM
;
;	INITIALIZE GENERAL I/O VECTORS.
;
	LDX	#JTBLL
INITGV	LDA	JTBL-1,X
	STA	$1780-1,X
	DEX
	BNE	INITGV
;
;	NOW GO LOAD STUFF UNTIL SPECIAL E-O-F
;	RECORD IS DETECTED. BRANCH TO RTN.
;
LDSYS	LDA	#0		;SET ID=0
	STA	ID		;WANT ANY LOADER RECORDS.
	JSR	LOADER
	BCS	SYSERR
	LDA	#PCL		;SPECIAL E-O-F RECORD?
	CMP	SAL
	BNE	LDSYS		;-NO- KEEP LOADING.
	LDA	SAH		;CHECK FOR $00.
	BNE	LDSYS		;-NO- KEEP LOADING.
;
;	IS SPECIAL LOAD RECORD. PCL, PCH HAVE
;	ADDRESS TO JUMP TO PROGRAM.
;
	JMP	(PCL)		;...AND WE'RE OFF!
SYSERR	JSR	ERROR		;SYSTEM LOAD ERROR. DISPLAY IT.
	BNE	RSTINT		;UPON RETURN DO A SYSTEM RESET.
;
;
ITBL	.DB	0		;ID=0 $17F9
	.DW	$1C00		;NMI INT.
	.DW	$1C22		;PSEUDO RESET.
	.DW	$1C00		;IRQ INT.
;
;	THIS IS JUMP VECTOR TBL FOR GENERAL I/O
;	STUFF. IT IS PLACED AT $1780
;
JTBL	JMP	GETCH		;INPUT TTY.
	JMP	OUTCH		;OUTPUT TTY.
	JMP 	DETCPS		;INIT TTY.
	JMP	RDCHT		;INPUT TAPE.
	JMP	OUTCHT		;OUTPUT TAPE.
	JMP	SYNT		;INIT TAPE.
	JMP	LOADT		;LOAD A TAPE.
	JMP	DUMPT		;DUMP TO A TAPE.
	JMP	VUTP		;VIEW A TAPE.
	JMP	CMPTP		;COMPARE A TAPE WITH MEM.
	JMP	LDERR		;DISPLAY ERROR.
	JMP	X2SEG		;CONVERT HEX TO 7SEG CODE.
	JMP	NXTDIG		;ACTIVATE LED DISPLAY.
VNPUL	.DB	2		;TWO PULSES = ONE CYCLE.
VTIMG	.DB	$C3,$03,$7E	;SUPERTAPE! TIMINGS.
JTBLL	.EQU $-JTBL		;LENGTH OF THIS
;
;	SUBROUTINE TO SYNCHRONIZE TO A TAPE.
;
SYNT	JSR	SETDSP		;SET UP INITIAL DSP MSG.
;
;	LOOK FOR SYN CHARS.
;
	LDA	#$FF
	STX	SAVX
SYNT2	LDA	#$07
	STA	SBD		;PB5=0 (DATAIN)
SYNT3	JSR	RDBIT
	BMI	SYNT4		;HAVE ONE.
	BNE	SYNT2		;HAVE NOTHING.
;				;HAVE ZERO.
SYNT4	LSR	SAVX		;SHIFT INTO WINDOW.
	ORA	SAVX
	STA	SAVX
	CMP	#$16		;HAVE SYN?
	BNE	SYNT3		;-NO- KEEP LOOKING.
	LDA	#0		;SYN COUNT=0
	STA	POINTL
	LDX	#4
SYNT5	LDA	SYNMSG-1,X	;PUT "SYN" IN DISPLAY.
	STA	LEDS-1,X
	DEX
	BNE	SYNT5
SYNLK	INC	POINTL		;BUMP SYN COUNT.
	LDA	POINTL
	JSR	X2SEG		;HEX TO 7SEG DISP.
	STX	LEDS+5-1	;HIGH DIGIT.
	STA	LEDS+6-1	;LOW DIGIT.
	JSR	RDCHT
	CMP	#$16		;HAVE SYN STILL?
	BEQ	SYNLK		;-YES- KEEP LOOKING.
	RTS			;-NO- AM DONE.
;
LDMSG	.DB	$B8,$BF,$F7,$DE,$80,$80		;LOAD
CMPMSG	.DB	$B9,$BF,$D4,$F3,$80,$80		;COMP
VUMSG	.DB	$B8,$BF,$BF,$FA,$80,$80		;LOOK
ERRMSG	.DB	$F9,$D0,$D0,$DC,$D0,$80		;ERROR
CERMSG	.DB	$BF,$BF,$F3,$ED,$80,$80		;OOPS
SYNMSG	.DB	$ED,$EE,$B7,$C0			;SYN-
;	SUBROUTINE TO SET UP DISPLAY MESSAGE IN
;	DISPLAY BUFFER.
;
SETDSP	LDY	#5
SD2	LDA	(INL),Y
	STA	LEDS,Y
	DEY
	BPL	SD2
	RTS
;
;
;
;	SUBROUTINE TO READ A BIT OFF TAPE.
;
RDBIT	BIT	SBD		;GOT SOMETHING?
	BMI	RDGS		;-YES- JUMP.
	JSR	NXTDIG		;GO LIGHT UP DISPLAY
	LDA	CLKRDT		;IS THIS TAKING TOO LONG?
	BMI	RDBIT		;-NO- KEEP LOOKING.
RDBTNO	LDA	#1		;INDICATE WE SEE NOTHING.
	RTS			;QUIT
;
;	CALC DUTY CYCLE OF INPUT. MEANWHILE
;	RUN THE DISPLAY.
;
RDGS	LDY	CLKRDT
	LDA	#$FF
	STA	CLK64T
RDKL	JSR	NXTDIG		;BLINK,BLINK
	LDA	CLKRDT
	BPL	RDBTNO		;FALSE START.
	BIT	SBD
	BMI	RDKL		;KEEP LOOKING...
	TYA	
	JMP $1A58	;THAT'S RDBIT2+5...
;
;
;	ROUTINE TO READ ONE CHAR FROM TAPE.
;	CHAR RETURNED IN A.
;
RDCHT	STX	SAVX+2
	LDX	#8		;READ 8 BITS.
RDCH2	JSR	RDBIT		;GET NEXT BIT.
	BMI	RDCH3
	BEQ	RDCH3
	SEC			;DROPOUT?
	RTS
RDCH3	LSR	SAVX+1
	ORA	SAVX+1
	STA	SAVX+1
	DEX			;MORE BITS TO READ?
	BNE	RDCH2		;-YES- GO GET THEM, SILLY.
	LDA	SAVX+1
	ROL	A
	LSR	A		;CLEAR OUT PARITY BIT.
	LDX	SAVX+2
	CLC
	RTS
;
;
;	SUBROUTINE TO CONVERT NUMBER TO 7-SEG CODE.
;
X2SEG	PHA
	LSR	A
	LSR	A
	LSR	A
	LSR	A		;GET FIRST DIGIT.
	TAY
	LDX	TABLE,Y		;CONVERT.
	PLA
	AND	#$0F		;GET SECOND DIGIT.
	TAY
	LDA	TABLE,Y
;
;
;	FIRST DIGIT IN X, SECOND IN A.
;
	RTS
;
;
;	SUBROUTINE TO LIGHT UP DISPLAY.
;	EACH CALL LIGHTS UP ANOTHER DIGIT.
;
NXTDIG	PHA
	TXA
	PHA			;SAVE A AND X.
	LDA	#$1E
	ORA	PBDD
	STA	PBDD
	LDA	#0
	STA	SAD		;TURN OFF WHAT WAS ON.
	LDA	#$7F
	STA	PADD		;MAKE OUTPUT
	LDX	CURDIG		;GET CURRENT DIGIT #.
	BMI	NDRST		;RESET.
	CPX	#9		;TOO BIG?
	BPL	NDRST		;-YES- RESET.
	CPX	#4
	BPL	NDOIT
NDRST	LDX	#3
NDOIT	INX
	TXA
	STA	CURDIG
	ASL	A
	STA	SBD		;SELECT DIGIT.
	LDA	LEDS-4,X
	STA	SAD		;LIGHT THEM UP.
	PLA
	TAX
	PLA			;RESTORE REGS.
	RTS
;
;
;	THIS IS A MODIFIED VERSION OF THE KIM-1(TM)
;	AUDIO CASSETTE LOAD ROUTINES. THIS VERSION
;	IS SUBROUTINE CALLABLE.  UPON RETURN, THE
;	CARRY FLAG IS CLEAR IF LOADED OK. IT'S
;	SET IF LOADING ERROR OCCURRED.
;	IN ADDITION, SAL,SAH ARE SET TO THE LOAD
;	POINT.
;
COMPTP	JSR	PUSHME
	JSR	CMPTP		;CALL TAPE/MEM COMPARE RTN.
	BVS	LDCERR		;COMPARE ERROR.
	BCS	LDERR
	RTS			;DO IT AGAIN.
;
;
VIEWTP	JSR	PUSHME
	JSR	VUTP		;CALL TAPE VIEW SUBROUTINE.
	BCS	LDERR
	RTS
;
;
LOADTP	JSR	PUSHME
	JSR	LOADT		;CALL LOAD SUBROUTINE.
	BCS	LDERR		;CARRY SET=ERROR.
LDOK	LDA	SAL
	STA	POINTL
	LDA	SAH
	STA	POINTH		;SET PC TO LOAD POINT.
	PLA
	PLA
	JMP	START
LDERR	LDA	#0-ERRMSG/256*256+ERRMSG
	STA	INL
	LDA	#ERRMSG/256
	STA	INH
	BNE	LDE2
;
LDCERR	LDA	#0-CERMSG/256*256+CERMSG
	STA	INL
	LDA	#CERMSG/256
	STA	INH
LDE2	JSR	SETDSP		;SET UP MSG.
LDERLP	JSR	NXTDIG
	DEX
	BNE	LDERLP		;LIGHT UP DISPLAY.
	LDX	#$01		;PREVENT GHOSTING.
	JSR	AK0		;ANY KEYS PRESSED?
	BEQ	LDE2		;-NO- CONT. ERR DISPLAY.
	RTS			;-YES- DONE.
;
;	THIS IS ENTERED VIA THE JMP IN THE VEB
;	WHEN CMPTP SUBR IS CALLED.
;
VEBCMP	BNE	CMPERR		;-NE- MISMATCH OCCURRED.
	JMP	VEBRET		;-EQ- TAPE=MEM, SO KEEP LOOKING.
CMPERR	JSR	SCANDS		;TURN OFF DISP.
	BIT	NMIT+1		;SET OVERFLOW FLAG.
	RTS			;QUIT. MISMATCH AT (VEB+1)
;
;
CMPTP	LDA	#0-VEBCMP/256*256+VEBCMP
	STA	VEB+4
	LDA	#VEBCMP/256
	STA	VEB+5		;WANT CONTROL TO TEST COND.
	LDA	#0-CMPMSG/256*256+CMPMSG
	STA	INL
	LDA	#CMPMSG/256
	STA	INH		;ADDRESS OF COMP MSG.
	LDA	#$CD		;CMP OPCODE.
	STA	VEB
	BNE	LDT3		;DIVE INTO LOAD CODE.
;
;
VUTP	LDA	#0-VUMSG/256*256+VUMSG
	STA	INL
	LDA	#VUMSG/256
	STA	INH		;ADDRESS OF "LOOK" MSG.
	LDA	#$AD		;LDA OPCODE.
	BNE	LDT2		;UNCONDITIONAL
;
;
LOADT	LDA	#0-LDMSG/256*256+LDMSG
	STA	INL
	LDA	#LDMSG/256
	STA	INH		;ADDRESS OF "LOAD" MSG.
	LDA	#$8D		;STA OPCODE.
LDT2	STA	VEB
	LDA	#0-VEBRET/256*256+VEBRET
	STA	VEB+4
	LDA	#VEBRET/256
	STA	VEB+5
LDT3	CLD
	JSR	MTRON		; MOTOR ON.
	JSR	INTVEB
	LDA	#$4C		;JMP OPCODE.
	STA	VEB+3
;
LDSYN	JSR	TAPSYN		;SYNC ONTO TAPE.
	CMP	#$2A		;HAVE START CHAR?
	BNE	LDT3		;-N- HMMM...TRY AGAIN.
;
;	GET ID OFF TAPE AND CHECK WITH ID REQUESTED.
;
	JSR	RDBYT		;READ ID FROM TAPE.
	PHA
	JSR	X2SEG		;SEUP TO DISP ID.
	STX	LEDS+5-1
	STA	LEDS+6-1
	PLA
	PHA			;UMM... YOU'LL SEE WHY LATER.
	CMP	ID		;THIS IT?
	BEQ	LDGB		;-YES- THIS IS GOOD BLOCK
	LDA	ID		;ID=0, READ ANY BLOCK?
	BEQ	LDGB		;-YES- USE THIS BLOCK
	CMP	#$FF		;ID=FF, IGNORE LOAD POINT FROM TAPE?
	BEQ	LDSP		;-YES- SPECIAL LOAD.
	PLA			;CLEANUP.
	JMP	LDT3		;GO TRY NEXT BLOCK.
;
;	GET LOAD POINT FROM TAPE  AND SAVE.
LDGB	JSR	RDBYT		;GET SAL.
	JSR	CHKT		;CHECKSUM TIME...
	STA	VEB+1
	STA	SAL
	JSR	RDBYT
	JSR	CHKT
	STA	VEB+2
	STA	SAH
	JMP	SVID		;GO LOAD.
;
;	USE LOAD POINT FROM SAL,SAH.
;
LDSP	JSR	RDBYT		;SAL, IGNORE.
	JSR	CHKT
	JSR	RDBYT
	JSR	CHKT
;
SVID	PLA			;GET ID READ FROM TAPE BACK.
	STA	ID		;...AND SAVE IT ID FIELD.
;
;	LOAD THE BLOODY THING IN.
;
;
;	SETUP VEB ADDR FOR DISPLAY.
;
LDIT	LDA	VEB+2
	JSR	X2SEG
	STX	LEDS+1-1
	STA	LEDS+2-1
	LDA	VEB+1		;ADL.
	JSR	X2SEG
	STX	LEDS+3-1
	STA	LEDS+4-1
;
;
	LDX	#2
LDIT2	JSR	TAPIN
	CMP	#$2F		;HAVE /? EOT.
	BEQ	LDCHK		;-YES- DO CHECKSUM COMPARE.
	JSR	PACKT
	BNE	LDGERR		;GOT ERROR
	DEX
	BNE	LDIT2
	JSR	CHKT
	JMP	VEB
VEBRET	JSR	INCVEB
	JMP	LDIT
;
;	CHECKSUM COMPARE.
;
LDCHK	JSR	RDBYT
	CMP	CHKL
	BNE	LDGERR
	JSR	RDBYT
	CMP	CHKH
	BNE	LDGERR
	JSR	SCANDS		;THIS IS JUST TO TURN OFF DISP.
				;IN CASE THIS WAS A SUBR CALL.
;
;	SETUP EAL, EAH.
;
	LDX	#1
STEA	LDA	VEB+1,X
	STA	EAL,X
	DEX
	BPL	STEA
;
;
	JSR	MTROFF
	CLC
	CLV
	RTS
LDGERR	JSR	SCANDS
	JSR	MTROFF
	SEC
	CLV
	RTS
;
;
;	SUBROUTINE TO READ TWO CHARS FROM TAPE
;	AND PACK THEM INTO ONE.
;
RDBYT	JSR	TAPIN
	JSR	PACKT
RDBYT2	JSR	TAPIN
	JSR	PACKT
	RTS
;
;
;	SUBROUTINE TO PUSH CALLING ADDR ON STACK.
;
PUSHME	PLA
	TAX
	SEC
	SBC	#3		;RESET TO POINT TO JSR
	TAY
	PLA
	STA	PCH
	SBC	#0
	PHA
	TYA
	PHA
	LDA	PCH
	PHA
	TXA
	PHA
	RTS
;	MOTOR CONTROL ROUTINES.
;	PB3 OF THE APPLICATION PIA IS THE MOTOR CONTROL PIN.
;	0-MOTOR ON  1-MOTOR OFF.
;
MTRON	JSR	MTRSET
	LDA	UPBD
	AND	#%11110111		;PB3=0
	STA	UPBD
	RTS
;
MTROFF	JSR	MTRSET
	LDA	UPBD
	AND	#%00001000		;PB3=1
	STA	UPBD
	RTS
;
MTRSET	LDA	UPBDD			;DATA DIRECTION.
	ORA	#%00001000		;MAKE OUTPUT.
	STA	UPBDD
	RTS
;
;
;
;
	.ORG	$FFFA
	.DW	NMIT
	.DW	RSTINT
	.DW	IRQT
	.END

; JOB NO. 670406	WAYNE STATE UNIVERSITY  -  M T S 			18:17.20    THU JUN 09/77
