4cade/src/prodos.impl.a

;license:MIT
;(c) 2019 by 4am & qkumba
;
; Pseudo-ProDOS environment
;

;------------------------------------------------------------------------------
; 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
;------------------------------------------------------------------------------
packet = first_zp ;word
buffer = first_zp+2 ;word

ProDOS_enter
!set CloseHandles = @imp_close
    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    packet
    jsr    @fetchbyte
    sta    packet+1
    lda    @fetchaddr+2
    pha
    lda    @fetchaddr+1
    pha
    tya
    pha
@request
    lda    #$d1
    cmp    #$80
    beq    @do_readblock
    cmp    #$81
    beq    @do_writeblock
    cmp    #$c4
    beq    @do_getattrib
    cmp    #$c6
    beq    @do_nothing
    cmp    #$c7
    beq    @do_prefix
    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    #$d1
    ;;bne    @do_fatal
@do_eof
    jmp    @imp_eof
@do_readblock
@do_writeblock
    jmp    @imp_rdwrblock
@do_getattrib
    jmp    @imp_getattrib
@do_nothing
    jmp    @restore_zp
@do_prefix
    jmp    @imp_prefix
@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
    jmp    @restore_zp
@do_seek
    jmp    @imp_seek
@do_fatal
    ;;jmp    ProDOS_fatal

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

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

@imp_prefix
    ldx    #buffer
    jsr    @setbuffer1
    ldy    ProDOS_prefix
    iny
    iny
    tya
    pha
    dey
@copy_prefix
    lda    ProDOS_prefix, y
    iny
    sta    (buffer), y
    dey
    dey
    bne    @copy_prefix
    pla
    sta    (buffer), y
    lda    #'/'
    iny
    sta    (buffer), y
    bne    @jmp_zp2

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

@imp_seek
    jsr    @set_rdwrbuff
    lda    #0
    sta    blkidx
    sta    blkofflo
    sta    blkoffhi
    sta    reqcmd
    jsr    @reset
    ldx    sizelo
    beq    @seek64
    sta    sizehi
    sta    sizelo
    jsr    @seekreset
    inc    ldrlo
    bne    @seek64
    inc    ldrhi

@seek64
    lda    ldrhi
    sta    sizehi
    lda    ldrlo
    sta    sizelo
    jsr    @seekreset
    lda    ldrhi
    ora    ldrlo
    bne    @jmp_zp
    dec    blkidx
    beq    @jmp_zp ;always

@seekreset
    jsr    hddrdwrpart
@reset
    lda    #$ff
    sta    blefthi
    sta    bleftlo
    rts

@imp_read
    clc
@imp_write
    php
    lda    #cmdread
    adc    #0
    sta    reqcmd
    jsr    @set_rdwrbuff
    plp
    bcc    @skip_align
    lda    sizelo
    adc    #$fe
    lda    sizehi
    adc    #1
    and    #$fe
    sta    sizehi
    lda    bleftlo
    adc    #$ff
    lda    blefthi
    adc    #1
    and    #$fe
    sta    blefthi

@skip_align
    jsr    hddrdwrpart
    ldy    #6
    lda    sizelo2
    sta    (packet), y
    iny
    lda    sizehi2
    sta    (packet), y
@jmp_zp
    jmp    @restore_zp

@imp_eof
    ldy    #2
    lda    bleftlo
    sta    (packet), y
    iny
    lda    blefthi
    sta    (packet), y
    bcs    @restore_zp ;always

@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
    inx
    stx    dirbufpatch5+2
    stx    dirbufpatch8+2
@close_ret
    rts

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

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

@setbuffer
    lda    (packet), y
    sta    $0,x
    iny
    lda    (packet), y
    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

;------------------------------------------------------------------------------
; traverse [private]
;
; in:    (namlo) points to length-prefixed pathname+filename
; out:   all flags clobbered
;        all registers clobbered
;------------------------------------------------------------------------------
traverse
         +LDAY gRootDirectory
         sta   (reloc + unrhddblocklo - unrelochdd) + 1
         sty   (reloc + unrhddblockhi - unrelochdd) + 1
         sta   @myreadblock+1
         sty   @myreadblock+3        ; reset 'root' directory (saved at program start)

         ;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

@myreadblock
@myx80_parms
         ldx   #2
         lda   #0
         jsr   hddreaddirsel
         lda   #NAME_LENGTH
         sta   bloklo
         lda   #>(hdddirbuf - 1)
         sta   blokhi

         ;there can be only one page crossed, so we can increment here

@mynextent1
         inc   blokhi
@mynextent
         ldy   #0
         lda   (bloklo), y
         pha
         and   #$0f
         tax
--       iny
         lda   (bloklo), y
         cmp   (namlo), y
         beq   @myfoundname

         ;match failed, move to next directory in this block, if possible

-        pla

@myskiphdr
         clc
         lda   bloklo
         adc   #ENTRY_SIZE
         sta   bloklo
         bcs   @mynextent1
         cmp   #$ff ;4 + ($27 * $0d)
         bne   @mynextent

         ;read next directory block when we reach the end of this block

         lda   hdddirbuf + NEXT_BLOCK_LO
         ldx   hdddirbuf + NEXT_BLOCK_HI
         bcs   +

@myfoundname
         dex
         bne   --

         ;parse path until last directory is seen

         iny
         lda   (namlo), y
         cmp   #'/'
         bne   -
         pla
         and   #$20 ;Volume Directory Header XOR subdirectory
         bne   @myskiphdr
         tya
         eor   #$ff
         adc   sizelo
         sta   sizelo
         clc
         tya
         adc   namlo
         sta   namlo

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

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

         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
ProDOS_savedX
        ldx    #$d1
        plp
        clc
        bcc    ProDOS_savedY
  !if * != $bf13 {
    !error "$BF13 misplaced (",*,")"
  }
        !byte  $c1
        !word  $c2d1, $c3d1, $c4d1, $c5d1, $c6d1, $c7d1
ProDOS_savedY
        ldy    #$d1
        sta    $c081
        lda    #0
        rts

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

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=$bfd0
;        !fill  $2e
}
end_promote


;------------------------------------------------------------------------------
; SaveOrRestoreScreenHoles
; preserve screen hole contents across demo execution
; to avoid crashing later on disk access
;
; in:    nothing
; out:   all flags clobbered
;        all registers clobbered
;------------------------------------------------------------------------------

SaveOrRestoreScreenHoles
    lda    #4
    sta    namhi
    ldx    #0
    stx    namlo
    sta    bloklo
--  ldy    #$78
-   lda    (namlo),y
    pha
    lda    holey_stuff,x
holepatch ;sta->lda
    lda    (namlo),y
    pla
    sta    holey_stuff,x
    inx
    tya
    eor    #$80
    tay
    bmi    -
    iny
    bpl    -
    inc    namhi
    dec    bloklo
    bne    --
    rts
holey_stuff
    !fill  64

LoadFileInternal
         +LDADDR gPathname
         +STAY namlo                 ; set filename
         jsr   traverse              ; go to subdirectory, set up filename for read
         lda   #cmdread              ; read (instead of write)
         sta   reqcmd
         lda   #0                    ; 0 = read into main memory
         sta   auxreq
         lda   ldrlo+1
         bne   +                     ; if caller provided a load address, use it
         sta   sizelo                ; otherwise query the load address from file metadata
         sta   sizehi                ; 0 = query load address
         jsr   hddopendir            ; call ProRWTS2
         +LDAY ldrlo2
         +STAY ldrlo
+        lda   #$FF                  ; read entire file (ProRWTS2 will figure out exact size)
         sta   sizehi
         jmp   hddopendir            ; exit via ProRWTS2

LoadDHRFileInternal
         +LDADDR gPathname
         +STAY namlo                 ; set filename
         jsr   traverse              ; go to subdirectory, set up filename for read
         lda   #$00                  ; read first $2000 bytes
         sta   sizelo
         sta   ldrlo
         lda   #$20
         sta   sizehi
         asl
         sta   ldrhi                 ; into $4000
         lda   #1                    ; 1 = read into aux memory
         sta   auxreq
         lda   #cmdread              ; read (instead of write)
         sta   reqcmd
         jsr   hddopendir            ; call ProRWTS2
         lda   #$20                  ; read next $2000 bytes
         sta   sizehi
         asl
         sta   ldrhi                 ; into $4000
         dec   auxreq                ; 0 = read into main memory
         clc                         ; not a subdirectory
         jmp   hddrdwrpart           ; call ProRWTS2

SaveSmallFileInternal
         +LDADDR gPathname
         +STAY namlo                 ; set filename for ProRWTS2
         jsr   traverse              ; go to subdirectory, set up filename for read
         ;;if the write address is always a fixed value then we can discard the query
         lda   #cmdread              ; read (instead of write)
         sta   reqcmd
         lda   #0                    ; 0 = read into main memory
         sta   sizelo
         sta   sizehi                ; 0 = query load address
         jsr   hddopendir            ; call ProRWTS2
         lda   ldrlo2
         sta   ldrlo
         lda   ldrhi2
         sta   ldrhi
         lda   #cmdwrite             ; write (instead of read)
         sta   reqcmd
         sta   sizelo                ; non-zero
         jmp   hddopendir            ; exit via ProRWTS2 (must re-open the file after query)