prodos-path/path.s

;;; ============================================================
;;;
;;; PATH
;;;
;;; Build with: ca65 - https://cc65.github.io/doc/ca65.html
;;;
;;; ============================================================

        .org $2000

        .include "apple2.inc"
        .include "more_apple2.inc"
        .include "prodos.inc"

;;; ============================================================

cmd_load_addr := $4000
max_cmd_size   = $2000

CASE_MASK = $DF

;;; ============================================================
;;; Install the new command

.proc installer
        ptr := $06

        ;; Save previous external command address
        lda     EXTRNCMD+1
        sta     next_command
        lda     EXTRNCMD+2
        sta     next_command+1

        ;; Request a buffer for handler.
        lda     #handler_pages
        jsr     GETBUFR
        bcc     :+
        lda     #BI_ERR_NO_BUFFERS_AVAILABLE
        rts
:       sta     new_page        ; A = MSB of new page

        ;; Reserve buffer permanently.
        ;; ProDOS Technical Note #9: Buffer Management Using BASIC.SYSTEM
        lda     RSHIMEM
        sec
        sbc     #handler_pages
        sta     RSHIMEM

        ;; Compute move delta in pages
        lda     new_page
        sec
        sbc     #>handler
        sta     page_delta

        ;; Relocatable routine is aligned to page boundary so only MSB changes
        ldx     #0
:       txa
        asl
        tay
        lda     relocation_table+1,y
        sta     ptr
        lda     relocation_table+2,y
        sta     ptr+1

        lda     (ptr)
        clc
        adc     page_delta
        sta     (ptr)
        inx
        cpx     relocation_table
        bne     :-

        ;; Relocate
        lda     #<handler
        sta     MOVE_SRC
        lda     #>handler
        sta     MOVE_SRC+1

        lda     #<handler_end
        sta     MOVE_END
        lda     #>handler_end
        sta     MOVE_END+1

        lda     #0
        sta     MOVE_DST
        lda     new_page
        sta     MOVE_DST+1
        ldy     #0
        jsr     MOVE

        ;; Install new address in external command address
        lda     new_page
        sta     EXTRNCMD+2
        lda     #0
        sta     EXTRNCMD+1

        ;; Complete
        rts

new_page:
        .byte   0

page_delta:
        .byte   0

.endproc

;;; ============================================================
;;;
;;; Relocatable Section
;;;
;;; ============================================================

;;; Use `reloc_counter ADDR` anywhere that needs the page updated
;;;
;;; Examples:
;;;
;;;      reloc_point *+2 ; update MSB of following JSR
;;;      jsr routine
;;;
;;;      reloc_point *+1 ; update MSB used in following LDA
;;;      lda #>routine

::reloc_counter .set 0
.macro reloc_point addr
        ::.ident (.sprintf ("RL%04X", ::reloc_counter)) := addr
        ::reloc_counter .set ::reloc_counter + 1
.endmacro

;;; Align handler to page boundary for easier relocation
        .res    $2100 - *, 0

;;; ============================================================
;;; Command Handler
;;; ============================================================

.proc handler
        ptr     := $06          ; pointer into VPATH
        tptr    := $08          ; pointer into TOKTABL

        lda     VPATH1
        sta     ptr
        lda     VPATH1+1
        sta     ptr+1

        ;; Check for this command, character by character.
        reloc_point *+2
        jsr     SkipLeadingSpaces

        ldy     #0               ; position in command string

        reloc_point *+2
nxtchr: jsr     ToUpperASCII

        reloc_point *+2
        cmp     command_string,y
        bne     check_if_token
        inx
        iny
        cpy     #command_length
        bne     nxtchr

        ;; A match - indicate end of command string for BI's parser.
        dey
        sty     XLEN

        ;; Point BI's parser at the command execution routine.
        lda     #<execute
        sta     XTRNADDR
        reloc_point *+1
        lda     #>execute
        sta     XTRNADDR+1

        ;; Set accepted parameter flags (optional name)
        lda     #PBitsFlags::FNOPT | PBitsFlags::FN1
        sta     PBITS
        lda     #0
        sta     PBITS+1

        ;; Mark command as external (zero).
        sta     XCNUM           ; A=0 from above

        clc                     ; Success (so far)
        rts                     ; Return to BASIC.SYSTEM

;;; ============================================================

check_if_token:
        ;; Is a PATH set?
        reloc_point *+2
        lda     path_buffer
        beq     not_ours

        reloc_point *+2
        jsr     SkipLeadingSpaces
        reloc_point *+2
        jsr     ToUpperASCII

        cmp     #'A'
        bcc     not_ours
        cmp     #'Z'+1
        bcs     not_ours

        ;; Check if it's a BASIC token. Based on the AppleSoft BASIC source.

        ;; Point tptr at TOKTABL less one page (will advance below)
        lda     #<(TOKTABL-$100)
        sta     tptr
        lda     #>(TOKTABL-$100)
        sta     tptr+1

        ;; These are immediately incremented
        dex
        ldy     #$FF            ; (tptr),y offset TOKTABL

        ;; Match loop
mloop:  iny                     ; Advance through token table
        bne     :+
        inc     tptr+1
:       inx

        ;; Check for match
next_char:
        reloc_point *+2
        jsr     ToUpperASCII    ; Next character

        ;; NOTE: Does not skip over spaces, unlike BASIC tokenizer

        sec                     ; Compare by subtraction..
        sbc     (tptr),Y
        beq     mloop
        cmp     #$80          ; If only difference was the high bit
        bne     next_token    ; then it's end-of-token -- and a match!

        ;; Only if next command char is not alpha.
        ;; This allows 'ON' as a prefix (e.g. 'ONLINE'),
        ;; without preventing 'RUN100' from being typed.

        inx
        reloc_point *+2
        jsr     ToUpperASCII
        cmp     #'A'
        bcc     not_ours
        cmp     #'Z'+1
        bcs     not_ours

        ;; Otherwise, advance to next token
next_token:
        reloc_point *+2
        jsr     SkipLeadingSpaces
sloop:  lda     (tptr),y         ; Scan table looking for a high bit set
        iny
        bne     :+
        inc     tptr+1
:       asl
        bcc     sloop           ; High bit clear, keep looking
        lda     (tptr),y        ; End of table?
        bne     next_char       ; Nope, check for a match
        beq     maybe_invoke

not_ours:
fail_invoke:
        sec                     ; Signal failure...
        next_command := *+1
        jmp     $ffff           ; Execute next command in chain


;;; ============================================================

maybe_invoke:

        ppos := $D6             ; position into path_buffer

        lda     #0
        sta     ppos

        ;; Compose path
compose:
        ldx     ppos
        reloc_point *+2
        cpx     path_buffer
        beq     fail_invoke

        ;; Entry from path list
        ldy     #1
        reloc_point *+2
:       lda     path_buffer+1,x
        inx
        cmp     #':'            ; separator
        beq     :+
        sta     (ptr),y
        iny
        reloc_point *+2
        cpx     path_buffer
        bne     :-

        ;; Slash separator
:       stx     ppos
        lda     #'/'
        sta     (ptr),y
        iny

        ;; Name from command line
        reloc_point *+2
        jsr     SkipLeadingSpaces
        reloc_point *+2
:       jsr     ToUpperASCII
        cmp     #'.'
        beq     ok
        cmp     #'0'
        bcc     notok
        cmp     #'9'+1
        bcc     ok
        cmp     #'A'
        bcc     notok
        cmp     #'Z'+1
        bcs     notok

ok:     sta     (ptr),y
        iny
        inx
        cpx     #65             ; Maximum path length+1
        bcc     :-
        bcs     compose

notok:  dey
        tya
        ldy     #0
        sta     (ptr),y

        ;; Indicate end of command string for BI's parser (if command uses it)
        dex
        stx     xlen            ; assigned to `XLEN` later

        ;; Check to see if path exists.
        lda     #$A             ; param length
        sta     SSGINFO
        lda     #GET_FILE_INFO
        jsr     GOSYSTEM
        bne     compose         ; no such file - try next path directory

        ;; Check to see if type is CMD.
        lda     FIFILID
        cmp     #FT_CMD
        bne     compose         ; wrong type - try next path directory

        ;; Tell BASIC.SYSTEM it was handled.
        ldx     #xtrnaddr_len - 1
:       lda     xtrnaddr,x
        sta     XTRNADDR,x
        dex
        bpl     :-

        ;; MLI/BI trashes part of INBUF (clock driver?), so stash it in upper half.
        ldx     #$7F
:       lda     INBUF,x
        sta     INBUF+$80,x
        dex
        bpl     :-

        ;; Use BI general purpose buffer for I/O (page aligned)
        lda     HIMEM+1
        sta     OSYSBUF+1

        ;; Now try to open/read/close and invoke it
        lda     #OPEN
        jsr     GOSYSTEM
        bcs     fail_load

        lda     OREFNUM
        sta     RWREFNUM
        sta     CFREFNUM

        ;; Assign `RWDATA` and `RWCOUNT`
        ldx     #rwdata_len - 1
:       lda     rwdata,x
        sta     RWDATA,x
        dex
        bpl     :-

        lda     #READ
        jsr     GOSYSTEM
        php                     ; save C in case it signals failure
        pha                     ; if so, A has error code

        lda     #CLOSE          ; always close
        jsr     GOSYSTEM
        pla
        plp
        bcs     fail_load

        ;; Restore INBUF now that MLI/BI work is done.
        ldx     #$7F
:       lda     INBUF+$80,x
        sta     INBUF,x
        dex
        bpl     :-

        ;; Invoke command, allow it to return to BASIC.SYSTEM
        jmp     cmd_load_addr

fail_load:
        rts


;;; Assigned to `XTRNADDR`, `XLEN`, `XCNUM`, and `PBITS`
xtrnaddr:
        .addr   XRETURN         ; assigned to `XTRNADDR`
xlen:   .byte   0               ; assigned to `XLEN`
        .byte   0               ; assigned to `XCNUM`
        .word   0               ; assigned to `PBITS`
        xtrnaddr_len = * - xtrnaddr


;;; Assigned to `RWDATA` and `RWCOUNT`
rwdata:
        .addr   cmd_load_addr   ; assigned to `RWDATA`
        .word   max_cmd_size    ; assigned to `RWCOUNT`
        rwdata_len = * - rwdata

;;; ============================================================

execute:
        ;; Verify required arguments

        lda     FBITS
        and     #PBitsFlags::FN1 ; Filename?
        bne     set_path

;;; --------------------------------------------------
        ;; Show current path

        ldx     #0
        reloc_point *+2
:       cpx     path_buffer
        beq     done
        reloc_point *+2
        lda     path_buffer+1,x
        ora     #$80
        jsr     COUT
        inx
        bpl     :-

        jsr     CROUT
done:   clc
        rts

;;; --------------------------------------------------
        ;; Set path
set_path:
        ldy     #0
        lda     (ptr),y
        tay
:       lda     (ptr),y
        reloc_point *+2
        sta     path_buffer,y
        dey
        bpl     :-
        clc
        rts

;;; ============================================================
;;; Helpers

;;; Returns INBUF,x with high bit stripped and up-cased
;;; (also converts {|}~DEL to [\]^_ but that's okay)

.proc ToUpperASCII
        lda     INBUF,x
        and     #$7F
        cmp     #'a'
        bcc     skip
        and     #CASE_MASK
skip:   rts
.endproc

;;; Returns with X pointing at first non-space in INBUF,
;;; and that character loaded in A.

.proc SkipLeadingSpaces
        ldx     #$FF
:       inx
        lda     INBUF,x
        cmp     #' '|$80
        beq     :-
        rts
.endproc

;;; ============================================================
;;; Data

command_string:
        .byte "PATH"
        command_length  =  *-command_string

path_buffer:
        .res    65, 0

.endproc
        handler_end := *-1
        handler_pages = (.sizeof(handler) + $FF) / $100
        next_command := handler::next_command

;;; ============================================================
;;;
;;; Relocation Table
;;;
;;; ============================================================

relocation_table:
        .byte   ::reloc_counter
        .repeat ::reloc_counter, rc
        .addr ::.ident (.sprintf ("RL%04X", rc))
        .endrepeat

;;; ============================================================