+ entry main
+
+;;; ========================================
+;;; The pushr macro pushes x onto the return stack
+;;; The popr macro pops x from the return stack
+macro pushr x {
+ sub rbp, 8
+ mov [rbp], x
+}
+
+macro popr x {
+ mov x, [rbp]
+ add rbp, 8
+}
+
+;;; ========================================
+;;; The next macro "moves" execution to the next FORTH instruction,
+;;; using rsi as instruction pointer. It points to the doer field of a
+;;; word, which points to the assembly code that implements the
+;;; execution effect of the word. That doer code is entered with rsi
+;;; referring to the subsequent address in the colling word, and rax
+;;; referring to the doer field of the called word.
+
+macro next {
+ lodsq ; mov rax, [rsi] + add rsi,8
+ jmp qword [rax] ; goto code of that FORTH word (64 bit jump)
+}
+
+;;; ========================================
+;;; The FORTH macro transitions to inline FORTH execution.
+macro FORTH {
+ local forthcode
+ mov rsi,forthcode
+ next
+ ;; align 8
+forthcode:
+}
+
+;;; ========================================
+;;; The ENDFORTH macro transitions back to inline assembler after FORTH
+;;; ========================================
+macro ENDFORTH {
+ dq inline_code
+}
+
+;;; ========================================
+;;; The DOFORTH lays out a single FORTH call
+;;; ========================================
+macro DOFORTH label {
+ FORTH
+ dq label
+ ENDFORTH
+}
+
+;;; Macro WORD starts a FORTH word definition in this code
+;;;
+ previous_word = 0 ; Used for chaining the words
+
+ IMMEDIATE = 1 ; optional flag
+
+macro WORD label, name, doer, flags {
+ ;; align 8
+label#_TFA:
+ ;; TFA
+ dq previous_word
+ previous_word = label#_TFA
+ ;; PFA
+label#_PFA:
+ db flags + 0
+ db label - $ - 2
+ db name
+ db 0
+ ;; align 8
+
+label#_OFF:
+ dq 0 ; The DOES offset. Defaults to 0.
+ ;; also CFA = pointer to "doer"
+label:
+ if doer eq
+ dq doforth
+ else
+ if doer in <fasm>
+ dq label#_DFA
+ else
+ dq doer
+ end if
+ end if
+ ;; DFA
+label#_DFA:
+}
+
+;;; ============================================================
+;;; FORTH machine model
+;;; rsp = data stack pointer
+;;; rbp = return stack pointer
+;;; rsi = instruction pointer
+
+;;; ============================================================