4cade/src/prodos.impl.lc2.a

;license:MIT
;(c) 2019-2020 by 4am & qkumba
;
; Pseudo-ProDOS environment
;
; /!\ These live in LC RAM 2 and rely on the ProRWTS code which is also in LC RAM 2. /!\

;------------------------------------------------------------------------------
; ProDOS_enter
; intercept certain ProDOS requests
; wrap them to ProRWTS2 file requests
;
; in:    return address+1 is command and pointer to parameter block
; out:   all flags clobbered
;        A=0, X and Y preserved
;        stack set to next instruction after parameters
;------------------------------------------------------------------------------
ipacket = first_zp ;word
buffer = first_zp+2 ;word

ProDOS_enter
!set CloseHandles = @imp_close
!set swap_zpg = @swap_zp
!set SavedZP = @saved_zp
         stx   ProDOS_savedX+1
         sty   ProDOS_savedY+1
         jsr   @swap_zp
         pla
         tay
         pla
         sta   @fetchaddr+1
         pla
         sta   @fetchaddr+2
         jsr   @fetchbyte
         sta   @request+1
         jsr   @fetchbyte
         sta   ipacket
         jsr   @fetchbyte
         sta   ipacket+1
         lda   @fetchaddr+2
         pha
         lda   @fetchaddr+1
         pha
         tya
         pha
         ldy   #2
@request
         lda   #$d1
         cmp   #$40
         beq   @imp_allocint ;;@do_allocint
         cmp   #$41
         beq   @do_deallocint
         cmp   #$65
         beq   @do_quit
         cmp   #$80
         beq   @imp_rdwrblock ;;@do_readblock
         cmp   #$81
         beq   @imp_rdwrblock ;;@do_writeblock
         cmp   #$c0
         beq   @do_create
         cmp   #$c4
         beq   @imp_getattrib ;;@do_getattrib
         cmp   #$c6
         beq   @do_setprefix
         cmp   #$c7
         beq   @do_getprefix
         cmp   #$c8
         beq   @do_open
         cmp   #$ca
         beq   @do_read
         cmp   #$cb
         beq   @do_write
         cmp   #$cc
         beq   @do_close
         cmp   #$ce
         beq   @do_seek
         cmp   #$d0
         beq   @do_seteof
;;         cmp   #$d1
;;       bne   @do_fatal
@do_geteof
         jmp   @imp_geteof
@do_allocint
;;         jmp   @imp_allocint
@do_quit
         jmp   $100
@do_readblock
@do_writeblock
;;         jmp   @imp_rdwrblock
@do_getattrib
;;         jmp   @imp_getattrib
@do_getprefix
         jmp   @imp_getprefix
@do_open
         jmp   @imp_open
@do_read
         jmp   @imp_read
@do_write
         jmp   @imp_write
@do_close
         jsr   @imp_close ;subroutine special case because of dual-use
@do_deallocint ;nothing for now
@do_create     ;nothing for now
@do_setprefix  ;nothing for now
@do_seteof     ;nothing for now
         jmp   @restore_zp
@do_seek
         jmp   @imp_seek
@do_fatal
;;       jmp   ProDOS_fatal

@imp_allocint
         ;;ldy   #2
         lda   (ipacket), y
         sta   ProDOS_irq + 1
         iny
         lda   (ipacket), y
         sta   ProDOS_irq + 2
         lda   #<ProDOS_int
         ldx   #>ProDOS_int
         sta   $3fe
         sta   $fffe
         stx   $3ff
         stx   $ffff
         bne   @jmp_zp2 ;always

@imp_rdwrblock
         and   #$7f
         adc   #0
         sta   @rdwrop+1
         ldx   #$44
         ;;ldy   #2
         jsr   @setbuffer
         lda   (ipacket), y
         tax
         iny
         lda   (ipacket), y
@rdwrop
         ldy   #$d1                  ; SMC
         jsr   hddseekrd+2
         bcc   @jmp_zp2 ;always

@imp_getattrib
         lda   ipacket+1
         pha
         lda   ipacket
         pha
         ldx   #namlo
         jsr   @setbuffer1
         lda   #$60
         sta   attribpatch
         jsr   hddopendir
         lda   #$10
         sta   attribpatch
         pla
         sta   ipacket
         pla
         sta   ipacket+1
         ldy   #5
         lda   ldrlo2
         sta   (ipacket), y
         iny
         lda   ldrlo2+1
         sta   (ipacket), y
         ldy   #$13
         jsr   fetchscratch
         ldy   #9
         sta   (ipacket), y
         txa
         dey
         sta   (ipacket), y
@jmp_zp2
         jmp   @restore_zp

@imp_getprefix
         ldx   #buffer
         jsr   @setbuffer1
         ldy   ProDOS_prefix
         iny
         iny
         tya
         pha
@copy_prefix
         lda   ProDOS_prefix-1, y
         sta   (buffer), y
         dey
         bne   @copy_prefix
         pla
         sta   (buffer), y
         tay
         lda   #'/'
         sta   (buffer), y
         ldy   #1
         sta   (buffer), y
         bne   @jmp_zp2 ;always

@imp_open
         ldx   #namlo
         jsr   @setbuffer1
         inc   @handles+1
@handles
         ldx   #0
         iny
         lda   (ipacket), y
         sta   @handle-1, x
         jsr   @patch_buffer
         iny
         lda   #1
         sta   (ipacket), y
         lsr
         sta   reqcmd
         sta   sizehi
         sta   sizelo
         jsr   hddopendir
         stx   blkidx
         beq   @link_jmpzp ;always

resetval=$f0
@imp_seek
         jsr   @set_rdwrbuff
         ldx   #0
         stx   blkidx
         stx   treeidx
         stx   blkofflo
         stx   blkoffhi
         stx   reqcmd
         ldy   sizelo
         beq   @testzero
@seekloop
         jsr   @reset
         ldy   sizelo
         bne   @seek64
         cmp   ldrhi
         bcc   @seek64
         bne   @seek32
         cpx   ldrlo
         bne   @seek64

@seek32
         lda   ldrhi
         ldx   ldrlo
@seek64
         sta   sizehi
         stx   sizelo
         lda   ldrhi
         pha
         lda   sizehi
         pha
         lda   ldrlo
         pha
         txa
         pha
         tya
         pha
         jsr   @seekreset
         pla
         tay
         sec
         pla
         sta   ldrlo
         pla
         sbc   ldrlo
         sta   ldrlo
         pla
         sta   ldrhi
         pla
         sbc   ldrhi
         sta   ldrhi
@testzero
         tya
         sbc   #0
         sta   sizelo
         ora   ldrlo
         ora   ldrhi
         bne   @seekloop
@link_jmpzp
         jmp   @jmp_zp

@seekreset
         jsr   hddrdwrpart
@reset
         lda   #resetval
         sta   blefthi
         stx   bleftlo
         rts

@imp_read
         clc
@imp_write
         php
         lda   #cmdread
         adc   #0
         sta   reqcmd
         jsr   @set_rdwrbuff
         plp
         bcc   @skip_align
         ldx   #sizelo
         jsr   @round
         lda   #0
         sta   sizelo
         ldx   #bleftlo
         jsr   @round

@skip_align
         jsr   hddrdwrpart
         ldx   #<sizelo2
         ldy   #6

         +HIDE_NEXT_2_BYTES
@imp_geteof
         ldx   #<bleftlo
         ;;ldy   #2
         lda   $0, x
         sta   (ipacket), y
         inx
         iny
         lda   $0, x
         sta   (ipacket), y
@jmp_zp
         jmp   @restore_zp

@imp_close
         lda   @handles+1
         beq   @close_ret
         dec   @handles+1
         bne   @close_ret
         lda   #>hddencbuf

@patch_buffer
         sta   encbufpatch1+1
         sta   encbufpatch2+1
         tax
         inx
         stx   dirbufpatch1+1
         inx
         stx   dirbufpatch2+2
         stx   dirbufpatch3+2
         stx   dirbufpatch4+2
         stx   dirbufpatch6+1
         stx   dirbufpatch7+2
         stx   dirbufpatch9+2
         stx   dirbufpatch10+1
         stx   dirbufpatch11+1
         stx   dirbufpatch12+1
         stx   dirbufpatch13+2
         inx
         stx   dirbufpatch5+2
         stx   dirbufpatch8+2
         stx   dirbufpatch14+2
@close_ret
         rts

@fetchbyte
         inc   @fetchaddr+1
         bne   @fetchaddr
         inc   @fetchaddr+2
@fetchaddr
         lda   $d1d1
         rts

@set_rdwrbuff
         ldy   #1
         lda   (ipacket), y
         tax
         lda   @handle-1, x
         jsr   @patch_buffer
         ldx   #ldrlo
         iny
         jsr   @setbuffer
         ldx   #sizelo
         !byte $2c
@setbuffer1
         ldy   #1

@setbuffer
         lda   (ipacket), y
         sta   $0,x
         iny
         lda   (ipacket), y
         sta   $1,x
         iny
         rts

@round
         clc
         lda   $0,x
         adc   #$ff
         lda   $1,x
         adc   #1
         and   #$fe
         sta   $1,x
         rts

@swap_zp
         ldx   #last_zp-first_zp
@save_zp
         lda   first_zp,x
         ldy   @saved_zp,x
         sta   @saved_zp,x
         sty   first_zp,x
         dex
         bpl   @save_zp
         rts

@restore_zp
         jsr   @swap_zp
         jmp   ProDOS_exit

@handle
         !byte 0, 0 ;only up to two handles at a time

@saved_zp
         !fill (last_zp - first_zp) + 1

resetRoot
gRootDirectory
         +LDADDR 0                   ; SMC
         sta   (reloc + unrhddblocklo - unrelochdd) + 1
         sty   (reloc + unrhddblockhi - unrelochdd) + 1
         rts

;------------------------------------------------------------------------------
; traverse [private]
;
; in:    (namlo) points to length-prefixed pathname+filename
; out:   all flags clobbered
;        all registers clobbered
;------------------------------------------------------------------------------
!ifdef PASS2 {
} else { ;PASS2
  !if * != itraverse {
    !error "itraverse=",*, ", fix constants.a, rebuild prelaunch"
  }
}
traverse
         jsr   resetRoot

         ;search for '/' character in filename

         ldx   #0
         ldy   #0
         lda   (namlo), y
         tay
-        inx
         dey
         bmi   @go                   ; no '/', just do the read
         lda   (namlo), y
         cmp   #'/'
         bne   -
         sty   sizelo
         txa
         pha
         lda   #$B1                  ; LDA (), y
         sta   pathpatch1
         lda   #$68                  ; PLA
         sta   pathpatch2
         lda   #$60                  ; RTS
         sta   pathpatch2 + 1

@myreadblock
         jsr   hddopendir
-        tax

         ;parse path until last directory is seen

         lda   (namlo), y
         cmp   #'/'
         beq   +
--       jsr   pathresume
         bne   -                     ; always taken
+        txa
         bmi   --
         tya
         eor   #$ff
         adc   sizelo
         sta   sizelo
         clc
         tya
         adc   namlo
         sta   namlo
         bcc   +
         inc   namhi
+

         ;cache block number of current directory
         ;as starting position for subsequent searches

         ldy   #(KEY_POINTER + 1)
         lda   (scratchlo), y
         tax
         dey
         lda   (scratchlo), y
         sta   (reloc + unrhddblocklo - unrelochdd) + 1
         stx   (reloc + unrhddblockhi - unrelochdd) + 1
         lda   sizelo
         bne   @myreadblock
         tay

         lda   #$D1                  ; CMP (), y
         sta   pathpatch1
         lda   #$86                  ; STX
         sta   pathpatch2
         lda   #$5A
         sta   pathpatch2 + 1

         pla
         sta   (namlo), y
@go
         rts

;------------------------------------------------------------------------------
; promote [private]
;
; tiny ProDOS-style interface for ProRWTS
; in:    whatever ProDOS expects for the supported functions
; out:   carry clear, A=0
;        X, Y, and other flags clobbered
;------------------------------------------------------------------------------

promote
!pseudopc $bf00 {
        php
        sei
        bit   $c083
        !byte $24
  !if * != $bf06 {
    !error "$BF06 misplaced (",*,")"
  }
        rts ;clock interface, must be RTS on real ProDOS if program uses $20x

        bit   $c083
        jmp   ProDOS_enter
ProDOS_exit
        sta   $c082
        bmi   ProDOS_savedX ;always
  !if * != $bf12 {
    !error "$BF12 misplaced (",*,")"
  }
        !word $c1d1, $c2d1, $c3d1, $c4d1, $c5d1, $c6d1, $c7d1
ProDOS_savedX
        ldx   #$d1
ProDOS_savedY
        ldy   #$d1
        plp
        clc
        lda   #0
        rts

  !if * > $bf30 {
    !error "$BF30 misplaced (",*,")"
  } else {
    !if * != $bf30 {
        !fill $bf30-*
    }
  }
ProDOS_unit
        !byte $d1

ProDOS_int
        pha
        txa
        pha
        tya
        pha
ProDOS_irq
        jsr   $d1d1 ;SMC
        pla
        tay
        pla
        tax
        pla
        bit   $c012
        bmi   +
        lda   $45
+       rti

  !if * > $bf58 {
    !error "code is too large, ends at ", *
  }

ProDOS_fatal ;only for debugging, will be removed
;;      bit   $c081
;;      pha
;;      jsr   $fe89
;;      jsr   $fe93
;;      pla
;;      jsr   $fdda
;;      jmp   $ff65
;;*=$bf58
;;      !fill $18 ;filled by init instead

ProDOS_prefix=gPathname
;       !fill $2e
}
end_promote