Chrin/error channel

From: Christopher Phillips (christopher_at_jaruth.com)
Date: 2004-07-05 13:17:18

Any thoughts on why it would sometimes hang while attempting to read 
the 1541's error channel?

Following advice in Inside Commodore Dos, I do this fairly frequently 
while snaffleupadisk is grabbing sectors for sending via swiftlink to a 
host computer, but I've had to disable one I do after each track, as it 
was dying around half the time.

following routine is intermittantly failing to return from chrin:

;-------------------------------------------------;
;  get and print error message                    ;
;-------------------------------------------------;
prerr .(
	ldx #$1
	jsr chkin
next
	jsr chrin
	jsr chrouts
	cmp #13
	bne next
	jmp clrchn ; restore default i/o channels.
	.)



rest of code attached - it's only small :)


;include "c64def.def"

ztmp  = 20
zp    = 254

#define poke(addr,val)	.(:lda #val:sta addr:.)
#define doke(addr,val)	.(:lda #<val:sta addr:lda #>val:sta addr+1:.)
#define lax16(val)		.(:lda #<val:ldx #>val:.)
#define equ =
	


;KERNAL

setlfs  equ $ffba
setnam  equ $ffbd
open    equ $ffc0
close   equ $ffc3
chkin   equ $ffc6
chkout  equ $ffc9
clrchn  equ $ffcc
chrin   equ $ffcf
chrout  equ $ffd2
chrouts  equ $e716    ;chrout to screen
clall   equ $ffe7
unlsn   equ $ffae

sData    = $de00
sStatus  = $de01
sCommand = $de02
sControl = $de03


transitLounge=$0500
unscramble  = $ce00


	*= $c000-2
	.word *+2	; load address
	jmp main

Track:
	.byt 18
numSe:
	.byt 1
doI0:
	.byt 2

main:
	lda #0
	sta $d020
	sta $d011
	lda #13
	sta $d021
	lda #<testStr
	ldx #>testStr
	jsr printzs
	lda #0
	sta $d021
	lda #27
	sta $d011


	jsr mkUST
	jsr opendisk
	
	jsr sendDriveCode


	poke(CurrentSector,0)
sectorLoop
	lda Track
	ldx CurrentSector
	jsr setTkSe
	jsr prerr
	
	jsr runDriveCode  ; warning - this clears interupt disable
	lax16(transitLounge)
	jsr toadReceive
	jsr sendBlockToHost

	inc CurrentSector
	lda CurrentSector
	cmp numSe
	bne sectorLoop




	;jsr prerr
	
	jsr closedisk

	rts
	
sendBlockToHost: .(
	ldy#0
loop
	lda #16
	ldx #200
notReady
	sty kk+1
	ldy#50
p
	dey
	bne p
kk
	ldy #0
	dex
	bne ohFuckit
	bit sStatus
	beq notReady
ohFuckit
	lda transitLounge,y
	sta sData
	ldx#0
	iny
	bne loop
	rts
	.)


CurrentSector:
	.byt 0
	
testStr:
	.byt 147,153,"HI THERE!",13,0


mkUST:
	ldy#0
usl
	tya
	lsr
	lsr
	lsr
	lsr
	tax
	lda utsm,x
	asl
	asl
	asl
	asl
	pha
	tya
	and #15
	tax
	pla
	ora utsm,x
	sta unscramble,y
	dey
	bne usl
	rts
utsm
	.byt 15,  7, 13,  5, 11,  3,  9,  1, 14,  6, 12,  4, 10,  2,  8,  0
#if 0
; on sending, each nyble has the following xform applied:
; all bits are flipped, then bits 3 and 1 are placed
; in bits 1 and 0, then bits 2 and 0 into
; bits 2 and 3.
; so; we must swap high and low bits, and toggle all
; a=(15-arange(16))
; a/8+(a &6) + (a%2)*8
#endif

prhex:
	pha
	sty ry+1
	lsr
	lsr
	lsr
	lsr
	tay
	lda hd,y
	jsr chrouts
	pla
	and#15
	tay
	lda hd,y
	jsr chrouts
ry	ldy#0
	rts
hd:
	.byt "0123456789abcdef"

xlate: .(
#if 1
	stx foo+1
	pha
	pla
	and#15
	tax
	lda tb1,x

foo ldx #0
#endif
	rts
tb1
	.byt 5*0+10, 1*0+2, 4*0+8, 0*0+0 
	.byt 5*0+10, 1*0+2, 4*0+8, 0*0+0 
	.byt 5*0+10, 1*0+2, 4*0+8, 0*0+0 
	.byt 5*0+10, 1*0+2, 4*0+8, 0*0+0 
	.)


;-------------------------------------------------;
;  recieve a page of data from drive.             ;
; Destination in a,x                              ;
;-------------------------------------------------;
toadReceive: .(
	php
	sei

	sta dest +1
	stx dest +2

	poke($d011,0)  	; blank screen
	poke($d020,4)
	poke($dd00,0)

	ldy#0
	ldx#0
getloop
	inc $d020
wbits
	bit $dd00    ; spacing shown for catching 1st store!



	bmi wbits

	bvc weAreLate  ; must have caught the 2nd store

	nop   ; caught 1st so wait 7 cycles instead of 3

	lda 3
weAreLate

	nop

	lda 3


	lda $dd00  ; 2 bits



	lsr

	lsr

	ora $dd00  ; 2 bits



	lsr

	lsr

	ora $dd00  ; 2 bits



	lsr

	lsr

	ora $dd00  ; 2 bits

	dec $d020

	tax
	lda unscramble,x
dest
	sta $400+160,y

	iny
	bne getloop

	poke($d020,0)

	
	poke($d020,0)
	poke($d011,27)
	poke($dd00,3)
	plp
	rts
	.)


;-------------------------------------------------;
;  set track,sector to a,x                        ;
;-------------------------------------------------;
setTkSe .(
	sta mwData+0
	stx mwData+1
	doke(mwCmd+3,tk)
	poke(mwCmd+5,2)
	lda #<mwCmd
	ldx #>mwCmd
	ldy #mwEnd-mwCmd
	jmp sendcmd
	.)
;-------------------------------------------------;
;  What it says on the box..                      ;
;-------------------------------------------------;

sendDriveCode .(
	doke(mwCmd+3,drivestart)
dsbl	ldy #0
next	lda drivecode,x
	inx
	sta mwData,y
	iny
	cpy #32
	beq senditalready
	cpx #driveend-drivestart
	bne next
senditalready
	sty mwCmd+5
	stx toSend +1

	lda #<mwCmd
	ldx #>mwCmd
	ldy #mwEnd-mwCmd
	jsr sendcmd
	clc
	lda #32
	adc mwCmd+3
	sta mwCmd+3
toSend	ldx #0
	cpx #driveend-drivestart
	bne dsbl
	rts
	.)


mwCmd:	.byt "M-W",0,5,32
mwData:	.dsb 32, $aa
mwEnd:

;-------------------------------------------------;
;  What it says on the box..                      ;
;-------------------------------------------------;

runDriveCode
	lda #<meCmd
	ldx #>meCmd
	ldy #meEnd-meCmd
	jmp sendcmd

meCmd:	.byt "M-E",0,5
meEnd:

;-------------------------------------------------;
;  open 1,8,15,"I0"                               ;
;-------------------------------------------------;

opendisk:
	lda #1  ; logical file number
	ldx #8  ; drive
	ldy #15 ; cmd channel
	jsr setlfs
	lda doI0 ; strlen  - should be 2 or 0
	ldx #<i0str
	ldy #>i0str
	jsr setnam
	jmp open

i0str:
	.byt "I0"

;-------------------------------------------------;
;  send cmd - no unlistn       ,ax  is str, y is len           ;
;-------------------------------------------------;

sendcmdnoUn .(
	sta loop+1
	stx loop+2
	sty loop-1
	ldx #1
	jsr chkout

	ldx #0
	ldy #0
loop	lda $ffff,x
	jsr chrout
	inx
	dey
	bne loop
	rts
	.)
;-------------------------------------------------;
;  send cmd       ,ax  is str, y is len           ;
;-------------------------------------------------;

sendcmd .(
	jsr sendcmdnoUn
	jmp unlsn
	.)

;-------------------------------------------------;
;  close 1                                        ;
;-------------------------------------------------;

closedisk:
	lda #1
	jmp close	

	
;-------------------------------------------------;
;  get and print error message                    ;
;-------------------------------------------------;
prerr .(
	ldx #$1
	jsr chkin
next
	jsr chrin
	jsr chrouts
	cmp #13
	bne next
	jmp clrchn ; restore default i/o channels.
	.)
	
;-------------------------------------------------;
;  print to screen null terminated string pointed to by a,x ;
;-------------------------------------------------;
printzs:  .(
	sta next +1
	stx next +2
	ldx #0
next	lda $ffff,x
	beq done
	jsr chrouts
	inx
	bne next
done	rts
	.)


;-------------------------------------------------;
;  Kill OS, start dummy main & raster interrupt   ;
;-------------------------------------------------;
switchToMyIRQ	.(
	poke($dc0d,$7f)	 ; kill CIA irq
	sei
	ldx #$fe
	txs

	poke($01,$35)	 ; disable ROM
	doke($fffe,irq1 ) ; set irq vector
	poke($d01a,$01  ) ; enable VIC irq
	poke($d011,$18+3) ; clear high bit of irq rasterline
	poke($d012,$00	) ; low byte of raster line ($33 is first visible)
	cli
sleep	jmp sleep
	.)
	
;-------------------------------------------------;
;  minimal raster irq                      ;
;-------------------------------------------------;

irq1: .(
	lda $d019
	sta $d019
	inc framecount
	bne foo
	inc $d020
foo
	rti
	.)
	
framecount:
	.byt 0


;-------------------------------------------------;
;  The Drive code                                 ;
;-------------------------------------------------;

port1b equ $1800   ; bit 7 is atn, 2 & 0 clock,data (2 & 0 in, 1 and 3 out??)
port2b equ $1c00   ; bit 3 is led

b0jq   equ $00     ; job queue for buffer #0
b0tk   equ $06     ; track
b0se   equ $07     ; sector

jobRead equ $80
jobSeek equ $b0    ; do we really need to do this b4 reading??

buffer0 = $0300

drivecode:
	*= $0500
drivestart:
	sei
	cld
	;do stuff

	lda #0
	sta port1b
	jsr ledOn
	
	jsr readBlock
	
		
	jsr ledOff	

	php
	sei
	jsr driveSend
	plp
	lda #0
	sta port1b
	cli
	rts
	
tk:	.byt 18
se:	.byt 1

driveSend: .(
	jsr pause
	poke(dct,0)
dsl:
	ldy dct
	lda buffer0,y
	jsr SendAByte
	inc dct
	bne dsl
	rts
dct
	.byt 0
	.)

pause:
	pha
	txa
	pha
	tya
	pha

	ldx#40
	ldy#0
pp
	nop  ; 7*39*256 = .070 seconds
	dey
	bne pp
	dex
	bne pp

	pla
	tay
	pla
	tax
	pla

	rts

SendAByte:
	pha
	and#15
	tax

	lda #2   ; drive lines low; hence should wait for high of dd00 to clear
	ldy #10  ; if bit 6 is already clear, we're 6 cycles late!
	sta port1b



	sty port1b 



	pla


	lsr

	lsr

	lsr

	stx port1b  ; 2bits



	ldy aslLo,x



	sty port1b  ; 2bits



	lsr

	tax

	stx port1b  ; 2bits



	ldy aslLo,x



	sty port1b  ; 2bits



	nop

	lda #0

	sta port1b  ; terminator
	rts
aslLo
	.byt 0,2,4,6, 8,10,12,14, 0,2,4,6, 8,10,12,14

; reads block pointed to by tk,se
readBlock:
	lda #jobSeek
	ldx tk
	ldy se
	jsr doJob
	lda #jobRead
	ldx tk
	ldy se
	jmp doJob

; returns nonzero Y on failure

doJob:	php
	cli
	stx b0tk
	sty b0se
	ldx #20    ; try counter
	
jobtry: .(
	sta b0jq
wait	ldy b0jq
	bmi wait
	cpy #$01
	beq jobOK
	dex
	bne jobtry
jobOK:	plp
	rts
	.)
	
	
	
ledOn:	lda #$08
	ora port2b
	sta port2b
	rts
ledOff:	lda #$f7
	and port2b
	sta port2b
	rts	

cnt:	.byt 0

driveend:






       Message was sent through the cbm-hackers mailing list

Archive generated by hypermail pre-2.1.8.