;;; This file contains words dealing with word lists (aka vocabularies)
;;;
;;; 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_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)
	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
	cmp rdi,rsi
	je p_strncpy_END
	jl p_strncpy_LOOP
	;; copy down
	std ; Direction is decrementing
	add rdi,rcx
	dec rdi
	add rsi,rcx
	dec rsi
p_strncpy_LOOP:
	rep
	movsb
p_strncpy_END:
	cld ; Restore default direction as incrementing
	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.
	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:
	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 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] ; 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_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 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_found
	mov rbx,qword [rsp]
	mov rsi,qword [rsp+8]
p_find_nextword:
	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:
	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