bug fix ALLOT

[rrq/rrqforth.git] / wordlists.asm

diff --git a/wordlists.asm b/wordlists.asm
index 44656e85fb81a22003e175b0019875cedd971cbc..0ee7aecedb83c134e75a86d0f82f30661015a27b 100644 (file)
--- a/wordlists.asm
+++ b/wordlists.asm
@@ -14,6 +14,30 @@
        ;; CURRENT-WORDLIST points to dfa of the currently active wordlist.
        dq p_forth_DFA          ; compilation word list
 
+       WORD p_definitions,'DEFINITIONS',fasm
+       ;; ( wordlist -- )
+       ;; Change CURRENT-WORDLIST to use the given word list
+       pop qword [p_wordlist_DFA]
+       next
+
+       WORD p_use,'USE',fasm
+       ;; ( wordlist "name" -- cfa )
+       ;; Read next word using the given wordlist
+       pushr rsi
+       mov rax,qword [p_wordlist_DFA]
+       pushr rax
+       pop qword [p_wordlist_DFA]
+       DOFORTH p_input, p_get, p_read_word, p_find
+       popr rax
+       mov qword [p_wordlist_DFA],rax
+       cmp qword [rsp],0
+       jne p_use_done
+       add rsp,16
+       mov qword [rsp],0
+p_use_done:
+       popr rsi
+       next
+
        WORD p_words,'WORDS',fasm
        ;; ( w -- )
        ;; Dump all words of the word list w (the dfa of a word list)
@@ -38,27 +62,67 @@ p_words_END:
        popr rsi
        next
 
+       WORD p_strlen,'STRLEN',fasm
+       ;; ( chars -- n )
+       ;; Determine length of NUL terminated byte sequence
+       pushr rsi
+       mov rsi,qword [rsp]
+       xor rcx,rcx
+       dec rcx
+       cld
+p_strlen_LOOP:
+       inc rcx
+       lodsb
+       cmp al,0
+       jne p_strlen_LOOP
+       mov qword [rsp],rcx
+       popr rsi
+       next
+
+       WORD p_strncpy,'STRNCPY',fasm
+       ;; ( chars1 chars2 n -- )
+       ;; Copy n bytes from chars1 to chars2.
+       pushr rsi
+       pop rcx
+       pop rdi
+       pop rsi
+       cmp rcx,0
+       jle p_strncpy_END
+       cld
+p_strncpy_LOOP:
+       movsb
+       dec rcx
+       jg p_strncpy_LOOP
+p_strncpy_END:
+       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                 ; count
-       pop rbx                 ; chars2
-       pop rax                 ; chars1
-       xor rcx,rcx
+       pushr rsi
+       pop rcx                 ; count
+       pop rsi                 ; chars2
+       pop rdi                 ; chars1
+       xor rax,rax
+       cmp rcx,0
+       jle p_strncmp_end
        ;; rax = chars1, rbx = chars2, cl = byte acc, rdx = length
+       cld
 p_strncmp_loop:
-       dec rdx
-       jl p_strncmp_end
-       mov cl,[rax]
-       inc rax
-       inc rbx
-       sub cl,[rbx-1]
-       je p_strncmp_loop
-       jmp p_strncmp_end
+       cmpsb
+       jne p_strncmp_diff
+       dec rcx
+       jg p_strncmp_loop
+p_strncmp_diff:
+       xor rax,rax
+       mov al,[rsi-1]
+       sub al,[rdi-1]
 p_strncmp_end:
-       push rcx
+       push rax
+       popr rsi
        next
 
        WORD p_find,'FIND',fasm