wordlists.asm

   1 ;;; This file contains words dealing with word lists (aka vocabularies)
   2 ;;;
   3 ;;; CURRENT-WORDLIST (variable) points out "the current wordlist"
   4 ;;; FORTH is a word list
   5 ;;;
   6
   7         ;; FORTH is the last word of WORDLIST FORTH
   8         WORD p_forth,'FORTH',dovariable
   9         ;; The FORTH word list
  10         dq last_forth_word      ; tfa of last FORTH word
  11         dq 0                    ; successor word list dfa
  12
  13         WORD p_wordlist,'CURRENT-WORDLIST',dovariable
  14         ;; CURRENT-WORDLIST points to dfa of the currently active wordlist.
  15         dq p_forth_DFA          ; compilation word list
  16
  17         WORD p_definitions,'DEFINITIONS',fasm
  18         ;; ( wordlist -- )
  19         ;; Change CURRENT-WORDLIST to use the given word list
  20         pop qword [p_wordlist_DFA]
  21         next
  22
  23         WORD p_use,'USE',fasm
  24         ;; ( wordlist "name" -- cfa )
  25         ;; Read next word using the given wordlist
  26         pushr rsi
  27         mov rax,qword [p_wordlist_DFA]
  28         pushr rax
  29         pop qword [p_wordlist_DFA]
  30         DOFORTH p_input, p_get, p_read_word, p_find
  31         popr rax
  32         mov qword [p_wordlist_DFA],rax
  33         cmp qword [rsp],0
  34         jne p_use_done
  35         add rsp,16
  36         mov qword [rsp],0
  37 p_use_done:
  38         popr rsi
  39         next
  40
  41         WORD p_words,'WORDS',fasm
  42         ;; ( w -- )
  43         ;; Dump all words of the word list w (the dfa of a word list)
  44         pushr rsi
  45 p_words_LOOP:
  46         mov rax,qword [rsp]
  47         mov rax,qword [rax]     ; Next word
  48         mov qword [rsp],rax
  49         cmp rax,0
  50         je p_words_END
  51         tfa2pfa rax
  52         push 1                  ; stdout
  53         pushpname rax           ; ( pfa* -- chars* length )
  54         DOFORTH sys_write
  55         pop rax                 ; ignore errors
  56         push qword 10
  57         DOFORTH p_emit          ; ( c -- )
  58         jmp p_words_LOOP
  59
  60 p_words_END:
  61         pop rax
  62         popr rsi
  63         next
  64
  65         WORD p_strlen,'STRLEN',fasm
  66         ;; ( chars -- n )
  67         ;; Determine length of NUL terminated byte sequence
  68         pushr rsi
  69         mov rsi,qword [rsp]
  70         xor rcx,rcx
  71         dec rcx
  72         cld
  73 p_strlen_LOOP:
  74         inc rcx
  75         lodsb
  76         cmp al,0
  77         jne p_strlen_LOOP
  78         mov qword [rsp],rcx
  79         popr rsi
  80         next
  81
  82         WORD p_strncpy,'STRNCPY',fasm
  83         ;; ( chars1 chars2 n -- )
  84         ;; Copy n bytes from chars1 to chars2.
  85         pushr rsi
  86         pop rcx
  87         pop rdi
  88         pop rsi
  89         cmp rcx,0
  90         jle p_strncpy_END
  91         cmp rdi,rsi
  92         je p_strncpy_END
  93         jl p_strncpy_LOOP
  94         ;; copy down
  95         std ; Direction is decrementing
  96         add rdi,rcx
  97         dec rdi
  98         add rsi,rcx
  99         dec rsi
 100 p_strncpy_LOOP:
 101         rep
 102         movsb
 103 p_strncpy_END:
 104         cld ; Restore default direction as incrementing
 105         popr rsi
 106         next
 107
 108         WORD p_strncmp,'STRNCMP',fasm
 109         ;; ( chars1 chars2 n -- flag )
 110         ;; Compare bytes until one is NUL, return <0, =0 or >0 to
 111         ;; indicate that chars1 is lesser, they are equal, or chars2
 112         ;; is lesser in ascii ordering respectively.
 113         pushr rsi
 114         pop rcx                 ; count
 115         pop rsi                 ; chars2
 116         pop rdi                 ; chars1
 117         xor rax,rax
 118         cmp rcx,0
 119         jle p_strncmp_end
 120         ;; rax = chars1, rbx = chars2, cl = byte acc, rdx = length
 121         cld
 122 p_strncmp_loop:
 123         cmpsb
 124         jne p_strncmp_diff
 125         dec rcx
 126         jg p_strncmp_loop
 127 p_strncmp_diff:
 128         xor rax,rax
 129         mov al,[rsi-1]
 130         sub al,[rdi-1]
 131 p_strncmp_end:
 132         push rax
 133         popr rsi
 134         next
 135
 136         WORD p_find,'FIND',fasm
 137         ;; ( chars* length -- [ chars* length 0 ]|[ tfa ] )
 138         ;; Search the current wordlists for the given pname
 139         pushr rsi
 140         mov rcx,[p_wordlist_DFA] ; the current top word list
 141         mov rdx,qword [rcx+8]    ; successor word list
 142         pushr rdx
 143         mov rcx,qword [rcx]     ; use rcx for word list traversing
 144         mov rbx,qword [rsp]     ; rbx is input length
 145         mov rsi,qword [rsp+8]   ; rsi is input chars*
 146 p_find_loop:
 147         cmp rcx,0
 148         je p_find_notfound      ; jump at end of word list
 149         cmp rbx,qword [rcx+24]  ; compare lengths
 150         jne p_find_nextword     ; jump on length mismatch
 151         push rcx                ; save tfa for later
 152         ;; check word
 153         push rsi                ; input chars
 154         tfa2pname rcx
 155         push rcx                ; word pname
 156         push rbx                ; length
 157         DOFORTH p_strncmp       ; ( s1* s2 n -- v )
 158         pop rax                 ; return value v
 159         pop rcx                 ; restore tfa
 160         cmp rax,0
 161         je p_find_found
 162         mov rbx,qword [rsp]
 163         mov rsi,qword [rsp+8]
 164 p_find_nextword:
 165         mov rcx,qword [rcx]
 166         jmp p_find_loop
 167 p_find_notfound:
 168         mov rcx,qword [rbp]     ; successor word list
 169         cmp rcx,0
 170         je p_find_nomore
 171         mov rdx,qword [rcx]
 172         mov qword [rbp],rdx
 173         jmp p_find_loop
 174 p_find_nomore:
 175         push 0
 176         add rbp,8               ; discard word list link
 177         popr rsi
 178         next
 179 p_find_found:
 180         add rsp,8               ; drop one stack entry
 181         mov qword [rsp],rcx     ; replace with tfa / 0
 182         add rbp,8               ; discard word list link
 183         popr rsi
 184         next