format elf64 executable
entry main
-previous_word = 0 ; Used for chaining the words
-
include 'machine.asm'
;;; ============================================================
- segment readable executable
-
-;;; This is the very first word
+ segment readable writable executable
- ;; FORTH is the last word of WORDLIST FORTH
- WORD p_forth,'FORTH',dowordlist
- ;; ( -- )
- ;; Change to use this wordlist
- dq last_forth_word
-
- WORD p_system,'SYSTEM',dowordlist
- ;; ( -- )
- ;; Change to use this wordlist
- dq last_system_word
-
-last_wordlists_word:
- WORD p_wordlists,'WORDLISTS',dowordlist
- ;; ( -- )
- ;; Change to use this wordlist
- dq p_wordlists_TFA
-
;;; ========================================
;;; These are the core "execution semantics" words, which are placed
;;; first so as to remain at the same binary address at successive
;;; rbp = return stack pointer
;;;
+previous_word = 0 ; Used for chaining the words
+
WORD p_dofasm,'doFASM',dovariable
;; Execution semantics for assembly words.
dofasm:
pushpname rax
next
- WORD p_dowordlist,'doWORDLIST',dovariable
- ;; Execution semantics for DOES>
- ;; [cfa-8] holds the adjustment offset ("does offset")
-dowordlist:
- pushr rsi
- lea rsi, [rax+8] ; rsi = the DFA of the rax word
- add rsi,qword [rax-8] ; adjust rsi by the "does offset'
- next
-
-
include 'syscalls.asm'
;;; ========================================
;;; The stacks are placed here.
- segment readable writable
+ ;segment readable writable
WORD return_stack,'RETURN-STACK',dovariable
;; The return stack
rb 1048576 ; 1 Mb data stack
DS_TOP: ; The initial rsp
+
;;; ========================================
;;; Core execution control words
- segment readable executable
+ ;segment readable executable
;;; At fasm compilation: reset previous_word to make a new word list
;;; Words above belong to the SYSTEM wordlist, and the following
;;; belong to the FORTH wordlist.
-previous_word = last_wordlists_word
+previous_word = 0
+
+ WORD p_system,'SYSTEM',dovariable
+ ;; ( -- dfa )
+ ;; The SYSTEM word list
+ dq last_system_word ; tfa of last SYSTEM word
+ dq p_forth_DFA ; dfa of successor word list
WORD inline_code,'[ASM]',fasm
;; ( -- )
;;; ========================================
;;; Core extension(s)
- segment readable writable executable
+ ;segment readable writable executable
include 'wordlists.asm'
include 'memory.asm'
;;; ========================================
- segment readable writable
+ ;segment readable writable
heap_start:
rb 1048576 ; +1 Mb heap
-;;; This file contains words dealing with word lists (vocabularies)
+;;; This file contains words dealing with word lists (aka vocabularies)
;;;
;;; CURRENT-WORDLIST (variable) points out "the current wordlist"
-;;; SYSCALLS is a wordl list
;;; FORTH is a word list
;;;
-;;; !! When a word list word is created, it gets added to the tail end
-;;; of the current word list as way of making all word list words be
-;;; present in all word lists. This is different to all other kinds of
-;;; words, which instead are added to the head end of the current word
-;;; list.
-;;;
-;;; !! A word list word is created, it is initialised to the head end
-;;; of the current word list. It will this be an extension to that
-;;; current word list.
-;;;
-;;; EMPTY-WORDLIST is a word list word for an empty word list. It thus
-;;; only contains word list words.
-;;;
-;;; WORDLIST ( "name" -- ) = start
+
+ ;; 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 cfa of the currently active wordlist.
- dq p_forth_DFA
-
+ ;; CURRENT-WORDLIST points to dfa of the currently active wordlist.
+ dq p_forth_DFA ; compilation word list
+
WORD p_words,'WORDS',fasm
- ;; ( -- )
- ;; Dump all words
+ ;; ( w -- )
+ ;; Dump all words of the word list w (the dfa of a word list)
pushr rsi
- mov rax,qword [p_wordlist_DFA] ; current wordlist word
- mov rax,[rax] ; list start
- sub rsp,8 ; use stack to hold ptr
p_words_LOOP:
+ mov rax,qword [rsp]
+ mov rax,qword [rax] ; Next word
mov qword [rsp],rax
cmp rax,0
je p_words_END
- ;; tfa>pfa
tfa2pfa rax
- push 1
- ;; pfa@ => ( chars* length)
- pushpname rax
+ push 1 ; stdout
+ pushpname rax ; ( pfa* -- chars* length )
DOFORTH sys_write
pop rax ; ignore errors
push qword 10
- DOFORTH p_emit
- mov rax,qword [rsp]
- mov rax,qword [rax]
+ DOFORTH p_emit ; ( c -- )
jmp p_words_LOOP
p_words_END:
+ pop rax
popr rsi
next
;; 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.
- pop rdx
- pop rbx
- pop rax
+ pop rdx ; count
+ pop rbx ; chars2
+ pop rax ; chars1
xor rcx,rcx
;; rax = chars1, rbx = chars2, cl = byte acc, rdx = length
- inc rdx
p_strncmp_loop:
dec rdx
- jle p_strncmp_end
+ jl p_strncmp_end
mov cl,[rax]
inc rax
- sub cl,[rbx]
inc rbx
+ sub cl,[rbx-1]
je p_strncmp_loop
+ jmp p_strncmp_end
p_strncmp_end:
push rcx
next
;; ( chars* length -- [ chars* length 0 ]|[ tfa ] )
;; Search the current wordlists for the given pname
pushr rsi
- mov rcx,[p_wordlist_DFA]
+ 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*
mov rcx,qword [rcx]
jmp p_find_loop
p_find_notfound:
- xor rcx,rcx
- sub rsp,16
+ 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
+ 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