	.title SYM-1 Interface routines for the Commodore 1541 Disk drive V1.0
	;
	; Ronald A. Jordan 
	;
	.org	$7000
	
disk.chr	=	$F8 		; disk input chr build	
bit.cnt		=	$F9		; disk bit count
status		=	$FC		; disk routine status
cmd.chr		=	status	
eoi.flg		=	$FD		; disk eoi flag
curad		=	$FE		; current address
	;
fname		=	$135		; file name
df.chr		=	$153		; deferred character
fn.len		=	$154		; file name lenght
	
	; monitor routines
usrent		=	$8035
ermsg		=	$8171
pshove		= 	$8208
ascnib		= 	$8275
incp3		=	$8293
p2scr		=	$829C
inccmp		=	$82B2
space		=	$8342
instat		=	$8386
crlf		=	$834D
execute		=	$8855
inchr		=	$8A1B
outchr		=	$8A47
intchr		=	$8A58
tout		=	$8AA0
access		=	$8B86
	;
	; defines
	;
skip2		=	$2c
	;
	; system RAM 
	;
rae.setupv	=	$A600		; RAE setup vector
bas.coldv	=	$A603		; BAS cold start vector
new.ursv	=	$A606		; new MON USR vector
new.outv	=	$A609		; new CHR out vector
new.inv		=	$A60C		; new CHR in vector
new.dcv		=	$A610		; new RAE DC vector
acc.vec		=	$A613		; common access vector
j0.vec		=	$A620		; basic cold start
j4.vec		=	$A628		; RAE warm start
j5.vec		=	$A62A		; RAE cold start
df.flg		=	$A62E		; serial deferred flag
sa.cmd		=	$A62F		; secondary address/command
scra		=	$A63A
disk.dev	=	$A647		; disk device number
appflg		=	$A648		; append flag
parnr		=	$A649
p3		=	$A64A
p2		=	$A64C
p1		=	$A64E
c.dev		=	p1
techo		=	$A653
toutfl		=	$A654
lastcmd		=	$A657
invec		=	$A660
outvec		=	$A663
ursvec		=	$A669
	;
	; serial bus VIA references
	;
via1ddra	=	$A003		; VIA #1 data direction - port A 
via1t2l		=	$A008		; VIA #1 timer 2 low order
via1t2h		=	$A009		; VIA #1 timer 2 high order
via1pcr		=	$A00C		; VIA #1 peripheral ctl register
via1ifr		=	$A00D		; VIA #1 interrupt flag register
via1dra		=	$A00F		; VIA #1 port A, no handshake

	;
	; jump tables
	;
		JMP start
	;
	; system vectors
	;
loadv		jmp	load
savev		jmp	save
diskcmdv	jmp	disk.cmd
diskstv		jmp	disk.st
direntv		jmp	dir.entry
getnamev	jmp	get.name
diskclosev	jmp	disk.close
diskopenv	jmp	disk.open
setupviav	jmp	setup.via
	;
	; primitive vectors
	;
talkv		jmp	talk
listenv		jmp	listen
secondv		jmp	second
talksav		jmp	talk.sa
cioutv		jmp	ciout
untalkv		jmp	untalk
unlistenv	jmp	unlisten
acptrv		jmp	acptr
	;
	; initialization routines
	;
start		jsr 	setupviav		; initialize VIA	
		lda 	#8			; 
		sta 	disk.dev		; drive #8 selected
vec.setup	lda	#$4C			; set some jumps
		sta	rae.setupv
		sta 	bas.coldv
		sta	new.ursv
		sta	new.outv
		sta	new.inv
		sta	new.dcv
		sta	acc.vec			; setup common access vec
		lda	#start / $100		; high START address
		sta	acc.vec + 2		; save in common acc. vec
		ldx	#$D1	 		; setip new urs return vec
		lda 	#$81	
		stx	new.ursv + 1
		sta	new.ursv + 2
		ldx  	#new.cmds & $00FF	; patch mon extensions
		lda	#new.cmds / $100
		stx	ursvec + 1
		sta	ursvec + 2
		ldx	#rae.init & $00FF	; set j5 for RAE
		lda	#rae.init / $100
		stx	j5.vec
		sta	j5.vec + 1
		ldx	#rae.setup & $00FF	
		lda	#rae.setup / $100
		stx	rae.setupv + 1
		sta	rae.setupv + 2
		ldx	#rae.warm & $00FF	; set j4 RAE warm start
		lda	#rae.warm / $100
		stx	j4.vec
		sta	j4.vec + 1
		ldx	#bas.init & $00FF	; set j0 for basic
		lda	#bas.init / $100
		stx	j0.vec
		sta	j0.vec + 1
		ldx	#bas.cold & $00FF	; set j0 for basic
		lda	#bas.cold / $100
		stx	bas.coldv + 1
		sta	bas.coldv + 2
		ldx	#0
init.msg	lda	message,X		; output message
		beq	end.msg
		jsr 	outchr
		inx 	
		bne	init.msg		; always, more message
end.msg		rts
		;
		; new commands, vectored via the monitor usrvec
		;
new.cmds	sta	cmd.chr			; save last char
		lda 	lastcmd			; get last command
l2.chk		cmp	#$13			; disk load?
		bne	s2.chk			;  noo, try save
		lda	cmd.chr	
		cmp	#'/'			; name delimiter?
		bne	ext.cmds		; no, error
		jmp 	l2	
	;
s2.chk		cmp	#$1E			; disk save?
		bne	sc.chk			; ..no, try disk cmds
		lda	cmd.chr
		cmp	#'/'
		bne	ext.cmds		; no, error
		jmp	s2
		;
sc.chk		cmp	#$1F			; sc?
		bne	ext.cmds		; no, error
		lda	cmd.chr			; get last char
		cmp	#'/'			; disk command
		bne	st.chk			; no, try status
		jmp	sc
		;
st.chk		cmp	#'!'			; status?
		bne	dir.chk			; no, try directory
		jmp	st
		;
dir.chk		cmp	#'?'			; directory?
		bne	nu.chk			; no, try device #
		jmp	dir
		;
nu.chk		cmp	#'#'			; device #?
		bne	ext.cmds		; no more commands
		jmp	nu
		;
ext.cmds	jmp	new.ursv		; no more commands
		;
		; load from disk (L2 - monitor command
		;
l2		jsr	pshove
		ldx	parnr			; get # parms
		beq	l2.0parm
		cpx	#1			; chk for 1
		beq	l2.1parm		; 1 parm ok
		;
l.error		lda	#$13
		sec				; set error flag
		rts
;
l2.1parm	stx	p3			; set relocate flag non-0
l2.0parm	lda	disk.dev
		sta	c.dev			; device # to p1
		jsr	getnamev		; get file name
			;
			; serial load routines
			;
			;	p1-device number	p2-relocate address (opt)
			;	p3-relocate flag (non-zero = relocate)
			;	fname and fn.len same as in save routines
			;
load		jsr	setupviav 		; unlock ram and set VIA
 		lda	#$F0			; open/load SA
 		jsr	diskopenv		; do disk open
 		bcs	err.rtn			; error
 		lda	#$60			; setup load SA
 		jsr	set.talk		; tell to talk
 		jsr	rcv.pgm			; get program data
 		jsr	untalkv
 		lda	#$E0			; close/load SA
 		jmp	diskclosev
 			;
 			; receive program from serial bus
 			;
rcv.pgm		jsr	acptrv		; start address low
 		sta	curad
 		lda	status		; check for timeout
 		and 	#$02
 		bne	err.rtn		; time out error
 		jsr	acptrv		; start adr high
 		sta	curad + 1
 		lda	p3		; check relocate flag
 		beq	load.byte	; no relocate
 		jsr	p2scr		;e lse use new start adr
 			;
load.byte	lda	#$FD		; turn off time out bit
 		and	status
 		sta 	status
 		lda	via1dra		; is atn still clear
 		and 	#$04
 		beq	atn.err	; some else has atn
 		jsr	acptrv		; get a byte
 		tax
 		lda	status
 		and #$02		; chk for timeout
 		bne	load.byte	; ignore if so
 		txa
 		sta	(curad),Y
 		inc	curad		; next place to store
 		bne	hicur
 		inc	curad +1
hicur		bit	status		; test for eoii
 		bvc	load.byte	; not yet
 		sty	status		; clear status
 		rts
 			;
 			; common error return
err.rtn		lda	status		; use status as err
s.error		sec			; set flag
 		rts
 			;
 			; Attention error
 				;
atn.err		lda	#$20		; invalid atn status
 		jmp	set.st
 			;
 			; save to disk S2 - monitor command
 			;
s2		ldx 	parnr		; number of parameters
 		cpx	#2		; must be 2 parms
 		bne	s.error		; not 2
 		jsr	getnamev	; get name
		jsr	incp3		; bump p3 to end+1
		lda	disk.dev
		sta	c.dev
			;
			; serial save routines
			;
			;	p1 - device number	p2 - start address
			;	p3 - end address +1	name @ fname (max 30 chars)
			;	name lenght @ fn.ln
			;
save		jsr	setupviav
		jsr	p2scr		; start adr to page zero
		lda	#$F1		; open/save SA
		jsr	diskopenv	; disk open
		bcs	err.rtn		; error
		lda	#$61		; setup save SA
		jsr	set.lstn
		jsr	send.pgm	; use common send
		jsr	unlistenv	; tell device we are done
		lda	#$E1		; close/save SA
		jmp	diskclosev
			;
			; send program to serial bus
			;
send.pgm	lda	curad		; start with ADR
		jsr	cioutv
		lda	curad + 1
		jsr	cioutv
			;
save.byte	lda	via1dra
		and	#$04		; check ATN in
		beq	atn.err		;	somebody else has it
		lda	(curad),y	;
		jsr	cioutv
		jsr	inccmp		; bump to next byte
		bne	save.byte	; loop, mote to do
		rts
			;
			; send disk command SC / - mon command
			;
sc		cpx	#0		; only 0 parm
		bne	s.error		; 
		lda	disk.dev
		sta	c.dev
		jsr	getnamev
disk.cmd	lda 	#$FF		; open command channel
		jsr 	diskopenv
		bcs	s.error
		lda	#$EF		; close command channel
		jsr	diskclosev
		bcs	s.error
		rts			; good return
			;
			; read error/status channnel SC ! - MON command
			;
			; does not open/close CMD channel as C64 wedge
			;
st		cpx	#0
st.err		bne	s.error		; only 0 allowed
		lda	disk.dev
		sta	c.dev
disk.st		lda	#fname & $00FF	; set adr to receive
		sta	curad
		lda	#fname / $100
		sta	curad + 1
		lda	#30		; 30 chrs max
		sta	fn.len
		lda	#$6F		; use command channel
		jsr	rcv.line
		bcs	s7.rts		; return with carry set
		ldy	#0		; output status received
		jsr	crlf		; start on next line
st.lp		lda	(curad),y
		jsr	outchr
		iny
		cpy	fn.len		; to end
		bne	st.lp		; more chars to output
		clc
s7.rts		rts
 		;
 		; receive line into (curad)
 		; until
 		;	1) a CR
 		;	2) EOI
 		;	3) fn.len chars received
 		; fl.lng returned with cars received
 		;
rcv.line	jsr	setupviav	; setup via
 		ldy 	#0		; clear status
 		sty 	status
 		jsr	set.talk
 		bne	rcv.err		; bad status
rc.chr		jsr	acptrv		; get a chr
 		sta	(curad),y	; store it
 		cmp	#$0D		; CR?
 		beq	rcv.end		; normal end
 		iny			; count chr
 		cpy	fn.len		; to max?
 		beq	rcv.end
 		lda	status		; chk status
 		beq	rc.chr		; normal, loop
 		cmp	#$40		; eoi only?	
 		beq	rcv.end		; normal end
rcv.err		jmp	err.rtn		; load ST and return with carry
rcv.end		sty	fn.len		; store returned length
 		jsr	untalkv		; done
 		clc
 		rts
 		;
 		; load/display directory SC ? - MON command
 		;
dir		cpx	#0
dir.err		bne	st.err	; only 0 allowed
 		lda	disk.dev
dir.entry	sta 	c.dev		; RAE and BAS direct start
 		lda	#'$'		; directory name				
 		sta	fname
 		ldx	#1
 		stx	fn.len		; name length = 1 chr
 		lda	#$F0		; 'load'SA
 		jsr	diskopenv	
 		bcs	s7.rts		;	return with carry set
 		lda	#$60
 		jsr	set.talk	; tell disk to talk
 		;
 		jsr	crlf
 		lda	#0
 		sta	status
 		ldy	#3
dir.line	sty	fn.len
 		jsr	acptrv
 		sta	fname
 		jsr	acptrv
 		sta	fname + 1
 		lda	status
 		bne	eoi.chk
 		ldy	fn.len
 		dey
 		bne	dir.line
 		jsr	hex2ad		; convert to ascii dec
 		jsr	space
 		jsr	space
dir.fix		jsr	acptrv		; fix a disk quirk
 		cmp	#$20
 		beq	dir.fix
 		bne	dchr.out
dir.name	jsr	acptrv		; get filename now
 		ldx	status
 		bne	eoi.chk
 		cmp	#0
 		beq	crlf.out
dchr.out	jsr	outchr
 		jsr	instat	 	; check for break
 		bcc	dir.name
 		lda	techo
 		pha
 		lda	#$40		; echo and output off		
 		sta	techo
wait.spc	jsr	inchr		; space to continue
 		cmp	#$20
 		bne	wait.spc
 		pla			; get techo back
 		sta techo
 		clc	
 		bcc	dir.name
 		;
crlf.out	jsr	crlf
 		ldy	#2
 		bne	dir.line	; always
 		;
eoi.chk	cmp	#$40			; eoi only?
 		bne	dir.err2	; other disk error
 		jsr 	crlf	
 		lda	#0
 		sta	status		; clear status
 		jsr	untalkv		; tell disk to untalk
 		lda	#$E0		; close/load SA
 		jmp	diskclosev
 		;
hex2ad		ldy	#0
nxtdig		ldx	#0	
subem		lda	fname
 		sec
 		sbc	subtbl,y
 		sta	fname
 		lda	fname + 1
 		iny
 		sbc	subtbl,y
 		bcc	addbak
 		sta	fname + 1
 		inx
 		dey
 		jmp	subem
addbak		dey
 		lda	fname
 		adc	subtbl,y
 		sta	fname
 		txa	
 		ora	#$30
 		jsr	outchr
 		iny
 		iny
 		cpy	#4
 		bcc	nxtdig
 		lda	fname
 		ora	#$30
 		jmp	outchr
 		;
subtbl		.word	100
 		.word	10
 		;
dir.err2	jmp	s.error
 		;
 		; set device number SC # - MON command
 		;
nu 		jsr	inchr		; get device number
 		jsr	ascnib		; convert to hex
 		bcs	dir.err2	; not hex chr
 		cmp	#8
 		bcc	dir.err2	; device < 8 error
 		sta 	disk.dev
 		clc
 		rts
 		;
 		; input file name
 		;
ctrold		jsr	crlf		; restart filename
 		lda	#'/'		; send prompt
 		jsr	outchr
 		;
get.name	ldx	#0
gn.chr 		jsr	inchr		; get a char
 		sta	fname,x		; save char
 		beq	gn.rts		; it was a CR
 		cmp	#$04		; ctrl-D?
 		beq	ctrold		; yes, restart file name
		inx		 	; count it
		cpx	#30		; 30 is max
		beq	get.name	; start over if too many
		bcc	gn.chr		; else loop over more
gn.rts		stx	fn.len		; save number chrs
		rts
		;
		; common disk close routines
		;	ST checked before the close
		;	SA	is in A upon call
		;	ST	is returned in A
		;
disk.close	ldy	status		; check previous status
		bne	err.rtn2	; error?
		jsr	set.lstn
		jsr	unlistenv
		lda	status	
		bne	err.rtn2	; error if not zero
		rts
		;
err.rtn2	jmp	err.rtn
		;
		; common disk open routines
		; 	ST cleared at entry
		;	SA in A at entry
		;
disk.open	ldy	#0		; clear status
		sty	status
		jsr	set.lstn	; tell to listen
		bne	err.rtn2	; bad status returned
		lda	fn.len		; any name or command
		beq	no.data		; none
send.name	lda	fname,y		; get name chr
		jsr 	cioutv		; send to disk
		iny
		cpy	fn.len		; end of name yet?
		bne	send.name	; loop
no.data		ldy	#0		; clear status
		jmp	unlistenv	; tell device done
		;
		; setup VIA routines SYM VIA #1
		;
setup.via	pha
		jsr	access
		lda	#$38		; ATN, CLK, Data set as output
		sta	via1ddra
		lda	#$20		; set clk & ATN HI, data low
		sta	via1dra
		lda	#$00
		sta	via1t2l		; zero T2 latches
		sta	via1t2h		;
		pla
		rts
		;
		; command device to talk
		; 	SA in A
set.talk	pha			; save SA
		lda 	c.dev		; get device number
		jsr	talkv		; command to talk
		pla			; get sa back
		jsr	talksav		; send to device
		ldy	status		; load/test status
		rts
		;
		; command device to listen
		; 	SA in A
		;
set.lstn	pha			; save SA
		lda	c.dev
		jsr 	listenv		; command to listen
		pla
		jsr	secondv
		ldy	status		; load/test status
		rts
		;
		; Disk primitives
		; from the C64 and VIC20 kernal
		; errors returned in the status regsiter
		;
		; send 'talk' to the device
		; command in A same a C64 $ED09 VIC20 $EE14
		;
talk		ora	#$40		; set talk bit
		.byte 	skip2
		;		
		; send listen to device
		; command in A same a C64 $ED0C VIC20 $EE17
		;
listen	ora	#$20
		jsr	s.chk.idl		; vic20 @ f160
		;
		; send 'control'
		;  same a C64 $ED11 VIC20 $EE1C
		;
control		pha				; save chr
		bit	df.flg			; test deferred chr flag
		bpl	get.def			; no def chr pending
		sec
		ror	eoi.flg			; set eoi bit on
		jsr	send.out		; send serial chr
		lsr	df.flg
		lsr	eoi.flg			; clear eoi bit
get.def		pla				; get chr back
		sta	df.chr			; same as deferred chr
		sei
		jsr	srl.1			; let device have data line
		cmp	#$3f			; error in kernal
		bne	atn.low
		jsr	clk.on			; set clock high
		;
atn.low		lda	via1dra
		ora	#$08			; set 'ATN'out low
		sta	via1dra
		;
bus.dir		sei	
		jsr	clk.off			; chk bus direction
		jsr	srl.1
		jsr	dly.1ms			; wait 1 ms
		;
		; send serial output character
		;
		; same a C64 $ED40 VIC20 $EE49
		;
send.out	sei				; disable interrupts
		jsr	srl.1			; output '1'
		jsr	srl.ic			; set input bit & clk in
		lsr	a
		bcs	dev.np			; device not present
		jsr	clk.on			; set clock out high
		bit	eoi.flg			; test eoi flag
		bpl	s.out3
		; signal eoi?
s.out1		jsr	srl.ic			; wait all listeners ready
		lsr	a	
		bcc	s.out1			; not yet
s.out2		jsr	srl.ic			; wait listener to ack eoi
		lsr 	a
		bcs	s.out2
s.out3		jsr	srl.ic			; wait all listeners ready
		lsr 	a
		bcc	s.out3
		jsr	clk.off			; start clock pulse
		; send out byte
		lda	#8			; 8 bytes to output
		sta	bit.cnt
s.out4		lda	via1dra
		cmp	via1dra			; make sure not changing
		bne	s.out4			; changing, try again
		lsr 	a	
		lsr	a
		bcc	time.out		; set time out status
		ror	df.chr			; get bit to send
		bcs	bit.on			; bit was on
		jsr	srl.0			; output '0'
		bne	s.wait			; unconditional
bit.on		jsr	srl.1			; outout '1'
s.wait		jsr	clk.on			; end clock pulse
		.byte	$EA,$EA,$EA,$EA,	; C64 needs 60 usec
		lda	via1dra
		and	#$DF			; data out high
		ora	#$10			; start next clock cycle
		sta via1dra
		dec 	bit.cnt			; count the bit sent
		bne	s.out4
		; frame handshake
		lda	#$04			; timing
		sta	via1t2h			; start t2 running
wait.ack	lda	via1ifr			; get interrupt flags
		and	#$20			; check for T2 time out
		bne	time.out		; timed out before ACK
		jsr	srl.ic			; check for ACK
		lsr	a
		bcs	wait.ack		; wait for ACK
		cli				; allow interrupts again
		rts				; and return
		;
		; set device not present in status
		;	same as C64 $EDAD VIC20 $EEB4
dev.np		lda	#$80			; set status for device not present
		.byte	skip2
		;
		; serial time out
		;	same as C64 $EDB0 VIC20 $EEB7
		;
time.out	lda	#$01			; set send time out flag
t.out		jsr	set.st			; store to status
		cli				; allow interrupts again
		clc
		bcc	unlst1			; CLR ATN etc
		;
		; Send LISTEN SA
		; 	same as C64 $EDB9 VIC20 $EEC0
second		sta	df.chr
		jsr	bus.dir
		;
		; clear ATN
		;	same as C64 $EDBE VIC20 $EEC5
atn.clr		lda	via1dra
		and	#$F7			; release ATN
		sta	via1dra
		rts
		;
		; Send TALK SA
		; 	same as C64 $EDC7 VIC20 $EECE
talk.sa		sta 	df.chr
		jsr 	bus.dir
		sei				; stop interrupts
		jsr	srl.0
		jsr	atn.clr
		jsr	clk.on
t.sa		jsr	srl.ic			; wait for device to grab clock
		bcs	t.sa			
 		cli	
 		rts
 		;
 		; send serial deferred
 		;	same as C64 $EDD0 VIC20 $EEE4	
 		; send byte with handshake
ciout		bit	df.flg			; any pending?
 		bmi	ci1			; got one pending
 		sec
 		ror	df.flg			; set flag for chr present
 		bne	ci2			; unconditional
ci1		pha				; save this chr
 		jsr 	send.out			; output prev one
 		pla
ci2 		sta	df.chr			; temp stored deferred
 		clc
 		rts
 		;
 		; send UNTALK
 		; 	same as C64 $EDEF VIC20 $EEF6
untalk		sei
 		jsr	clk.off
 		lda	via1dra
 		ora	#$08			; turn on ATN
 		sta	via1dra
 		lda	#$5F
 		.byte	skip2
 		;
 		; send unlisten
 		; 	same as C64 $EDFE VIC20 $EF04
unlisten	lda	#$3F
 		jsr	control			; send last char
unlst1		jsr	atn.clr			; clear ATN
 		;
unlst2		txa				; save X
 		ldx	#$08			; timing C64=0A VIC20=0B
unlst3		dex
 		bne 	unlst3
 		tax				; restore X
 		jsr	clk.on
 		jmp	srl.1			; enable data in
 		;
 		; receive from serial bus
 		; 	same as C64 $EE13 VIC20 $EF19
acptr		sei				; stop talking
 		lda	#0
 		sta 	bit.cnt			; only 1 eoi allowed
 		jsr	clk.on			; enable clock in
rcv.clk		jsr	srl.ic			; get input clock
		bcc	rcv.clk			; wait for start
		jsr	srl.1			; indicate ready to receive
rcv.t256	lda	#01			; timing mode
		sta	via1t2h			; 200 us delay
rcv.tm1		lda	via1ifr			; chk timer
		and	#$20 
 		bne	rcv.tm2			; time out, check if eoi
 		jsr	srl.ic			; get input clock
 		bcs	rcv.tm1			; no clock yet
 		bcc	rcv.bit			; input clock started
rcv.tm2		lda	bit.cnt			; been here before?
 		beq	rcv.eoi			; no, must be an eoi
 		lda	#$02			; error, read time out
 		jmp	t.out			; store as status
 		;
rcv.eoi		jsr	srl.0			; ack eoi
 		jsr	unlst2			; delay for 60 us
 		lda	#$40			; set ST eoi flag
 		jsr	set.st
 		inc	bit.cnt			; allow only 1 eoi
 		bne	rcv.t256
rcv.bit		lda	#8			; set up for 8 bits of data
 		sta 	bit.cnt
rcv.tm3		lda	via1dra
 		cmp	via1dra			; not changing
 		bne	rcv.tm3			
 		lsr 	a	
 		bcc	rcv.tm3			; wait data present clock
 		lsr	a
 		ror	disk.chr		; into chr build
rcv.tm4		lda	via1dra
 		cmp	via1dra
 		bne	rcv.tm4			; not changing
 		lsr 	a
 		bcs	rcv.tm4			; wait clock to fall
 		dec	bit.cnt			; count bit in
 		bne	rcv.tm3			; more bits to get
 		jsr	srl.0			; force data low
 		lda	status			; chk for eoi or timeout
 		beq	rcv.tm5			; none
 		jsr	unlst2			; delay a bit & clear data
rcv.tm5		lda	disk.chr		; load chr
 		cli
 		clc
 		rts
 		;
 		; set clock line high (IE on)
 		; 	same as c64 ee85 vic20 $ef84
clk.on		lda	via1dra
 		and 	#$EF			; clock out high
 		sta	via1dra
 		rts
;
 		; set clock line low (IE off)
 		; 	same as c64 ee8E vic20 $ef8D
clk.off		lda	via1dra
 		ora 	#$10			; clock out low
 		sta	via1dra
 		rts
 		;
 		; serial output 1
 		;	same as C64 $EE97 VIC20 $E4A0
srl.1		lda	via1dra			; get control reg
 		and 	$DF			; set data out high
 		sta	via1dra
 		rts
 		;
 		; serial output 0
 		;	same as C64 $EEA0 VIC20 $E4A9
srl.0		lda	via1dra			; get control reg
 		ora 	#$20			; set data out low
 		sta	via1dra
 		rts
 		;
 		; get serial input & clock in
 		;	same as C64 $EEA9 VIC20 $E4B2
srl.ic		lda 	via1dra			; get current input
 		cmp	via1dra			; make sure not changing
 		bne	srl.ic			; changed, try again
 		lsr	a			; clock to carry
 		rts
 		;
 		; delay 1 msec
 		;	same as C64 $EEBE VIC20 $EF96
dly.1ms	lda	#4
 		sta	via1t2h
dly1		lda	via1ifr
 		and	#$20
 		beq	dly1
 		rts
 		;
 		; check for serial bus idle
 		; 	same as C64 $F0A4 VIC20 $F160
s.chk.idl	pha				; save A
c.idl		lda	via1dra
		and	#$04
		beq	c.idl			; wait for ATN to clear
		pla
		rts
		;
		; set status
		; 	same as C64 $FE1C VIC20 $FE6A
set.st		ora	status
		sta	status
		sec
		rts
		;
message		.byte	$0D,$0A
		.byte	"==============================="
		.byte	$0D,$0A
		.byte	"SYM-1 1541 DISK OPERATING SYSTEM"
		.byte	$0D,$0A
		.byte	"COPYRIGHT 1984 BY RONALD A. JORDAN"
 		.byte	$0D,$0A
		.byte	"==============================="
		.byte	$0D,$0A,$0A,$0A,$00
		;
		; RAE interface routines 
		; interfaced via RAE GET, PUT and DC vectors
		; 
		;
		.org	$7800	
purecl		=	$C8			; relocating buffer addr lo
tpres		=	$D3			; present	end of text file
diskc.vec	=	$EC			; disk command vector
diski		=	$EE			; 1 = disk input, else tape
disko		=	$EF			; 1 = disk outpu, else tape
disko.vec	=	$F4			; put vector
diski.vec	=	$F6			; get vector
						;
txst		=	$100			; start of textfile
txen		=	$102			; end of text file
stst		=	$104			; start of label file
sten		=	$106			; end of label file
first		=	$108			; first line number
file.no		=	$110			; current file number
hex.dec		=	$111			; 0 = hex, 1 = dec
cur.save	=	$11C			; used to locate last line
tstart		=	$124			; tape start address
tend		=	$126			; tape end address
hfile.no	=	$128			; header file number
hstart		=	$129			; header start address
hend		=	$12B			; header end address
crt.buf		=	$135			; crt buffer
						;
rae.warm	=	$B003			; RAE warm start
error		=	$B00E			; RAE error vector
line.adr	=	$B214			; find adr of line
tape1.off	=	$E318			; turn off read tape
tape0.off	=	$E30F			; turn off write tape
set.eot		=	$E597			; put eot after tape load
tape.get	=	$EF68			; tape re-entry after get
tape.put	=	$EF95			; buffer area
		;
		; RAE initialization parameters
		;
txtladr		=	$200			; start of text file
txthadr		=	$5FFC			; end of text file
lblladr		=	$6000			; start of label file
lblhadr		=	$6EFC			; end of label file
bufadr		=	$6F00			; buffer area
		;
		; RAE cold start
		;
rae.init	jsr	access
		lda	#rae.cold & $00FF	; RAE start adr to P3
		sta	p3
		lda	#rae.cold / $100	; 
		sta	p3 + 1
		jmp	execute			; do monitor execute
		;
		; initialize RAE					
		;
rae.setup	lda	#1			; enable get & put i/o
		sta	diski
		sta	disko
		lda	#get.vec & $00FF	; setup RAE vectors
		sta	diski.vec
		lda	#get.vec / $100
		sta	diski.vec + 1
		lda	#disk.rae & $00FF
		sta	diskc.vec
		lda	#disk.rae / $100
		sta	diskc.vec + 1
		lda	#$60			; set return in new dc vec
		sta	new.dcv
		lda	#put.vec & $00FF
		sta	disko.vec
		lda	#put.vec / $100
		sta	disko.vec + 1
		lda	#bufadr & $00FF
		sta	purecl 
		lda	#bufadr / $100
		sta	purecl + 1
		lda	#txtladr & $00FF
		sta	txst
		lda	#txtladr / $100
		sta	txst + 1
		lda	#txthadr & $00FF
		sta	txen
		lda	#txthadr / $100
		sta	txen + 1
		lda	#lblladr & $00FF
		sta	stst
		lda	#lblladr / $100
		sta	stst + 1 
		lda	#lblhadr & $00FF
		sta	sten
		lda	#lblhadr / $100
		sta	sten + 1 
		;
		jmp	rae.warm			; warm start RAE
		;
		; new get.vec entry point
		;
get.vec		lda	disk.dev			; disk or tape?
		bne	disk.get			; go to disk
		;
		lda	hex.dec
		bne	tapeget
		sta	file.no				; file nu,mber = 0
tapeget		jmp	tape.get
		;
disk.get	cmp	#8
		bcc	to.err32			; < 8, error
		jsr	tape1.off			; record tape off
		lda	tstart + 1			; heasder or data pass?
		cmp	#$01				; header if page 1
		bne	chk.gtype			; no do .ct or load
		;			;
		; header for get
		;
		lda	#0				; zero header info
		sta	hfile.no
		sta	file.no
		sta	hstart
		sta	hstart + 1
		sta	hend
		sta hend + 1
		rts
		;
		; check for disk .ct or load and finish
chk.gtype	lda	hex.dec				; .ct?
		beq	disk.ct				; yes, disk .ct
		ldx	#0				; name to start
		jsr 	get.nam				; name to fname
disk.get1	lda	disk.dev			; get device #
		sta	c.dev
		sta 	p3				; non-0 for relocated load
		lda	tstart				; start adr to p2
		sta	p2
		lda	tstart + 1
		sta	p2 + 1
		jsr 	loadv				; do load
		bcs	err33				; load error
		lda	curad				; set new eot
		sta	tend
		lda	curad + 1
		sta	tend + 1 
		cmp	txen + 1			; chk for text overflow
		bne	errr	
		lda	curad
		cmp	txen
errr		bcs	err31
		ldx	#0
		jsr	set.eot				; end addr to tpres & store EOT
		txa
		rts
		;
err33		jsr	ermsg				; display status
		ldx	#$33				; disk i/o error
		jmp	(error)
		;
err31		ldx	#$31				; text file overflow
		jmp	(error)
to.err32	jmp	err32
		;
		; continue on disk
		;
disk.ct		ldy	#2				; point past line #
		lda	#$3B				; make 1st line a valid line
		sta	(tpres),y
		lda	#$FF
		sta	first + 1			; search for highest #
		jsr	line.adr
		lda	cur.save
		sta	curad
		lda	cur.save + 1
		sta	curad + 1
		ldy	#1				; just before 1srt chr
fnd.ct		iny					; next chr
		lda	(curad),y
		bmi	err34				; invalid fname
		cmp	#'.'				; look for '.'
		bne	fnd.ct				; keep lokking
		iny
		lda	(curad),y
		cmp	#'C'				; C?
		bne	fnd.ct				; keep looking
		iny
		lda	(curad),y
		cmp	#'T'				; .CT?
		bne	fnd.ct				; keep looking
		iny
		jsr	gn.move				; get name from .ct
		jmp	disk.get1			; finish with load
		;
err34		ldx	#$34				; invalid fname
		jmp	(error)
err32		ldx	#$32				; invalid device #
		jmp	(error)
		;
		; get name from crt buffer
		;
get.nam		ldy	#2				; at least PU/ or GE/
g.nam		jsr	access
		lda	#crt.buf & $00FF
		sta	curad
		lda	#crt.buf / $100
		sta	curad + 1
gn.delim	lda	(curad),Y			; get from buffer
		cmp	#'/'				; find fname start
		beq	gnm.lp				; yes, names starts next
		iny					; else next chr
		cpy	#80				; end of buffer?
		beq	err34				; name/command error
		bne	gn.delim			; always
gn.move		ldx	#0				; name to start of fname
		jsr access
gn.mov1		lda	(curad),y
		cmp	#$20				; skip leading blanks
		bne	gnm.lp1				; 1st non-blank
		iny
		bne	gn.mov1				; always
gnm.lp		iny
gnm.lp1		lda	(curad),y
		and	#$7F				; strip EOL bit
		cmp	#$20				; blanks?
		beq	gn.end				; yes, end
		cmp	#$09				; tab?
		beq	gn.end				; yes, end
		sta	fname,x				; else save chr
		inx
		cpx	#30				; name too long?
		beq	err34				; invalid filename
		lda	(curad),y			; chk for eol
		bpl	gnm.lp				; not yet
gn.end		stx	fn.len				; save name length
		rts
		;
		; new put.vec entry point
		;
put.vec		lda	disk.dev			; output to disk
		bne	disk.put
		jmp	tape.put			; else normal tape
		;
disk.put	cmp	#8				; check drive number
		bcc	err32				; < 8 error
		jsr	tape0.off
		lda	tstart + 1			; header or data pass?
		cmp	#$01
		bne	put.data			; no, then data pass
		lda	#0				; set ok flag
		rts					; and return this pass	
		;
put.data	lda	#0				; file name to buff start
		jsr	get.nam				; name from crt buffer
		lda	disk.dev			; set device number
		sta	c.dev
		lda	hstart				; setup save parms
		sta	p2
		lda	hstart + 1			; setup save parms
		sta	p2 + 1
		lda	hend				; points to last byte
		sta 	p3
		lda	hend + 1			; points to last byte
		sta 	p3 + 1
		jsr	savev
		bcs	to.err33			; disk i/o error
		rts
		;
		; new disk command dc.vec entry point
		;
disk.rae	cpy	#80				; any command given
		beq	to.err34			; inavlid command?
		lda	crt.buf,y
		cmp	#'#'				; device umber?
		beq	local.dev			; yes, change
		cmp	#'!'				; disk status?
		beq	prt.st
		cmp	#'?'				; directory?
		beq	dir.list
		cmp	#'/'				; disk command?
		beq	disk.cd
		jmp	new.dcv				; return or add more commands	
		;
		; send 1541 disk command
		;
disk.cd		lda	disk.dev			; get device #
		cmp	#8
		bcc	too.err32			; < 8 error
		clc	
		sta 	c.dev
		ldx	#0				; put disk command at start
		jsr	g.nam
		jsr	diskcmdv			; use extended command
		bcs	to.err33
		rts
		;
		; errors
to.err34	jmp	err34		
to.err33	jmp	err33		
too.err32	jmp	err32		
		;
		; change current device number
		;
local.dev	iny
		lda	crt.buf,y			; get drive #
		jsr	ascnib				; convert to hex
		bcs	too.err32			; non hex chr
		sta	disk.dev
		rts
		;
		; display disk status
		;
prt.st		lda	disk.dev			; get device #
		cmp	#8				; < 8 error
		bcc	too.err32		
		clc
		sta	c.dev
		jmp	diskstv				; use extended command
		;
		; display disk directory
		;
dir.list	ldx	#1				; set length of name
		lda	disk.dev	
		cmp	#8	
		bcc	too.err32			; < 8 error
		clc
		sta	c.dev
		jmp	direntv				; use extended command
		;
		; 
rae.cold	.byte	"GB000"
		.byte	$0D
		.byte	"RU $A600"
		.byte	$0D
		.byte	0
		;
		; basic interface routines for Commodore disk 1541
		; interfaced through invec and outvec
		;
buff		=	$1E			; buffer pointer
psad		=	$7B			; start source text
vsad		=	$7D			; start simple variables
himem		=	$87			; top of basic ram
chrget		=	$CC			; get next character
chrgot		=	$D2			; get last character
txtptr		=	tpres			; text pointer low
acc		=	$ED			; save acc
xreg		=	diski			; save x
yreg		=	disko			; save y
		;
		; basic routines
		;
baswarm		=	$C27E			; basic warm start
scratch		=	$C458
run.cmd		=	$C707
		;
		; basic cold start
		;
bas.init	jsr 	access
		lda	#bas.start & $00FF
		sta	p3
		lda	#bas.start / $100
		sta	p3 + 1
		jmp	execute
		;
bas.cold	jsr	scratch			; new and clear basic text
		lda	scra			; set invec for execure rts
		ldy	scra + 1
		sta	new.inv + 1
		sty	new.inv + 2
		lda	#input & $00FF
		ldy	#input / $100
		sta	scra
		sty	scra + 1
		jmp	wedge2
;
wedge		jsr	access
		lda	invec + 1			; setup new invec
		ldy	invec + 2
		sta	new.inv + 1
		sty	new.inv + 2
		lda	#input & $00FF			; invec to input
		ldy	#input / $100
		sta	invec + 1
		sty	invec + 2
		;
wedge2		lda	#0
		sta	techo				; setup for no excho
		lda	outvec + 1			; setup new outvec
		ldy	outvec + 2
		sta	new.outv + 1
		sty	new.outv + 2
		lda	#output & $00FF			; outvec goes to moutvec
		ldy	#output / $100
		sta	outvec + 1
		sty	outvec + 2
		jmp	baswarm
		;
		; invec entry point
		;
input		jsr	new.inv				; get character
		and	#$7F				; strip bit 7
ctrolc		cmp	#3				; monitor jump?
		bne	send				; no
		jsr	access
		lda	new.outv + 1			; restore i/o
		sta	outvec + 1
		lda	new.outv + 2			
		sta	outvec + 2
		lda	new.inv + 1			; restore i/o
		sta	invec + 1
		lda	new.inv + 2	
		sta	invec + 2
		lda	#$80				; reset echo flag
		sta	techo
		jsr	usrent
		jmp	wedge				; return by "G CR"
		;
send		jmp	new.outv
		;
		; save al registers
savereg		sta	acc
savexy		stx	xreg
		sty	yreg
		rts
		; 
		; restore all registers
		;
restorregs	lda	acc
restorxy	ldx	xreg
		ldy	yreg
		rts
		;
		; outvec entry point
		;
output		jsr 	savereg			 	; save regs
		ldx	#5
pull2		pla					; pull stack
		dex					; to allow tout not outchr
		bpl	pull2
		jsr	restorregs
		;
		cmp	#$0D				; look for CR
		bne	send2
		jsr	chrgot				; get last chr
		cmp	#'#'
		beq	newcmds				; yes. check new commands
		lda	#$0D				; restore CR
send2		jsr	new.outv
		jmp	restorregs
		;
		; pull stack back to command processor
		;
newcmds		ldx	#7
pull3		pla
		dex
		bpl	pull3
		;
		ldy	#				; set index for cmd pointer
cmd.chk		ldx	#0
c.chk		lda	buff,x
		cmp	cmd.table,y
		bne	next.cmd			; no try next cmd
		inx					; move to next chr
		iny
		cpx	#3				; only 3 chrs / cmd
		bne	c.chk
		lda	cmd.table + 1,y			; high address
		pha
		lda	cmd.table,y			; low addresss
		pha
		rts					; match, good return
		;
next.cmd	iny					; next cmd in table
		iny
		clc
		cpy	#15				; chars in cmd table
		bcc	cmd.chk
nxt.err		jmp	chrget				; sn err, move to next chr
		;
		; disk load & save routines
		;
append.prg	lda	#1
		.byte 	skip2
load.prg	lda	#0
		jsr access
		sta	appflg
		lda	disk.dev
		cmp	#8				; check device #
		bcc	d.err				; < 8 error
		sta	c.dev
		sta	p3				; non-zero, reloacate load opt
		jsr	get.fname
		bcs	f.err				; file name error
		lda	appflg
		beq	l.prg1				; non-zero, append load
		ldx	vsad				; append address
		ldy	vsad + 1			; 
		bne	l.prg2				; always
l.prg1		ldx	psad				; normal address
		ldy	psad + 1		
l.prg2		stx	p2
		sty	p2 + 1
		jsr	loadv
		bcs	l.err				; load error
		ldx	curad				; set basic eot
		ldy	curad + 1
		stx	vsad
		sty	vsad + 1
		cpy	himem + 1			; check for text overflow
		bne	l.prg3
		cpx	himem
l.prg3		bcs	t.err				; text overflow
		rts
		;
run.prg		jsr	load.prg
		jmp	run.cmd
save.prg	jsr	access
		lda	disk.dev
		cmp	#8				; check device number
		bcc	d.err				; < 8 error
		sta 	c.dev
		jsr	get.fname
		bcs	f.err
		ldx	psad
		ldy	psad + 1
		stx	p2
		sty	p2 + 1
		ldx	vsad	
		ldy	vsad + 1
		stx	p3
		sty	p3 + 1
		jsr	savev
		bcs	s.err				; save error
		rts
		;
		; error routines
		;
d.err		lda	#dev.err
		bne	send.err
dc.err		lda	#dcmd.err
		bne	send.err
f.err		lda	#fname.err
		bne	send.err
l.err		lda	#load.err
		bne	send.err
s.err		lda	#save.err
		bne	send.err
t.err		lda	#text.err
send.err	sec
		jsr	ermsg
		jsr 	crlf
		rts
		;
dev.err		= 	49
fname.err	= 	50
load.err	= 	51
save.err	=	52
text.err	=	53
dcmd.err	=	54
		;
		; disk commands
		;
disk.cmds	jsr	access
		jsr	get.fname
		bcs	f.err
		lda	fname
		cmp	#'#'
		beq	set.dev
		cmp	#'!'
		beq	d.status
		cmp	#'?'
		beq	d.direct
		cmp	#'/'
		beq	send.cmd
to.dc.err	bne	dc.err				; disk comamnd error
		;
set.dev		lda	fname + 1
		jsr	ascnib				; convert to hex
		bcs	d.err				; non hex number
		cmp	#8
		bcc	d.err				; < 8 error
		clc
		sta	disk.dev
		rts
		;
d.status	lda	disk.dev			; check device number
		cmp	#8
		bcc	d.err				; < 8 error
		clc
		sta	c.dev
		jmp	diskstv
		;
d.direct	lda	disk.dev			; check device #
		cmp	#8
		bcc	d.err	
		clc	
		ldx	#1
		jmp	direntv
		;
send.cmd	lda	disk.dev
		cmp	#8
		bcc	d.err				; < 8 error
		sta	c.dev
		ldy	#0
s.cmd		lda	fname + 1,y			; move command up one
		sta	fname,y
		iny
		cpy	fn.len				; # chrs in name
		bcc	s.cmd
		dec	fn.len
		jsr	diskcmdv
		bcs	to.dc.err
		rts
		;
		; get file name
		;
get.fname	inc	txtptr				; move ptr to next chr
		inc	txtptr				; past command
		jsr	chrget
		cmp	#' '
		bne	f.err.rts
		ldx	#0
g.fname		jsr	chrget
		cmp	#' '
		beq	end.fname
		sta	fname,x
		inx
		cpx	#30				; max 30 chars in fname
		bcc	g.fname
f.err.rts	sec
		rts
		;
end.fname	cpx	#0				; empty fname?
		beq	f.err.rts			; yes, error
		stx	fn.len				; save name length
		jsr	chrget				; prevent sn error
		clc
		rts
		;
cmd.table	.byte	"#LP"
		.word	load.prg - 1
		.byte	"#SP"
		.word	save.prg - 1
		.byte	"#DC"
		.word	disk.cmds - 1
		;
bas.start	.byte	"GC000"
		.byte	$0D
		.byte	"28672"
		.byte	$0D
		.byte	"80"
		.byte	$0D
		.byte	"1?X=USR(&", 
		.byte	$22
		.byte	"A603"
		.byte	$22
		.byte	",0)"
		.byte	$0D
		.byte	"RUN"
		.byte	$0D
		.byte	0
 		;
		.end                                                                         