X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=wordlists.asm;h=7daa4289c964b501314d40dbb21f4609d92fc480;hb=aa6d10c30115571b859b9e7e3d6e8a9b9ced599b;hp=9790a288b4e945363da6f548427f6c3fcae73a8f;hpb=f3bc3b97f37dd7bc012c152374d4185c734b3a7e;p=rrq%2Frrqforth.git

diff --git a/wordlists.asm b/wordlists.asm
index 9790a28..7daa428 100644
--- a/wordlists.asm
+++ b/wordlists.asm
@@ -1,59 +1,152 @@
-;;; 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_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
-	je 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'
-	;; ( 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