This commit is contained in:
Joshua Bell 2019-01-06 20:26:58 -08:00
parent 42dc31e40e
commit ed1277cc4d

171
path.s
View File

@ -8,6 +8,8 @@
.org $2000 .org $2000
.include "apple2.inc"
.include "apple2.mac"
.include "prodos.inc" .include "prodos.inc"
;;; ============================================================ ;;; ============================================================
@ -20,7 +22,20 @@ INBUF := $200 ; GETLN input buffer
CROUT := $FD8E CROUT := $FD8E
COUT := $FDED COUT := $FDED
MOVE := $FE2C ; call with Y=0
MOVE_SRC := $3C
MOVE_END := $3E
MOVE_DST := $42
TOKEN_NAME_TABLE := $D0D0
CASE_MASK = $DF
;;; ============================================================ ;;; ============================================================
;;; Install the new command
;; TODO: Fail if Applesoft is not in ROM
;; Save previous external command address ;; Save previous external command address
lda EXTRNCMD+1 lda EXTRNCMD+1
@ -28,34 +43,54 @@ COUT := $FDED
lda EXTRNCMD+2 lda EXTRNCMD+2
sta next_command+1 sta next_command+1
;; Request a 1-page buffer ;; Request a 2-page buffer
lda #1 lda #2
jsr GETBUFR jsr GETBUFR
bcc :+ bcc :+
lda #$C ; NO BUFFERS AVAILABLE lda #$C ; NO BUFFERS AVAILABLE
rts rts
: : sta new_page ; A = MSB of new page
;; A = MSB of new page - update absolute addresses
;; (aligned to page boundary so only MSB changes) ;; Compute move delta in pages
lda #>handler
sec
sbc new_page
sta page_delta
;; Relocatable routine is aligned to page boundary so only MSB changes
ldx relocation_table ldx relocation_table
: ldy relocation_table+1,x : ldy relocation_table+1,x
lda handler,y
clc
adc page_delta
sta handler,y sta handler,y
dex dex
bpl :- bpl :-
;; 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 ;; Install new address in external command address
lda new_page
sta EXTRNCMD+2 sta EXTRNCMD+2
lda #0 lda #0
sta EXTRNCMD+1 sta EXTRNCMD+1
;; Relocate
ldx #0
: lda handler,x
page_num3 := *+2
sta $2100,x ; self-modified
inx
bne :-
;; Complete ;; Complete
rts rts
@ -68,21 +103,19 @@ COUT := $FDED
.res $2100 - *, 0 .res $2100 - *, 0
.proc handler .proc handler
ptr := $06
;; Check for this command, character by character. ;; Check for this command, character by character.
ldx #0 ldx #0
nxtchr: lda INBUF,x ;; TODO: skip leading spaces
and #$7F ; Convert to ASCII nxtchr: lda INBUF,x
cmp #'a' ; Convert to upper-case page_num6 := *+2 ; address needing updating
bcc :+ jsr to_upper
cmp #'z'+1
bcs :+
and #$DF
page_num1 := *+2 ; address needing updating page_num1 := *+2 ; address needing updating
: cmp command_string,x cmp command_string,x
bne not_path bne check_if_token
inx inx
cpx #command_length cpx #command_length
bne nxtchr bne nxtchr
@ -115,15 +148,75 @@ nxtchr: lda INBUF,x
;;; ============================================================ ;;; ============================================================
not_path: check_if_token:
;; Ensure it's alpha
lda INBUF
page_num7 := *+2 ; address needing updating
jsr to_upper
cmp #'A'|$80
bcc not_ours
cmp #('Z'+1)|$80
bcs not_ours
;; Check if it's a BASIC token. Based on the AppleSoft BASIC source.
;; Point ptr at TOKEN_NAME_TABLE less one page (will advance below)
lda #<(TOKEN_NAME_TABLE-$100)
sta ptr
lda #>(TOKEN_NAME_TABLE-$100)
sta ptr+1
;; These start at "-1" and are immediately incremented
ldx #$FF ; X = position in input line
ldy #$FF ; (ptr),y offset TOKEN_NAME_TABLE
;; Match loop
mloop: iny ; Advance through token table
bne :+
inc ptr+1
: inx
;; Check for match
next_char:
lda INBUF,x ; Next character
page_num8 := *+2 ; address needing updating
jsr to_upper
;; NOTE: Does not skip over spaces, unlike BASIC tokenizer
sec ; Compare by subtraction..
sbc (ptr),Y
beq mloop
cmp #$80 ; If only difference was the high bit
beq not_ours ; then it's end-of-token -- and a match!
;; Otherwise, advance to next token
next_token:
ldx #0 ; Start next match at start of input line
;; TODO: skip leading spaces
@loop: lda (ptr),y ; Scan table looking for a high bit set
iny
bne :+
inc ptr+1
: asl
bcc @loop ; High bit clear, keep looking
lda (ptr),y ; End of table?
bne next_char ; Nope, check for a match
;; Not a keyword, so invoke
not_a_token:
;; TODO: Implement me!
;;; ============================================================
not_ours: not_ours:
sec ; Signal failure... sec ; Signal failure...
next_command := *+1 next_command := *+1
jmp $ffff ; Execute next command in chain jmp $ffff ; Execute next command in chain
;;; ============================================================
;;; ============================================================ ;;; ============================================================
execute: execute:
@ -137,10 +230,10 @@ execute:
;; Show current path ;; Show current path
ldx #0 ldx #0
page_num3 := *+2 page_num3 := *+2 ; address needing updating
: cpx path_buffer : cpx path_buffer
beq done beq done
page_num4 := *+2 page_num4 := *+2 ; address needing updating
lda path_buffer+1,x lda path_buffer+1,x
ora #$80 ora #$80
jsr COUT jsr COUT
@ -154,7 +247,6 @@ done: clc
;;; -------------------------------------------------- ;;; --------------------------------------------------
;; Set path ;; Set path
set_path: set_path:
ptr := $06
lda VPATH1 lda VPATH1
sta ptr sta ptr
ldx VPATH1+1 ldx VPATH1+1
@ -164,27 +256,43 @@ set_path:
lda (ptr),y lda (ptr),y
tay tay
: lda (ptr),y : lda (ptr),y
page_num5 := *+2 page_num5 := *+2 ; address needing updating
sta path_buffer,y sta path_buffer,y
dey dey
bpl :- bpl :-
clc clc
rts rts
;;; ============================================================
;;; Helpers
.proc to_upper
cmp #'a'|$80
bcc skip
and #CASE_MASK
skip: rts
.endproc
;;; ============================================================ ;;; ============================================================
;;; Data ;;; Data
command_string: command_string:
.byte "PATH" ; Command string scrcode "PATH"
command_length = *-command_string command_length = *-command_string
path_buffer: path_buffer:
.res 65, 0 .res 65, 0
.endproc .endproc
.assert .sizeof(handler) <= $100, error, "Must fit on one page" .assert .sizeof(handler) <= $200, error, "Must fit on two pages"
handler_end := *-1
next_command := handler::next_command next_command := handler::next_command
new_page:
.byte 0
page_delta:
.byte 0
relocation_table: relocation_table:
.byte 5 .byte 5
.byte <handler::page_num1 .byte <handler::page_num1
@ -192,3 +300,6 @@ relocation_table:
.byte <handler::page_num3 .byte <handler::page_num3
.byte <handler::page_num4 .byte <handler::page_num4
.byte <handler::page_num5 .byte <handler::page_num5
.byte <handler::page_num6
.byte <handler::page_num7
.byte <handler::page_num8