From db90764185b85d949d517c9f1f46563425c05a44 Mon Sep 17 00:00:00 2001 From: Vince Weaver Date: Tue, 2 Jul 2024 15:16:19 -0400 Subject: [PATCH] riven: update prorwts for ca65 --- games/riven_hgr/prorwts_ca65.s | 1747 ++++++++++++++++---------------- 1 file changed, 896 insertions(+), 851 deletions(-) diff --git a/games/riven_hgr/prorwts_ca65.s b/games/riven_hgr/prorwts_ca65.s index bc0ff8c1..9508c061 100644 --- a/games/riven_hgr/prorwts_ca65.s +++ b/games/riven_hgr/prorwts_ca65.s @@ -1,127 +1,131 @@ ;open/read/write binary file in ProDOS filesystem ;copyright (c) Peter Ferrie 2013-16 + +; modified to assemble with ca65 (vmw) 2024 + + ;!cpu 6502 ;!to "prorwts",plain ;*=$800 - ;constants - cmdread = 1 ;requires enable_write=1 - cmdwrite = 2 ;requires enable_write=1 - SETKBD = $fe89 - SETVID = $fe93 - DEVNUM = $bf30 - PHASEOFF = $c080 - MOTOROFF = $c088 - MOTORON = $c089 - Q6L = $c08c - Q6H = $c08d - Q7L = $c08e - Q7H = $c08f - MLI = $bf00 - KEY_POINTER = $11 ;ProDOS constant - EOF = $15 ;ProDOS constant - AUX_TYPE = $1f ;ProDOS constant - ROMIN = $c081 - LCBANK2 = $c089 - CLRAUXRD = $c002 - CLRAUXWR = $c004 + ;constants + cmdread = 1 ;requires enable_write=1 + cmdwrite = 2 ;requires enable_write=1 + SETKBD = $fe89 + SETVID = $fe93 + DEVNUM = $bf30 + PHASEOFF = $c080 + MOTOROFF = $c088 + MOTORON = $c089 + Q6L = $c08c + Q6H = $c08d + Q7L = $c08e + Q7H = $c08f + MLI = $bf00 + KEY_POINTER = $11 ;ProDOS constant + EOF = $15 ;ProDOS constant + AUX_TYPE = $1f ;ProDOS constant + ROMIN = $c081 + LCBANK2 = $c089 + CLRAUXRD = $c002 + CLRAUXWR = $c004 - ;options - enable_floppy = 0 ;set to 1 to enable floppy drive support - poll_drive = 0 ;set to 1 to check if disk is in drive - override_adr = 0 ;set to 1 to require an explicit load address - aligned_read = 0 ;set to 1 if all reads can be a multiple of block size - enable_write = 0 ;set to 1 to enable write support - ;file must exist already and its size cannot be altered - ;writes occur in multiples of block size (256 bytes for floppy, 512 bytes for HDD) - allow_multi = 0 ;set to 1 to allow multiple floppies - check_checksum=0 ;set to 1 to enforce checksum verification for floppies - allow_subdir = 0 ;set to 1 to allow opening subdirectories to access files - might_exist = 0 ;set to 1 if file is not known to always exist already - ;makes use of status to indicate success or failure - allow_aux = 0 ;set to 1 to allow read/write directly to/from aux memory - ;requires load_high to be set for arbitrary memory access - ;else driver must be running from same memory target - ;i.e. running from main if accessing main, running from aux if accessing aux - load_high = 0 ;load into banked RAM instead of main RAM - lc_bank = 1 ;load into specified bank (1 or 2) if load_high=1 + ;options + enable_floppy = 0 ;set to 1 to enable floppy drive support + poll_drive = 0 ;set to 1 to check if disk is in drive + override_adr = 0 ;set to 1 to require an explicit load address + aligned_read = 0 ;set to 1 if all reads can be a multiple of block size + enable_write = 0 ;set to 1 to enable write support + ;file must exist already and its size cannot be altered + ;writes occur in multiples of block size (256 bytes for floppy, 512 bytes for HDD) + allow_multi = 0 ;set to 1 to allow multiple floppies + check_checksum=0 ;set to 1 to enforce checksum verification for floppies + allow_subdir = 0 ;set to 1 to allow opening subdirectories to access files + might_exist = 0 ;set to 1 if file is not known to always exist already + ;makes use of status to indicate success or failure + allow_aux = 0 ;set to 1 to allow read/write directly to/from aux memory + ;requires load_high to be set for arbitrary memory access + ;else driver must be running from same memory target + ;i.e. running from main if accessing main, running from aux if accessing aux + load_high = 0 ;load into banked RAM instead of main RAM + lc_bank = 1 ;load into specified bank (1 or 2) if load_high=1 - ;zpage usage + ;zpage usage .if enable_floppy=1 - tmpsec = $3c - reqsec = $3d + tmpsec = $3c + reqsec = $3d .endif ; enable_floppy .if enable_floppy=1 - curtrk = $40 + curtrk = $40 .endif ;enable_floppy - command = $42 ;ProDOS constant - unit = $43 ;ProDOS constant - adrlo = $44 ;ProDOS constant - adrhi = $45 ;ProDOS constant - bloklo = $46 ;ProDOS constant - blokhi = $47 ;ProDOS constant + command = $42 ;ProDOS constant + unit = $43 ;ProDOS constant + adrlo = $44 ;ProDOS constant + adrhi = $45 ;ProDOS constant + bloklo = $46 ;ProDOS constant + blokhi = $47 ;ProDOS constant .if aligned_read=0 - secsize = $46 - secsize1 = $47 - secsize2 = $48 + secsize = $46 + secsize1 = $47 + secsize2 = $48 .endif ;aligned_read .if might_exist=1 - status = $f3 ;returns non-zero on error + status = $f3 ;returns non-zero on error .endif ;might_exist .if allow_aux=1 - auxreq = $f4 ;set to 1 to read/write aux memory, else main memory is used + auxreq = $f4 ;set to 1 to read/write aux memory, else main memory is used .endif ;allow_aux - sizelo = $f5 ;set if enable_write=1 and writing - sizehi = $f6 ;set if enable_write=1 and writing - entries = $f7 ;(internal) total number of entries - reqcmd = $f8 ;set (read/write) if enable_write=1 - ;if allow_multi=1, bit 7 selects floppy drive in current slot (clear=drive 1, set=drive 2) - ldrlo = $f9 ;set to load address if override_adr=1 - ldrhi = $fa ;set to load address if override_adr=1 - namlo = $fb ;name of file to access - namhi = $fc ;name of file to access + sizelo = $f5 ;set if enable_write=1 and writing + sizehi = $f6 ;set if enable_write=1 and writing + entries = $f7 ;(internal) total number of entries + reqcmd = $f8 ;set (read/write) if enable_write=1 + ;if allow_multi=1, bit 7 selects floppy drive in current slot (clear=drive 1, set=drive 2) + ldrlo = $f9 ;set to load address if override_adr=1 + ldrhi = $fa ;set to load address if override_adr=1 + namlo = $fb ;name of file to access + namhi = $fc ;name of file to access .if enable_floppy=1 - step = $fd ;(internal) state for stepper motor - tmptrk = $fe ;(internal) temporary copy of current track - phase = $ff ;(internal) current phase for seek + step = $fd ;(internal) state for stepper motor + tmptrk = $fe ;(internal) temporary copy of current track + phase = $ff ;(internal) current phase for seek .if enable_write=1 .if load_high=1 - reloc = $d000 ;$300 bytes code, $100 bytes data - dirbuf = reloc+$400 - encbuf = dirbuf+$200 + reloc = $d000 ;$300 bytes code, $100 bytes data + dirbuf = reloc+$400 + encbuf = dirbuf+$200 .else ;load_high - reloc = $bc00 ;$300 bytes code, $100 bytes data - dirbuf = reloc-$200 - encbuf = dirbuf-$100 + reloc = $bc00 ;$300 bytes code, $100 bytes data + dirbuf = reloc-$200 + encbuf = dirbuf-$100 .endif ;load_high .else ;enable_write .if load_high=1 - reloc = $d000 ;$200 bytes code, $100 bytes data - dirbuf = reloc+$300 + reloc = $d000 ;$200 bytes code, $100 bytes data + dirbuf = reloc+$300 .else ;load_high - reloc = $bd00 ;$200 bytes code, $100 bytes data - dirbuf = reloc-$200 + reloc = $bd00 ;$200 bytes code, $100 bytes data + dirbuf = reloc-$200 .endif ;load_high .endif ;enable_write .else ;enable_floppy .if load_high=1 - reloc = $d000 ;$200 bytes code + reloc = $d000 ;$200 bytes code .if aligned_read=0 - dirbuf = reloc+$200 + dirbuf = reloc+$200 .else ;aligned_read - dirbuf = reloc+$100 + dirbuf = reloc+$100 .endif ;aligned_read .else ;load_high - reloc = $be00 ;$200 bytes code + reloc = $be00 ;$200 bytes code .if aligned_read=0 - dirbuf = reloc-$200 + dirbuf = reloc-$200 .else ;aligned_read - dirbuf = reloc-$100 + dirbuf = reloc-$100 .endif ;aligned_read .endif ;load_high .endif ;enable_floppy @@ -167,7 +171,7 @@ init: .endif ;poll_drive stx unrread4+1 stx unrread5+1 - .if check_checksum=1 { + .if check_checksum=1 stx unrread6+1 .endif ;check_checksum .endif ;enable_floppy @@ -182,183 +186,200 @@ init: ldx $200 dex stx sizelo -.if 0 - bmi +++ -readblock jsr MLI - !byte $80 - !word x80_parms + bmi readblock_plus_three ; +++ - lda #<(readbuff+4) - sta bloklo - lda #>(readbuff+4) - sta blokhi -inextent ldy #0 - lda (bloklo), y - pha - and #$d0 +readblock: + jsr MLI + .byte $80 + .word x80_parms - ;watch for subdirectory entries + lda #<(readbuff+4) + sta bloklo + lda #>(readbuff+4) + sta blokhi +inextent: + ldy #0 + lda (bloklo), Y + pha + and #$d0 - cmp #$d0 - bne + + ; watch for subdirectory entries - lda (bloklo), y - and #$0f - tax - iny --- lda (bloklo), y - cmp (namlo), y - beq ifoundname + cmp #$d0 + bne readblock_plus_one ; + - ;match failed, move to next directory in this block, if possible + lda (bloklo), Y + and #$0f + tax + iny +readblock_minus_two: ; -- + lda (bloklo), Y + cmp (namlo), Y + beq ifoundname -- -+ pla - clc - lda bloklo - adc #$27 - sta bloklo - bcc + + ; match failed, move to next directory in this block, if possible - ;there can be only one page crossed, so we can increment instead of adc +readblock_minus_one: ; - +readblock_plus_one: ; + + pla + clc + lda bloklo + adc #$27 + sta bloklo + bcc readblock_plus_two ; + - inc blokhi -+ cmp #<(readbuff+$1ff) ;4+($27*$0d) - lda blokhi - sbc #>(readbuff+$1ff) - bcc inextent + ; there can be only one page crossed, so we can increment instead of adc - ;read next directory block when we reach the end of this block + inc blokhi +readblock_plus_two: ; + + cmp #<(readbuff+$1ff) ;4+($27*$0d) + lda blokhi + sbc #>(readbuff+$1ff) + bcc inextent - lda readbuff+2 - ldx readbuff+3 - bcs + + ; read next directory block when we reach the end of this block -ifoundname iny - dex - bne -- - lda (namlo), y - cmp #'/' - bne - - tya - eor #$ff - adc sizelo - sta sizelo - clc - tya - adc namlo - sta namlo - pla - and #$20 - bne ++ - ldy #KEY_POINTER+1 - lda (bloklo), y - tax - dey - lda (bloklo), y -!if enable_floppy=1 { - sta unrblocklo+1 - stx unrblockhi+1 -} ;enable_floppy - sta unrhddblocklo+1 - stx unrhddblockhi+1 -+ sta x80_parms+4 - stx x80_parms+5 -++ lda sizelo - bne readblock + lda readbuff+2 + ldx readbuff+3 + bcs readblock_plus_four ; + -+++ pla - lsr - lsr - lsr - tax - lsr - ora #$c0 - ldy $bf11, x - cpy #$c8 ;max slot+1 - bcs set_slot - tya -set_slot sta slot+2 - sta unrentry+2 -!if enable_floppy=1 { - ldx #>unrelocdsk - ldy #unrelochdd - ldy #((bit2tbl-opendir)+$ff) - ldy #0 -- lda (bloklo), y -reladr sta reloc, y - iny - bne - - inc blokhi - inc reladr+2 - dex - bne - - plp - bne ++ - ldx #$16 --- stx bloklo - txa - asl - bit bloklo - beq + - ora bloklo - eor #$ff - and #$7e +readblock_plus_three: ; +++ + pla + lsr + lsr + lsr + tax + lsr + ora #$c0 + ldy $bf11, x + cpy #$c8 ; max slot+1 + bcs set_slot + tya +set_slot: + sta slot+2 + sta unrentry+2 +.if enable_floppy=1 + ldx #>unrelocdsk + ldy #unrelochdd + ldy #((bit2tbl-opendir)+$ff) + ldy #0 +copydrv_minus_one: ; - + lda (bloklo), Y +reladr: + sta reloc, Y + iny + bne copydrv_minus_one ; - + inc blokhi + inc reladr+2 + dex + bne copydrv_minus_one ; - + plp + bne ++ + ldx #$16 +copydrv_minus_two: ; -- + stx bloklo + txa + asl + bit bloklo + beq + + ora bloklo + eor #$ff + and #$7e - bcs + - lsr - bne - - tya - sta nibtbl-$16, x - !if enable_write=1 { - txa - ora #$80 - sta xlattbl, y - } ;enable_write - iny + lsr + bne - + tya + sta nibtbl-$16, x + .if enable_write=1 + txa + ora #$80 + sta xlattbl, y + .endif ;enable_write + iny + inx - bpl -- + bpl copydriv_minus_two ; -- ++ rts -} else { ;enable_floppy -slot lda $cfff - sta unrentry+1 - !if load_high=1 { - !if lc_bank=1 { - lda LCBANK2 - lda LCBANK2 - } else { ;lc_bank - lda ROMIN - lda ROMIN - } ;lc_bank - } ;load_high - ldy #0 -- lda unrelochdd, y - sta reloc, y - lda unrelochdd+$100, y - sta reloc+$100, y - iny - bne - - rts -} ;enable_floppy -.endif +.else ; enable_floppy +slot: + lda $cfff + sta unrentry+1 + .if load_high=1 + .if lc_bank=1 + lda LCBANK2 + lda LCBANK2 + .else ; { ;lc_bank + lda ROMIN + lda ROMIN + .endif ;lc_bank + .endif ;load_high + ldy #0 +slot_minus_one: ; - + lda unrelochdd, Y + sta reloc, y + lda unrelochdd+$100, Y + sta reloc+$100, Y + iny + bne slot_minus_one + rts +.endif ;enable_floppy + c7_parms: .byte 1 @@ -367,725 +388,744 @@ c7_parms: x80_parms: .byte 3, $d1 .word readbuff, 2 -.if 0 -!if enable_floppy=1 { -unrelocdsk -!pseudopc reloc { + +.if enable_floppy=1 +unrelocdsk: + +;!pseudopc reloc { +reloc = $D000 opendir ;read volume directory key block unrblocklo=unrelocdsk+(*-reloc) - ldx #2 + ldx #2 unrblockhi=unrelocdsk+(*-reloc) - lda #0 - jsr readdirsel + lda #0 + jsr readdirsel - ;include volume directory header in count + ;include volume directory header in count readdir !if might_exist=1 { - ldx dirbuf+37 - inx - stx entries + ldx dirbuf+37 + inx + stx entries } ;might_exist firstent lda #<(dirbuf+4) - sta bloklo - lda #>(dirbuf+4) - sta blokhi + sta bloklo + lda #>(dirbuf+4) + sta blokhi nextent ldy #0 !if might_exist=1 { - sty status + sty status } ;might_exist - lda (bloklo), y + lda (bloklo), y !if (might_exist+allow_subdir)>0 { - and #$f0 + and #$f0 !if might_exist=1 { - ;skip deleted entries without counting + ;skip deleted entries without counting - beq ++ + beq ++ } ;might_exist } ;might_exist or allow_subdir !if allow_subdir=1 { - ;subdirectory entries are seedlings - ;but we need to distinguish between them later + ;subdirectory entries are seedlings + ;but we need to distinguish between them later - cmp #$d0 - beq savetype + cmp #$d0 + beq savetype } ;allow_subdir - ;watch for seedling and saplings only + ;watch for seedling and saplings only - cmp #$30 - bcs + + cmp #$30 + bcs + - ;remember type + ;remember type savetype !if allow_subdir=1 { - asl - asl + asl + asl } else { ;allow_subdir - cmp #$20 + cmp #$20 } ;allow_subdir - php + php - ;match name lengths before attempting to match names + ;match name lengths before attempting to match names - lda (bloklo), y - and #$0f - tax - inx - !byte $2c + lda (bloklo), y + and #$0f + tax + inx + !byte $2c - lda (bloklo), y - cmp (namlo), y - beq foundname + cmp (namlo), y + beq foundname - ;match failed, check if any directory entries remain + ;match failed, check if any directory entries remain - plp + plp + !if might_exist=1 { - dec entries - bne ++ + dec entries + bne ++ nodisk unrdrvoff1=unrelocdsk+(*-reloc) - lda MOTOROFF - inc status - rts + lda MOTOROFF + inc status + rts } ;might_exist - ;move to next directory in this block, if possible + ;move to next directory in this block, if possible ++ clc - lda bloklo - adc #$27 - sta bloklo - bcc + + lda bloklo + adc #$27 + sta bloklo + bcc + - ;there can be only one page crossed, so we can increment instead of adc + ;there can be only one page crossed, so we can increment instead of adc - inc blokhi + inc blokhi + cmp #<(dirbuf+$1ff) ;4+($27*$0d) - lda blokhi - sbc #>(dirbuf+$1ff) - bcc nextent + lda blokhi + sbc #>(dirbuf+$1ff) + bcc nextent - ;read next directory block when we reach the end of this block + ;read next directory block when we reach the end of this block - ldx dirbuf+2 - lda dirbuf+3 - jsr readdirsec - bne firstent + ldx dirbuf+2 + lda dirbuf+3 + jsr readdirsec + bne firstent foundname iny - dex - bne - - stx entries + dex + bne - + stx entries !if enable_write=1 { - ldy reqcmd - cpy #cmdwrite ;control carry instead of zero - bne + + ldy reqcmd + cpy #cmdwrite ;control carry instead of zero + bne + - ;round requested size up to nearest sector if writing - ;or nearest block if using aligned reads + ;round requested size up to nearest sector if writing + ;or nearest block if using aligned reads - lda sizelo + lda sizelo !if aligned_read=0 { - beq + - inc sizehi + beq + + inc sizehi } else { ;aligned_read - ldx sizehi - jsr round - sta sizehi + ldx sizehi + jsr round + sta sizehi } ;aligned_read + } ;enable_write - ;cache EOF (file size, loaded backwards) + ;cache EOF (file size, loaded backwards) - ldy #EOF+1 - lda (bloklo), y + ldy #EOF+1 + lda (bloklo), y !if (enable_write+aligned_read)>0 { - tax + tax } else { ;enable_write or aligned_read - sta sizehi + sta sizehi } ;enable_write or aligned_read - dey - lda (bloklo), y + dey + lda (bloklo), y !if (enable_write+aligned_read)>0 { - ;round file size up to nearest sector if writing without aligned reads - ;or nearest block if using aligned reads + ;round file size up to nearest sector if writing without aligned reads + ;or nearest block if using aligned reads !if aligned_read=0 { - bcc ++ - beq + - inx - lda #0 + bcc ++ + beq + + inx + lda #0 } else { ;aligned_read !if enable_write=1 { - jsr round - tax + jsr round + tax } else { ;enable_write - adc #$fe - txa - adc #1 - and #$fe + adc #$fe + txa + adc #1 + and #$fe } ;enable_write } ;aligned_read - ;set requested size to min(length, requested size) + ;set requested size to min(length, requested size) !if enable_write=1 { + cpx sizehi - bcs + + bcs + ++ stx sizehi + } else { ;enable_write - sta sizehi + sta sizehi } ;enable_write } ;enable_write or aligned_read !if aligned_read=0 { - sta sizelo + sta sizelo } ;aligned_read - ;cache AUX_TYPE (load offset for binary files) + ;cache AUX_TYPE (load offset for binary files) !if override_adr=0 { !if allow_subdir=1 { - pla - tax + pla + tax } else { ;allow_subdir - plp + plp } ;allow_subdir - ldy #AUX_TYPE - lda (bloklo), y - pha - iny - lda (bloklo), y - pha + ldy #AUX_TYPE + lda (bloklo), y + pha + iny + lda (bloklo), y + pha !if allow_subdir=1 { - txa - pha + txa + pha } ;allow_subdir } ;override_adr - ;cache KEY_POINTER + ;cache KEY_POINTER - ldy #KEY_POINTER - lda (bloklo), y - tax - sta dirbuf - iny - lda (bloklo), y - sta dirbuf+256 + ldy #KEY_POINTER + lda (bloklo), y + tax + sta dirbuf + iny + lda (bloklo), y + sta dirbuf+256 - ;read index block in case of sapling + ;read index block in case of sapling !if allow_subdir=1 { - plp - bpl rdwrfile - php - jsr readdirsec - plp + plp + bpl rdwrfile + php + jsr readdirsec + plp } else { ;allow_subdir !if override_adr=1 { - plp + plp } ;override_adr - bcc rdwrfile - jsr readdirsec + bcc rdwrfile + jsr readdirsec } ;allow_subdir - ;restore load offset + ;restore load offset rdwrfile !if override_adr=1 { - ldx ldrhi - lda ldrlo + ldx ldrhi + lda ldrlo } else { ;override_adr - pla - tax - pla + pla + tax + pla } ;override_adr !if allow_subdir=1 { - ;check file type and fake size and load address for subdirectories + ;check file type and fake size and load address for subdirectories - bcc + - ldy #2 - sty sizehi - ldx #>dirbuf - lda #dirbuf + lda #dirbuf - sty adrhi + sty adrhi !if aligned_read=0 { - ldy #2 - sty secsize2 + ldy #2 + sty secsize2 } ;aligned_read - ldy #cmdread - sty command + ldy #cmdread + sty command - ;convert block number to track/sector + ;convert block number to track/sector seekrdwr unrdrvon2=unrelocdsk+(*-reloc) - ldy MOTORON - lsr - txa - ror - lsr - lsr - sta phase - txa - and #3 - php - asl - plp - rol - sta reqsec + ldy MOTORON + lsr + txa + ror + lsr + lsr + sta phase + txa + and #3 + php + asl + plp + rol + sta reqsec !if aligned_read=0 { - ;set read size to min(first size, $100) and then read address + ;set read size to min(first size, $100) and then read address - ldy #0 - lda secsize2 - bne + - ldy secsize1 + ldy #0 + lda secsize2 + bne + + ldy secsize1 + sty secsize - dec secsize2 + dec secsize2 } ;aligned_read - jsr readadr + jsr readadr - ;if track does not match, then seek + ;if track does not match, then seek - ldx curtrk - cpx phase - beq checksec - jsr seek + ldx curtrk + cpx phase + beq checksec + jsr seek - ;force sector mismatch + ;force sector mismatch - lda #$ff + lda #$ff - ;match or read/write sector + ;match or read/write sector checksec jsr cmpsec !if aligned_read=0 { - ;return if less than one sector requested + ;return if less than one sector requested - tya - bne readret + tya + bne readret - ;return if only one sector requested + ;return if only one sector requested - lda secsize1 - cmp secsize2 - beq readret - sta secsize + lda secsize1 + cmp secsize2 + beq readret + sta secsize } ;aligned_read - inc reqsec - inc reqsec + inc reqsec + inc reqsec - ;force sector mismatch + ;force sector mismatch -cmpsecrd lda #$ff +cmpsecrd: + lda #$ff -cmpsec - !if enable_write=1 { - ldy command - cpy #cmdwrite ;we need Y=2 below - beq encsec - } ;enable_write -cmpsec2 cmp reqsec - beq readdata - jsr readadr - beq cmpsec2 +cmpsec: + .if enable_write=1 + ldy command + cpy #cmdwrite ;we need Y=2 below + beq encsec + .endif ; enable_write +cmpsec2: + cmp reqsec + beq readdata + jsr readadr + beq cmpsec2 - ;read sector data + ; read sector data -readdata jsr readd5aa - eor #$ad ;zero A if match -;; bne * ;lock if read failure +readdata: + jsr readd5aa + eor #$ad ;zero A if match +;; bne * ;lock if read failure unrread4=unrelocdsk+(*-reloc) -- ldx Q6L - bpl - - eor nibtbl-$96, x - sta bit2tbl-$aa, y - iny - bne - + +readdata_minus_one: ; - + ldx Q6L + bpl readdata_minus_one ; - + eor nibtbl-$96, X + sta bit2tbl-$aa, Y + iny + bne readdata_minus_one ; - unrread5=unrelocdsk+(*-reloc) --- ldx Q6L - bpl -- - eor nibtbl-$96, x - sta (adrlo), y ;the real address - iny - !if check_checksum=1 { - !if aligned_read=0 { - bne check_end - } else { ;aligned_read - bne -- - } ;aligned_read + +readdata_minus_two: ; -- + ldx Q6L + bpl readdata_minus_two ; -- + eor nibtbl-$96, X + sta (adrlo), Y ; the real address + iny + .if check_checksum=1 + .if aligned_read=0 + bne check_end + .else ;aligned_read + bne readdata_minus_two ; -- + .endif ;aligned_read + unrread6=unrelocdsk+(*-reloc) -- ldx Q6L - bpl - - eor nibtbl-$96, x - bne cmpsecrd - } ;check_checksum - !if aligned_read=0 { -check_end - cpy secsize - bne -- - ldy #0 - } ;aligned_read + +readdata_minus_three: ; - + ldx Q6L + bpl readdata_minus_three ; - + eor nibtbl-$96, X + bne cmpsecrd + .endif ;check_checksum + + .if aligned_read=0 +check_end: + cpy secsize + bne readdata_minus_two ; -- + ldy #0 + .endif ;aligned_read -- ldx #$a9 - inx - beq -- - lda (adrlo), y - lsr bit2tbl-$aa, x - rol - lsr bit2tbl-$aa, x - rol - sta (adrlo), y - iny - !if aligned_read=0 { - cpy secsize - } ;aligned_read - bne - + beq -- + lda (adrlo), y + lsr bit2tbl-$aa, x + rol + lsr bit2tbl-$aa, x + rol + sta (adrlo), y + iny + .if aligned_read=0 + cpy secsize + .endif ;aligned_read + bne - readret inc adrhi - rts + rts - !if enable_write=1 { -encsec + .if enable_write=1 +encsec: -- ldx #$aa - dey - lda (adrlo), y - lsr - rol bit2tbl-$aa, x - lsr - rol bit2tbl-$aa, x - sta encbuf, y - lda bit2tbl-$aa, x - and #$3f - sta bit2tbl-$aa, x - inx - bne - - tya - bne -- + lda (adrlo), y + lsr + rol bit2tbl-$aa, x + lsr + rol bit2tbl-$aa, x + sta encbuf, y + lda bit2tbl-$aa, x + and #$3f + sta bit2tbl-$aa, x + inx + bne - + tya + bne -- -cmpsecwr jsr readadr - cmp reqsec - bne cmpsecwr +cmpsecwr: + jsr readadr + cmp reqsec + bne cmpsecwr - ;skip tail #$DE #$AA #$EB some #$FFs ... + ;skip tail #$DE #$AA #$EB some #$FFs ... - ldy #$24 + ldy #$24 - dey - bpl - + bpl - - ;write sector data + ;write sector data unrslot1=unrelocdsk+(*-reloc) - ldx #$d1 - lda Q6H, x ;prime drive - lda Q7L, x ;required by Unidisk - tya - sta Q7H, x - ora Q6L, x + ldx #$d1 + lda Q6H, x ;prime drive + lda Q7L, x ;required by Unidisk + tya + sta Q7H, x + ora Q6L, x - ;40 cycles + ;40 cycles - ldy #4 ;2 cycles - cmp $ea ;3 cycles - cmp ($ea,x) ;6 cycles + ldy #4 ;2 cycles + cmp $ea ;3 cycles + cmp ($ea,x) ;6 cycles - jsr writenib1 ;(29 cycles) - ;+6 cycles - dey ;2 cycles - bne - ;3 cycles if taken, 2 if not + ;+6 cycles + dey ;2 cycles + bne - ;3 cycles if taken, 2 if not - ;36 cycles - ;+10 cycles - ldy #(prolog_e-prolog) ;2 cycles - cmp $ea ;3 cycles + ;36 cycles + ;+10 cycles + ldy #(prolog_e-prolog) ;2 cycles + cmp $ea ;3 cycles - lda prolog-1, y ;4 cycles - jsr writenib3 ;(17 cycles) + jsr writenib3 ;(17 cycles) - ;32 cycles if branch taken - ;+6 cycles - dey ;2 cycles - bne - ;3 cycles if taken, 2 if not + ;32 cycles if branch taken + ;+6 cycles + dey ;2 cycles + bne - ;3 cycles if taken, 2 if not - ;36 cycles on first pass - ;+10 cycles - tya ;2 cycles - ldy #$56 ;2 cycles + ;36 cycles on first pass + ;+10 cycles + tya ;2 cycles + ldy #$56 ;2 cycles - eor bit2tbl-1, y ;5 cycles - tax ;2 cycles - lda xlattbl, x ;4 cycles + tax ;2 cycles + lda xlattbl, x ;4 cycles unrslot2=unrelocdsk+(*-reloc) - ldx #$d1 ;2 cycles - sta Q6H, x ;5 cycles - lda Q6L, x ;4 cycles + ldx #$d1 ;2 cycles + sta Q6H, x ;5 cycles + lda Q6L, x ;4 cycles - ;32 cycles if branch taken + ;32 cycles if branch taken - lda bit2tbl-1, y ;5 cycles - dey ;2 cycles - bne - ;3 cycles if taken, 2 if not + lda bit2tbl-1, y ;5 cycles + dey ;2 cycles + bne - ;3 cycles if taken, 2 if not - ;32 cycles - ;+9 cycles - clc ;2 cycles + ;32 cycles + ;+9 cycles + clc ;2 cycles -- eor encbuf, y ;4 cycles -- tax ;2 cycles - lda xlattbl, x ;4 cycles +- tax ;2 cycles + lda xlattbl, x ;4 cycles unrslot3=unrelocdsk+(*-reloc) - ldx #$d1 ;2 cycles - sta Q6H, x ;5 cycles - lda Q6L, x ;4 cycles - bcs + ;3 cycles if taken, 2 if not + ldx #$d1 ;2 cycles + sta Q6H, x ;5 cycles + lda Q6L, x ;4 cycles + bcs + ;3 cycles if taken, 2 if not - ;32 cycles if branch taken + ;32 cycles if branch taken - lda encbuf, y ;4 cycles - iny ;2 cycles - bne -- ;3 cycles if taken, 2 if not + lda encbuf, y ;4 cycles + iny ;2 cycles + bne -- ;3 cycles if taken, 2 if not - ;32 cycles - ;+10 cycles - sec ;2 cycles - bcs - ;3 cycles + ;32 cycles + ;+10 cycles + sec ;2 cycles + bcs - ;3 cycles - ;32 cycles - ;+3 cycles + ;32 cycles + ;+3 cycles + ldy #(epilog_e-epilog) ;2 cycles - cmp ($ea,x) ;6 cycles + cmp ($ea,x) ;6 cycles - lda epilog-1, y ;4 cycles - jsr writenib3 ;(17 cycles) + jsr writenib3 ;(17 cycles) - ;32 cycles if branch taken - ;+6 cycles - dey ;2 cycles - bne - ;3 cycles if branch taken, 2 if not + ;32 cycles if branch taken + ;+6 cycles + dey ;2 cycles + bne - ;3 cycles if branch taken, 2 if not - lda Q7L, x - lda Q6L, x ;flush final value - inc adrhi - rts + lda Q7L, x + lda Q6L, x ;flush final value + inc adrhi + rts -writenib1 cmp ($ea,x) ;6 cycles -writenib2 cmp ($ea,x) ;6 cycles -writenib3 +writenib1: + cmp ($ea,X) ; 6 cycles +writenib2: + cmp ($ea,X) ; 6 cycles +writenib3: unrslot4=unrelocdsk+(*-reloc) - ldx #$d1 ;2 cycles -writenib4 sta Q6H, x ;5 cycles - ora Q6L, x ;4 cycles - rts ;6 cycles + ldx #$d1 ; 2 cycles +writenib4: + sta Q6H, X ; 5 cycles + ora Q6L, X ; 4 cycles + rts ; 6 cycles -prolog !byte $ad, $aa, $d5 -prolog_e -epilog !byte $ff, $eb, $aa, $de -epilog_e - } ;enable_write +prolog: + .byte $ad, $aa, $d5 +prolog_e: +epilog: + .byte $ff, $eb, $aa, $de +epilog_e: +.endif ;enable_write bit2tbl = (*+255) & -256 nibtbl = bit2tbl+86 !if enable_write=1 { @@ -1095,20 +1135,20 @@ dataend = xlattbl+64 dataend = nibtbl+106 } ;enable_write ;hack to error out when code is too large for current address - !if reloc<$c000 { - !if dataend>$c000 { - !serious "code is too large" - } - } else { - !if relocdirbuf { - !serious "code is too large" - } - } - } -} ;enable_floppy -} ;reloc -.endif + .if reloc<$c000 + .if dataend>$c000 + .error "code is too large" + .endif + .else + .if relocdirbuf + .error "code is too large" + .endif + .endif + .endif +.endif ;enable_floppy +;.endif ;reloc + unrelochdd: .org reloc ; !pseudopc reloc { @@ -1123,12 +1163,12 @@ unrhddblockhi=unrelochdd+(*-reloc) .if enable_floppy=1 .if (*-hddopendir) < (readdir-opendir) - ;essential padding to match offset with floppy version + ;essential padding to match offset with floppy version .res (readdir-opendir)-(*-hddopendir), $ea ; .fill .endif .endif ;enable_floppy - ;include volume directory header in count + ;include volume directory header in count hddreaddir: .if might_exist=1 @@ -1151,9 +1191,9 @@ hddnextent: and #$f0 .if might_exist=1 - ;skip deleted entries without counting + ;skip deleted entries without counting - beq ++ + beq hddst_plus_two ; ++ .endif ;might_exist .endif ;might_exist or allow_subdir @@ -1168,7 +1208,7 @@ hddnextent: ;watch for seedling and saplings only cmp #$30 - bcs + + bcs hddst_plus_one ; + ;remember type @@ -1188,7 +1228,7 @@ hddsavetype: tax inx .byte $2c --: +hddst_minus_one: ; - lda (bloklo), Y cmp (namlo), y beq hddfoundname @@ -1196,27 +1236,27 @@ hddsavetype: ;match failed, check if any directory entries remain plp -+: +hddst_plus_one: ; + .if might_exist=1 dec entries - bne ++ + bne hddst_plus_two ; ++ inc status rts .endif ;might_exist ;move to next directory in this block, if possible -++: +hddst_plus_two: ; __ ++ clc lda bloklo adc #$27 sta bloklo - bcc + + bcc hddst_plus_three ; + ;there can be only one page crossed, so we can increment instead of adc inc blokhi -+: +hddst_plus_three: ; + cmp #<(dirbuf+$1ff) ;4+($27*$0d) lda blokhi sbc #>(dirbuf+$1ff) @@ -1232,13 +1272,13 @@ hddsavetype: hddfoundname: iny dex - bne - + bne hddst_minus_one ; - stx entries .if enable_write=1 ldy reqcmd cpy #cmdwrite ;control carry instead of zero - bne + + bne hddst_plus_four ;round requested size up to nearest block if writing @@ -1249,10 +1289,10 @@ hddfoundname: .if aligned_read=0 sec .endif ;aligned_read -+: +hddst_plus_four: ; + .endif ;enable_write - ;cache EOF (file size, loaded backwards) + ;cache EOF (file size, loaded backwards) ldy #EOF+1 lda (bloklo), Y @@ -1265,7 +1305,7 @@ hddfoundname: lda (bloklo), Y .if (enable_write+aligned_read)>0 .if aligned_read=0 - bcc ++ + bcc hddst_plus_five ; ++ .endif ;aligned_read ;round file size up to nearest block if writing or using aligned reads @@ -1280,10 +1320,10 @@ hddfoundname: ;set requested size to min(length, requested size) cpx sizehi - bcs + -++: + bcs hddst_plus_six +hddst_plus_five: ; ++ stx sizehi -+: +hddst_plus_six: ; + .else ;enable_write adc #$fe txa @@ -1296,200 +1336,205 @@ hddfoundname: sta sizelo .endif ;aligned_read - ;cache AUX_TYPE (load offset for binary files) + ;cache AUX_TYPE (load offset for binary files) .if override_adr=0 .if allow_subdir=1 - pla - tax + pla + tax .else ;allow_subdir - plp + plp .endif ;allow_subdir - ldy #AUX_TYPE - lda (bloklo), y - pha - iny - lda (bloklo), y - pha - .if allow_subdir=1 { - txa - pha + ldy #AUX_TYPE + lda (bloklo), Y + pha + iny + lda (bloklo), Y + pha + .if allow_subdir=1 + txa + pha .endif ;allow_subdir .endif ;override_adr - ;cache KEY_POINTER + ;cache KEY_POINTER - ldy #KEY_POINTER - lda (bloklo), y - tax - sta dirbuf - iny - lda (bloklo), y - sta dirbuf+256 + ldy #KEY_POINTER + lda (bloklo), Y + tax + sta dirbuf + iny + lda (bloklo), Y + sta dirbuf+256 - ;read index block in case of sapling + ; read index block in case of sapling .if allow_subdir=1 - plp - bpl hddrdwrfile - php - jsr hddreaddirsec - plp + plp + bpl hddrdwrfile + php + jsr hddreaddirsec + plp .else ;allow_subdir .if override_adr=1 - plp + plp .endif ;override_adr - bcc hddrdwrfile - jsr hddreaddirsec + bcc hddrdwrfile + jsr hddreaddirsec .endif ;allow_subdir - ;restore load offset + ;restore load offset hddrdwrfile: .if override_adr=1 - ldx ldrhi - lda ldrlo + ldx ldrhi + lda ldrlo .else ;override_adr - pla - tax - pla + pla + tax + pla .endif ;override_adr .if allow_subdir=1 - ;check file type and fake size and load address for subdirectories + ;check file type and fake size and load address for subdirectories - bcc + - ldy #2 - sty sizehi - ldx #>dirbuf - lda #dirbuf + lda #dirbuf - sta adrhi - lda #0 - sta adrlo -+ php + lda sizehi + cmp #2 + bcs hdd_rdwr_plus_two ; + + pha + lda #2 + sta sizehi + lda adrhi + pha + lda adrlo + pha + lda #>dirbuf + sta adrhi + lda #0 + sta adrlo +hdd_rdwr_plus_two: ; + + php .endif ;aligned_read - ;fetch data block and read/write it + ;fetch data block and read/write it - ldy entries - inc entries - ldx dirbuf, y - lda dirbuf+256, y + ldy entries + inc entries + ldx dirbuf, Y + lda dirbuf+256, Y .if enable_write=1 - ldy reqcmd + ldy reqcmd .endif ;enable_write - jsr hddseekrdwr + jsr hddseekrdwr .if aligned_read=0 - plp - bcc + + plp + bcc hdd_rdwr_plus_three ; + .endif ;aligned_read - inc adrhi - inc adrhi - dec sizehi - dec sizehi - bne hddrdwrloop + inc adrhi + inc adrhi + dec sizehi + dec sizehi + bne hddrdwrloop .if aligned_read=0 - lda sizelo - bne hddrdwrloop + lda sizelo + bne hddrdwrloop .endif ;aligned_read .if allow_aux=1 hddrdwrdone: - ldx #0 + ldx #0 hddsetaux: - sta CLRAUXRD, x - sta CLRAUXWR, x + sta CLRAUXRD, x + sta CLRAUXWR, x .endif ;allow_aux - rts + rts .if aligned_read=0 -+ pla - sta bloklo - pla - sta blokhi - pla - tay - beq + - dey -- lda (adrlo), y - sta (bloklo), y - iny - bne - - inc blokhi - inc adrhi - bne + -- lda (adrlo), y - sta (bloklo), y - iny -+ cpy sizelo - bne - +hdd_rdwr_plus_three: ; + + pla + sta bloklo + pla + sta blokhi + pla + tay + beq hdd_rdwr_plus_four ; + + dey +hdd_rdwr_minus_one: ; - + lda (adrlo), Y + sta (bloklo), Y + iny + bne hdd_rdwr_minus_one + inc blokhi + inc adrhi + bne hdd_rdwr_plus_four ; + +hdd_rdwr_minus_two: ; - + lda (adrlo), Y + sta (bloklo), Y + iny +hdd_rdwr_plus_four: ; + + cpy sizelo + bne hdd_rdwr_minus_two ; - .if allow_aux=1 - beq hddrdwrdone + beq hddrdwrdone .else ;allow_aux - rts + rts .endif ;allow_aux .endif ;aligned_read .if enable_write=1 hddround: - clc - adc #$ff - txa - adc #1 - and #$fe - rts + clc + adc #$ff + txa + adc #1 + and #$fe + rts .endif ;enable_write hddreaddirsel: - ldy #0 - sty adrlo + ldy #0 + sty adrlo .if might_exist=1 - sty status + sty status .endif ;might_exist .if allow_multi=1 - asl reqcmd - lsr reqcmd + asl reqcmd + lsr reqcmd .endif ;allow_multi hddreaddirsec: - ldy #>dirbuf - sty adrhi - ldy #cmdread + ldy #>dirbuf + sty adrhi + ldy #cmdread .if enable_write=1 hddseekrdwr: .endif ;enable_write - sty command + sty command .if enable_write=0 hddseekrdwr: .endif ;enable_write - stx bloklo - sta blokhi + stx bloklo + sta blokhi unrunit=unrelochdd+(*-reloc) lda #$d1