prodos-path/path.s
2024-01-02 22:17:14 -08:00

517 lines
12 KiB
ArmAsm

;;; ============================================================
;;;
;;; 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
;;; ============================================================