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