upgraded binary
[rrq/rrqforth.git] / wordlists.asm
index 5f4f281c6be3ea3f2bcb1047b7379bedcd9c40ec..7daa4289c964b501314d40dbb21f4609d92fc480 100644 (file)
-;;; This file contains words dealing with word lists (vocabularies)
+;;; This file contains words dealing with word lists (aka vocabularies)
 ;;;
 ;;; CURRENT-WORDLIST (variable) points out "the current wordlist"
-;;; SYSCALLS is a wordl list
 ;;; FORTH is a word list
 ;;;
-;;; !! When a word list word is created, it gets added to the tail end
-;;; of the current word list as way of making all word list words be
-;;; present in all word lists. This is different to all other kinds of
-;;; words, which instead are added to the head end of the current word
-;;; list.
-;;;
-;;; !! A word list word is created, it is initialised to the head end
-;;; of the current word list. It will this be an extension to that
-;;; current word list.
-;;;
-;;; EMPTY-WORDLIST is a word list word for an empty word list. It thus
-;;; only contains word list words.
-;;; 
-;;; WORDLIST ( "name" -- ) = start
+
+       ;; 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 cfa of the currently active wordlist.
-       dq p_forth_DFA
-       
+       ;; CURRENT-WORDLIST points to dfa of the currently active wordlist.
+       dq p_forth_DFA          ; compilation word list
+
        WORD p_words,'WORDS',fasm
-       ;; ( -- )
-       ;; Dump all words
+       ;; ( -- )
+       ;; Dump all words of the word list w (the dfa of a word list)
        pushr rsi
-       mov rax,qword [p_wordlist_DFA] ; current wordlist word
-       mov rax,[rax]                  ; list start
-       sub rsp,8                      ; use stack to hold ptr
 p_words_LOOP:
+       mov rax,qword [rsp]
+       mov rax,qword [rax]     ; Next word
        mov qword [rsp],rax
        cmp rax,0
        je p_words_END
-       ;; tfa>pfa
        tfa2pfa rax
-       push 1
-       ;; pfa@ => ( chars* length)
-       pushpname rax
+       push 1                  ; stdout
+       pushpname rax           ; ( pfa* -- chars* length )
        DOFORTH sys_write
        pop rax                 ; ignore errors
        push qword 10
-       DOFORTH p_emit
-       mov rax,qword [rsp]
-       mov rax,qword [rax]
+       DOFORTH p_emit          ; ( c -- )
        jmp p_words_LOOP
 
 p_words_END:
+       pop rax
        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
-       pop rbx
-       pop rax
-       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
-       inc rdx
+       cld
 p_strncmp_loop:
-       dec rdx
-       jle p_strncmp_end
-       mov cl,[rax]
-       inc rax
-       sub cl,[rbx]
-       inc rbx
-       je p_strncmp_loop
+       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
        ;; ( chars* length -- [ chars* length 0 ]|[ tfa ] )
        ;; Search the current wordlists for the given pname
        pushr rsi
-       mov rcx,[p_wordlist_DFA]
+       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*
@@ -104,10 +133,20 @@ p_find_nextword:
        mov rcx,qword [rcx]
        jmp p_find_loop
 p_find_notfound:
-       xor rcx,rcx
-       sub rsp,16
+       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:
-       add rsp,8
+       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