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_words,'WORDS',fasm
  18         ;; ( w -- )
  19         ;; Dump all words of the word list w (the dfa of a word list)
  20         pushr rsi
  21 p_words_LOOP:
  22         mov rax,qword [rsp]
  23         mov rax,qword [rax]     ; Next word
  24         mov qword [rsp],rax
  25         cmp rax,0
  26         je p_words_END
  27         tfa2pfa rax
  28         push 1                  ; stdout
  29         pushpname rax           ; ( pfa* -- chars* length )
  30         DOFORTH sys_write
  31         pop rax                 ; ignore errors
  32         push qword 10
  33         DOFORTH p_emit          ; ( c -- )
  34         jmp p_words_LOOP
  35
  36 p_words_END:
  37         pop rax
  38         popr rsi
  39         next
  40
  41         WORD p_strlen,'STRLEN',fasm
  42         ;; ( chars -- n )
  43         ;; Determine length of NUL terminated byte sequence
  44         pushr rsi
  45         mov rsi,qword [rsp]
  46         xor rcx,rcx
  47         dec rcx
  48         cld
  49 p_strlen_LOOP:
  50         inc rcx
  51         lodsb
  52         cmp al,0
  53         jne p_strlen_LOOP
  54         mov qword [rsp],rcx
  55         popr rsi
  56         next
  57
  58         WORD p_strncpy,'STRNCPY',fasm
  59         ;; ( chars1 chars2 n -- )
  60         ;; Copy n bytes from chars1 to chars2.
  61         pushr rsi
  62         pop rcx
  63         pop rdi
  64         pop rsi
  65         cmp rcx,0
  66         jle p_strncpy_END
  67         cld
  68 p_strncpy_LOOP:
  69         movsb
  70         dec rcx
  71         jg p_strncpy_LOOP
  72 p_strncpy_END:
  73         popr rsi
  74         next
  75
  76         WORD p_strncmp,'STRNCMP',fasm
  77         ;; ( chars1 chars2 n -- flag )
  78         ;; Compare bytes until one is NUL, return <0, =0 or >0 to
  79         ;; indicate that chars1 is lesser, they are equal, or chars2
  80         ;; is lesser in ascii ordering respectively.
  81         pushr rsi
  82         pop rcx                 ; count
  83         pop rsi                 ; chars2
  84         pop rdi                 ; chars1
  85         xor rax,rax
  86         cmp rcx,0
  87         jle p_strncmp_end
  88         ;; rax = chars1, rbx = chars2, cl = byte acc, rdx = length
  89         cld
  90 p_strncmp_loop:
  91         cmpsb
  92         jne p_strncmp_diff
  93         dec rcx
  94         jg p_strncmp_loop
  95 p_strncmp_diff:
  96         xor rax,rax
  97         mov al,[rsi-1]
  98         sub al,[rdi-1]
  99 p_strncmp_end:
 100         push rax
 101         popr rsi
 102         next
 103
 104         WORD p_find,'FIND',fasm
 105         ;; ( chars* length -- [ chars* length 0 ]|[ tfa ] )
 106         ;; Search the current wordlists for the given pname
 107         pushr rsi
 108         mov rcx,[p_wordlist_DFA] ; the current top word list
 109         mov rdx,qword [rcx+8]    ; successor word list
 110         pushr rdx
 111         mov rcx,qword [rcx]     ; use rcx for word list traversing
 112         mov rbx,qword [rsp]     ; rbx is input length
 113         mov rsi,qword [rsp+8]   ; rsi is input chars*
 114 p_find_loop:
 115         cmp rcx,0
 116         je p_find_notfound      ; jump at end of word list
 117         cmp rbx,qword [rcx+24]  ; compare lengths
 118         jne p_find_nextword     ; jump on length mismatch
 119         push rcx                ; save tfa for later
 120         ;; check word
 121         push rsi                ; input chars
 122         tfa2pname rcx
 123         push rcx                ; word pname
 124         push rbx                ; length
 125         DOFORTH p_strncmp       ; ( s1* s2 n -- v )
 126         pop rax                 ; return value v
 127         pop rcx                 ; restore tfa
 128         cmp rax,0
 129         je p_find_found
 130         mov rbx,qword [rsp]
 131         mov rsi,qword [rsp+8]
 132 p_find_nextword:
 133         mov rcx,qword [rcx]
 134         jmp p_find_loop
 135 p_find_notfound:
 136         mov rcx,qword [rbp]     ; successor word list
 137         cmp rcx,0
 138         je p_find_nomore
 139         mov rdx,qword [rcx]
 140         mov qword [rbp],rdx
 141         jmp p_find_loop
 142 p_find_nomore:
 143         push 0
 144         add rbp,8               ; discard word list link
 145         popr rsi
 146         next
 147 p_find_found:
 148         add rsp,8               ; drop one stack entry
 149         mov qword [rsp],rcx     ; replace with tfa / 0
 150         add rbp,8               ; discard word list link
 151         popr rsi
 152         next