-;;; 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
-
- WORD p_tfa2cfa,'TFA>CFA',fasm
- ;; ( tfa -- cfa )
- ;; Advance a word tfa pointer to the cfa field
- mov rax,qword[rsp]
- tfa2cfa rax
- mov qword [rsp],rax
- next
-
- WORD p_tfa2dfa,'TFA>DFA',fasm
- ;; ( tfa -- dfa )
- ;; Advance a word tfa pointer to the dfa field
- mov rax,qword[rsp]
- tfa2dfa rax
- mov qword [rsp],rax
- next
- WORD p_dfa2tfa,'DFA>TFA',fasm
- ;; ( dfa -- tfa )
- ;; Advance a word tfa pointer to the dfa field
- mov rax,qword[rsp]
- mov rax,qword [rax-24] ; tfa
- mov qword [rsp],rax
- next
+ ;; 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
+ ;; ( w -- )
+ ;; 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
- 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
pushr rsi
- mov rcx,[p_wordlist_DFA]
- mov rcx,qword [rcx]
- mov rbx,[rsp]
- mov rax,[rsp+8]
+ 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
- cmp rbx,qword [rcx+16] ; compare lengths
- 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 rsi ; input chars
tfa2pname rcx
- push rcx
- push rbx
- DOFORTH p_strncmp
- pop rax ; return value
- pop 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
- mov rbx,[rsp]
- mov rax,[rsp+8]
+ 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
projects / rrq / rrqforth.git / blobdiff