6502
/
of816
mirror of https://github.com/mgcaret/of816.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

fix a very subtle bug in dictionary search

This commit is contained in:
mgcaret 2020-05-01 22:43:30 -07:00
parent d090c232aa
commit edef1c80b7
2 changed files with 29 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
asm/forth-dictionary.s
View File

@ -4746,16 +4746,14 @@ eword
; ( c-addr u wid -- xt ) Search wordlist wid for word. ; ( c-addr u wid -- xt ) Search wordlist wid for word.
hword dWLSEARCH,"$WLSEARCH" hword dWLSEARCH,"$WLSEARCH"
jsr _popwr jsr _popwr ; wid -> WR
ldy #$02 ldy #$02
lda [WR],y lda [WR],y ; LAST of wordlist at wid, high word
sta YR+2 sta YR+2 ; to YR
dey lda [WR] ; now low word
dey
lda [WR],y
sta YR sta YR
jsr _popxr jsr _popxr ; u -> XR
jsr _popwr jsr _popwr ; c-addr -> WR
jsr _search_unsmudged jsr _search_unsmudged
PUSHNEXT PUSHNEXT
eword eword
@ -4767,14 +4765,14 @@ dword SEARCH_WORDLIST,"SEARCH-WORDLIST"
hword SEARCH_WORDLIST,"SEARCH-WORDLIST" hword SEARCH_WORDLIST,"SEARCH-WORDLIST"
.endif .endif
ENTER ENTER
.dword dWLSEARCH .dword dWLSEARCH ; ( c-addr u wid -- 0 | xt )
.dword DUP .dword DUP ; ( 0 | xt -- 0 0 | xt xt )
.dword _IF .dword _IF ; ( 0 0 | xt xt - 0 | xt )
.dword notfound .dword notfound ; ( 0 ) if taken
.dword IMMEDQ .dword IMMEDQ ; ( xt -- xt f )
ONLIT 1 .dword ONE ; ( xt f -- xt f 1 )
.dword LOR .dword LOR ; ( ... xt 1/-1 )
.dword NEGATE .dword NEGATE ; ( ... xt -1/1 )
notfound: EXIT notfound: EXIT
eword eword
@ -6575,22 +6573,22 @@ dword BACKSLASH,"\",F_IMMED
.dword SOURCEID .dword SOURCEID
.dword _IF .dword _IF
.dword term ; faster .dword term ; faster
ONLIT 0 ; something to drop... .dword ZERO
lp: .dword DROP lp: .dword DROP
.dword INQ .dword INQ
.dword _IF .dword _IF
.dword done .dword done ; whole enchilada has been eaten
.dword GETCH .dword GETCH
.dword DUP .dword DUP
ONLIT c_cr ONLIT c_cr
.dword EQUAL .dword EQUAL
.dword _IFFALSE .dword _IFFALSE
.dword ddone ; if true (= CR) .dword ddone ; taken if = CR
.dword DUP .dword DUP
ONLIT c_lf ONLIT c_lf
.dword EQUAL .dword EQUAL
.dword _IF .dword _IF
.dword lp ; if false (<> LF) .dword lp ; taken if <> LF
ddone: .dword DROP ddone: .dword DROP
done: EXIT done: EXIT
term: .dword NIN term: .dword NIN
@ -6831,7 +6829,7 @@ eword
dword EVALUATE,"EVALUATE" dword EVALUATE,"EVALUATE"
ENTER ENTER
.dword SAVEINPUT .dword SAVEINPUT
.dword XNPtoR ; throw it all on the return stack .dword XNPtoR ; throw it all on the return stack
.dword PtoR ; along with the count .dword PtoR ; along with the count
ONLIT -1 ONLIT -1
.dword dSOURCEID ; standard requires source-id to be -1 during EVALUATE .dword dSOURCEID ; standard requires source-id to be -1 during EVALUATE

18
asm/interpreter.s
View File

@ -915,17 +915,16 @@ good: sec
rts rts
.endproc .endproc
; search dictionary for word at WR, length in XR, start of search (header) at YR ; search dictionary for word at WR, length in XR, start of search (header) at YR
; if found, AY=XT and carry set, otherwise ; if found, AY=XT and carry set, otherwise
; AY=0 and carry clear ; AY=0 and carry clear
; preserves WR, XR, and YR ; preserves WR, XR; YR points at the header of the last word considered
.proc _search .proc _search
olp: lda YR olp: lda YR
ora YR+2 ora YR+2
beq notfnd beq notfnd
ldy #$04 ; offset of length ldy #$04 ; offset of length
lda [YR],y ; get name length lda [YR],y ; get name length (we pull in two bytes)
and #$7F ; mask in significant bits and #$7F ; mask in significant bits
cmp XR ; compare to supplied cmp XR ; compare to supplied
bne snext ; not the right word bne snext ; not the right word
@ -939,12 +938,14 @@ olp: lda YR
.a8 .a8
ldx XR ; get length to match ldx XR ; get length to match
ldy #$05 ; offset of name ldy #$05 ; offset of name
clp: lda [WR] clp: lda [WR] ; char in the word we are searching for
jsr _cupper8 ; upper case jsr _cupper8 ; upper case it
cmp [YR],y ; compare char cmp [YR],y ; compare to char in definition
bne xsnext ; no match bne xsnext ; no match
iny ; move to next char iny ; move to next char of name in def
jsr _incwr rep #SHORT_A
jsr _incwr ; move to next char of word we are searching for
sep #SHORT_A
dex ; if X hit zero, matched it all dex ; if X hit zero, matched it all
bne clp ; if it didn't, keep going bne clp ; if it didn't, keep going
rep #SHORT_A ; match! rep #SHORT_A ; match!
@ -963,6 +964,7 @@ clp: lda [WR]
sec sec
rts rts
xsnext: rep #SHORT_A xsnext: rep #SHORT_A
.a16 ; good habit
plx plx
pla pla
sta WR sta WR