+;;; ######################################################################
+
+;;; ============================================================
+;;; FORTH machine model
+;;; rsp = data stack pointer
+;;; rbp = return stack pointer
+;;; rsi = instruction pointer
+
+;;; ========================================
+;;; 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
+}
+
+ previous_word = 0 ; Used for chaining the words
+
+ IMMEDIATE = 1 ; optional flag (symbol)
+
+;;; ========================================
+;;; Macro WORD starts a FORTH word definition in this code.
+;;; The layout of a word is as follows:
+;;; TFA: [8 bytes] pointer to previous word in the word list
+;;; [8 bytes] pointer to the word's CFA
+;;; [8 bytes] a flags field
+;;; [8 bytes] the length of the word's pname
+;;; [varying] the word's pname
+;;; [1 byte] NUL -- making an asciiz of the pname
+;;; ;;[? bytes] 0-7 bytes for address alignment to [disabled]
+;;; [8 bytes] pointer to the word's TFA
+;;; OFF: [8 bytes] the DOES offset for the word
+;;; CFA: [8 bytes] pointer to the word's "doer" code
+;;; DFA: [? bytes] the word's data field
+
+macro WORD label, name, doer, flags, previous, offset {
+ local pname
+ ;; align 8
+label#_TFA:
+ ;; TFA
+ if previous eq
+ dq previous_word
+ else
+ dq previous
+ end if
+ previous_word = label#_TFA
+ ;; PFA
+label#_pCFA:
+ dq label#_CFA ; link to CFA of word
+ dq flags + 0
+label#_PFA:
+ dq pname - $ - 8
+ db name
+pname: db 0 ; extra NUL byte
+ ;; align 8
+label#_pTFA:
+ dq label#_TFA ; link to TFA of word
+label#_OFF:
+ dq offset + 0 ; The DOES offset. Defaults to 0.
+ ;; also CFA = pointer to "doer"
+label#_CFA:
+label:
+ if doer eq
+ dq doforth
+ else
+ if doer in <fasm>
+ dq label#_DFA
+ else
+ dq doer
+ end if
+ end if
+ ;; DFA
+label#_DFA:
+}
+
+macro tfa2cfa reg {
+ mov reg,qword [reg+8]
+}
+macro tfa2does reg {
+ tfa2cfa reg
+ sub reg,8
+}
+macro tfa2dfa reg {
+ tfa2cfa reg
+ add reg,8
+}
+macro tfa2flags reg {
+ add reg,16
+}
+macro tfa2pfa reg {
+ add reg,24
+}
+macro tfa2pname reg {
+ add reg,32
+}
+macro cfa2tfa reg {
+ sub reg,16
+ mov reg,qword [reg]
+}
+macro cfa2dfa reg {
+ add reg,8
+}
+macro dfa2cfa reg {
+ sub reg,8
+}
+macro dfa2tfa reg {
+ sub reg,24
+ mov reg,qword [reg]
+}
+macro pushpname rg { ; ( reg -- chars* length )
+ add rg,8
+ push rg
+ sub rg,8
+ push qword [rg]
+}
+;;; ========================================
+;;; The BLOCK macro lays out the length for a subsequent block to the
+;;; given label.
+macro BLOCK endlabel {
+ local datastart
+ dq endlabel - datastart
+datastart:
+ }
+
+;;; ========================================
+;;; The STRING macro lays out length cell and data for several string
+;;; components.
+macro STRING [data] {
+common
+ local datastart, dataend
+ dq dataend - datastart
+datastart:
+forward
+ db data
+common
+dataend:
+ }