;;; 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_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. 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