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_wordlist,'CURRENT-WORDLIST',dovariable
  23         ;; CURRENT-WORDLIST points to cfa of the currently active wordlist.
  24         dq p_forth_DFA
  25
  26         WORD p_words,'WORDS',fasm
  27         ;; ( -- )
  28         ;; Dump all words
  29         pushr rsi
  30         mov rax,qword [p_wordlist_DFA] ; current wordlist word
  31         mov rax,[rax]                  ; list start
  32         sub rsp,8                      ; use stack to hold ptr
  33 p_words_LOOP:
  34         mov qword [rsp],rax
  35         cmp rax,0
  36         je p_words_END
  37         ;; tfa>pfa
  38         tfa2pfa rax
  39         push 1
  40         ;; pfa@ => ( chars* length)
  41         pushpname rax
  42         DOFORTH sys_write
  43         pop rax                 ; ignore errors
  44         push qword 10
  45         DOFORTH p_emit
  46         mov rax,qword [rsp]
  47         mov rax,qword [rax]
  48         jmp p_words_LOOP
  49
  50 p_words_END:
  51         popr rsi
  52         next
  53
  54         WORD p_strncmp,'STRNCMP',fasm
  55         ;; ( chars1 chars2 n -- flag )
  56         ;; Compare bytes until one is NUL, return <0, =0 or >0 to
  57         ;; indicate that chars1 is lesser, they are equal, or chars2
  58         ;; is lesser in ascii ordering respectively.
  59         pop rdx
  60         pop rbx
  61         pop rax
  62         xor rcx,rcx
  63         ;; rax = chars1, rbx = chars2, cl = byte acc, rdx = length
  64         inc rdx
  65 p_strncmp_loop:
  66         dec rdx
  67         jle p_strncmp_end
  68         mov cl,[rax]
  69         inc rax
  70         sub cl,[rbx]
  71         inc rbx
  72         je p_strncmp_loop
  73 p_strncmp_end:
  74         push rcx
  75         next
  76
  77         WORD p_find,'FIND',fasm
  78         ;; ( chars* length -- [ chars* length 0 ]|[ tfa ] )
  79         ;; Search the current wordlists for the given pname
  80         pushr rsi
  81         mov rcx,[p_wordlist_DFA]
  82         mov rcx,qword [rcx]     ; use rcx for word list traversing
  83         mov rbx,qword [rsp]     ; rbx is input length
  84         mov rsi,qword [rsp+8]   ; rsi is input chars*
  85 p_find_loop:
  86         cmp rcx,0
  87         je p_find_notfound      ; jump at end of word list
  88         cmp rbx,qword [rcx+24]  ; compare lengths
  89         jne p_find_nextword     ; jump on length mismatch
  90         push rcx                ; save tfa for later
  91         ;; check word
  92         push rsi                ; input chars
  93         tfa2pname rcx
  94         push rcx                ; word pname
  95         push rbx                ; length
  96         DOFORTH p_strncmp       ; ( s1* s2 n -- v )
  97         pop rax                 ; return value v
  98         pop rcx                 ; restore tfa
  99         cmp rax,0
 100         je p_find_found
 101         mov rbx,qword [rsp]
 102         mov rsi,qword [rsp+8]
 103 p_find_nextword:
 104         mov rcx,qword [rcx]
 105         jmp p_find_loop
 106 p_find_notfound:
 107         xor rcx,rcx
 108         sub rsp,16
 109 p_find_found:
 110         add rsp,8
 111         mov qword [rsp],rcx     ; replace with tfa / 0
 112         popr rsi
 113         next