wordlists.asm

   1 ;;; This file contains words dealing with word lists (vocabularies)
   2 ;;;
   3 ;;; CURRENT-WORDLIST (variable) points out "the current wordlist"
   4 ;;; SYSCALLS is a wordl list
   5 ;;; FORTH is a word list
   6 ;;;
   7 ;;; !! When a word list word is created, it gets added to the tail end
   8 ;;; of the current word list as way of making all word list words be
   9 ;;; present in all word lists. This is different to all other kinds of
  10 ;;; words, which instead are added to the head end of the current word
  11 ;;; list.
  12 ;;;
  13 ;;; !! A word list word is created, it is initialised to the head end
  14 ;;; of the current word list. It will this be an extension to that
  15 ;;; current word list.
  16 ;;;
  17 ;;; EMPTY-WORDLIST is a word list word for an empty word list. It thus
  18 ;;; only contains word list words.
  19 ;;;
  20 ;;; WORDLIST ( "name" -- ) = start
  21
  22         WORD p_tfa2cfa,'TFA>CFA',fasm
  23         ;; ( tfa -- cfa )
  24         ;; Advance a word tfa pointer to the cfa field
  25         mov rax,qword[rsp]
  26         tfa2cfa rax
  27         mov qword [rsp],rax
  28         next
  29
  30         WORD p_tfa2dfa,'TFA>DFA',fasm
  31         ;; ( tfa -- dfa )
  32         ;; Advance a word tfa pointer to the dfa field
  33         mov rax,qword[rsp]
  34         tfa2dfa rax
  35         mov qword [rsp],rax
  36         next
  37
  38         WORD p_dfa2tfa,'DFA>TFA',fasm
  39         ;; ( dfa -- tfa )
  40         ;; Advance a word tfa pointer to the dfa field
  41         mov rax,qword[rsp]
  42         mov rax,qword [rax-24]  ; tfa
  43         mov qword [rsp],rax
  44         next
  45
  46         WORD p_wordlist,'CURRENT-WORDLIST',dovariable
  47         ;; CURRENT-WORDLIST points to cfa of the currently active wordlist.
  48         dq p_forth_DFA
  49
  50         WORD p_words,'WORDS',fasm
  51         ;; ( -- )
  52         ;; Dump all words
  53         pushr rsi
  54         mov rax,qword [p_wordlist_DFA] ; current wordlist word
  55         mov rax,[rax]                  ; list start
  56         sub rsp,8                      ; use stack to hold ptr
  57 p_words_LOOP:
  58         mov qword [rsp],rax
  59         cmp rax,0
  60         je p_words_END
  61         ;; tfa>pfa
  62         tfa2pfa rax
  63         push 1
  64         ;; pfa@ => ( chars* length)
  65         pushpname rax
  66         DOFORTH sys_write
  67         pop rax                 ; ignore errors
  68         push qword 10
  69         DOFORTH p_emit
  70         mov rax,qword [rsp]
  71         mov rax,qword [rax]
  72         jmp p_words_LOOP
  73
  74 p_words_END:
  75         popr rsi
  76         next
  77
  78         WORD p_strncmp,'STRNCMP',fasm
  79         ;; ( chars1 chars2 n -- flag )
  80         ;; Compare bytes until one is NUL, return <0, =0 or >0 to
  81         ;; indicate that chars1 is lesser, they are equal, or chars2
  82         ;; is lesser in ascii ordering respectively.
  83         pop rdx
  84         pop rbx
  85         pop rax
  86         xor rcx,rcx
  87         ;; rax = chars1, rbx = chars2, cl = byte acc, rdx = length
  88         inc rdx
  89 p_strncmp_loop:
  90         dec rdx
  91         je p_strncmp_end
  92         mov cl,[rax]
  93         inc rax
  94         sub cl,[rbx]
  95         inc rbx
  96         je p_strncmp_loop
  97 p_strncmp_end:
  98         push rcx
  99         next
 100
 101         WORD p_find,'FIND'
 102         ;; ( chars length -- [ chars 0 | cfa 1 )
 103         ;; Search the current wordlists for the given pname
 104         pushr rsi
 105         mov rcx,[p_wordlist_DFA]
 106         mov rcx,qword [rcx]
 107         mov rbx,[rsp]
 108         mov rax,[rsp+8]
 109 p_find_loop:
 110         cmp rcx,0
 111         je p_find_done
 112         cmp rbx,qword [rcx+16]  ; compare lengths
 113         jne p_find_nextword
 114         push rcx
 115         ;; check word
 116         push rax
 117         tfa2pname rcx
 118         push rcx
 119         push rbx
 120         DOFORTH p_strncmp
 121         pop rax                 ; return value
 122         pop rcx
 123         cmp rax,0
 124         je p_find_done
 125         mov rbx,[rsp]
 126         mov rax,[rsp+8]
 127 p_find_nextword:
 128         mov rcx,[rcx]
 129         jmp p_find_loop
 130 p_find_found:
 131         mov qword [rsp+8],rcx   ; replace chars with tfa
 132         mov rcx,1
 133 p_find_done:
 134         push rcx
 135         popr rsi
 136         next