update

[rrq/rrqforth.git] / wordlists.asm

diff --git a/wordlists.asm b/wordlists.asm
index 9790a288b4e945363da6f548427f6c3fcae73a8f..44656e85fb81a22003e175b0019875cedd971cbc 100644 (file)
--- a/wordlists.asm
+++ b/wordlists.asm
@@ -1,59 +1,112 @@
-;;; This file contains words dealing with word lists (vocabularies)
+;;; This file contains words dealing with word lists (aka vocabularies)
 ;;;
-       WORD p_wordlists,'WORDLIST',dovariable
-       ;; VARIABLE WORDLIST is the currently active wordlist.
-       dq last_word
+;;; CURRENT-WORDLIST (variable) points out "the current wordlist"
+;;; FORTH is a word list
+;;;
+
+       ;; FORTH is the last word of WORDLIST FORTH
+       WORD p_forth,'FORTH',dovariable
+       ;; The FORTH word list
+       dq last_forth_word      ; tfa of last FORTH word
+       dq 0                    ; successor word list dfa
+
+       WORD p_wordlist,'CURRENT-WORDLIST',dovariable
+       ;; CURRENT-WORDLIST points to dfa of the currently active wordlist.
+       dq p_forth_DFA          ; compilation word list
+
+       WORD p_words,'WORDS',fasm
+       ;; ( w -- )
+       ;; Dump all words of the word list w (the dfa of a word list)
+       pushr rsi
+p_words_LOOP:
+       mov rax,qword [rsp]
+       mov rax,qword [rax]     ; Next word
+       mov qword [rsp],rax
+       cmp rax,0
+       je p_words_END
+       tfa2pfa rax
+       push 1                  ; stdout
+       pushpname rax           ; ( pfa* -- chars* length )
+       DOFORTH sys_write
+       pop rax                 ; ignore errors
+       push qword 10
+       DOFORTH p_emit          ; ( c -- )
+       jmp p_words_LOOP
+
+p_words_END:
+       pop rax
+       popr rsi
+       next
 
        WORD p_strncmp,'STRNCMP',fasm
        ;; ( chars1 chars2 n -- flag )
        ;; Compare bytes until one is NUL, return <0, =0 or >0 to
        ;; indicate that chars1 is lesser, they are equal, or chars2
        ;; is lesser in ascii ordering respectively.
-       pop rdx
-       pop rbx
-       pop rax
+       pop rdx                 ; count
+       pop rbx                 ; chars2
+       pop rax                 ; chars1
        xor rcx,rcx
        ;; rax = chars1, rbx = chars2, cl = byte acc, rdx = length
-       inc rdx
 p_strncmp_loop:
        dec rdx
-       je p_strncmp_end
+       jl p_strncmp_end
        mov cl,[rax]
        inc rax
-       sub cl,[rbx]
        inc rbx
+       sub cl,[rbx-1]
        je p_strncmp_loop
+       jmp p_strncmp_end
 p_strncmp_end:
        push rcx
        next
 
-       WORD p_find,'FIND'
-       ;; ( chars length -- [ chars 0 | cfa 1 )
+       WORD p_find,'FIND',fasm
+       ;; ( chars* length -- [ chars* length 0 ]|[ tfa ] )
        ;; Search the current wordlists for the given pname
-       mov rcx,[p_wordlists_DFA]
+       pushr rsi
+       mov rcx,[p_wordlist_DFA] ; the current top word list
+       mov rdx,qword [rcx+8]    ; successor word list
+       pushr rdx
+       mov rcx,qword [rcx]     ; use rcx for word list traversing
+       mov rbx,qword [rsp]     ; rbx is input length
+       mov rsi,qword [rsp+8]   ; rsi is input chars*
 p_find_loop:
        cmp rcx,0
-       je p_find_done
-       mov rbx,[rsp]
-       mov rax,[rsp+8]
-       cmp bl,byte [rcx+10]
-       jne p_find_nextword
-       push rcx
+       je p_find_notfound      ; jump at end of word list
+       cmp rbx,qword [rcx+24]  ; compare lengths
+       jne p_find_nextword     ; jump on length mismatch
+       push rcx                ; save tfa for later
        ;; check word
-       push rax
-       push rcx+11
-       push rbx
-       DOFORTH p_strncmp
-       pop rax                 ; return value
-       pop rcx
+       push rsi                ; input chars
+       tfa2pname rcx
+       push rcx                ; word pname
+       push rbx                ; length
+       DOFORTH p_strncmp       ; ( s1* s2 n -- v )
+       pop rax                 ; return value v
+       pop rcx                 ; restore tfa
        cmp rax,0
-       je p_find_done
+       je p_find_found
+       mov rbx,qword [rsp]
+       mov rsi,qword [rsp+8]
 p_find_nextword:
-       mov rcx,[rcx]
+       mov rcx,qword [rcx]
        jmp p_find_loop
+p_find_notfound:
+       mov rcx,qword [rbp]     ; successor word list
+       cmp rcx,0
+       je p_find_nomore
+       mov rdx,qword [rcx]
+       mov qword [rbp],rdx
+       jmp p_find_loop
+p_find_nomore:
+       push 0
+       add rbp,8               ; discard word list link
+       popr rsi
+       next
 p_find_found:
-       mov qword [rsp+8],rcx   ; replace chars with tfa
-       mov rcx,1
-p_find_done:
-       push rcx
+       add rsp,8               ; drop one stack entry
+       mov qword [rsp],rcx     ; replace with tfa / 0
+       add rbp,8               ; discard word list link
+       popr rsi
        next