format elf64 executable
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
+include 'machine.asm'
;;; ============================================================
;; exit to the calling definition via "jmp exit".
jmp qword rsi
+ WORD p_exit, 'EXIT',fasm
+ ;; ( -- ) ( R: addr -- )
+ ;; Returns execution to the calling definition as per the
+ ;; return stack.
+exit:
+ popr rsi
+ next
+
;;; Execution semantics for FORTH defition word
;;; At entry, rsi points into the calling definition, at the cell
;;; following the cell indicating this word, rax points to the CFA of
lea rsi, [rax+8] ; rsi = the DFA of the rax word
next
- WORD p_exit, 'EXIT',fasm
- ;; ( -- ) ( R: addr -- )
- ;; Returns execution to the calling definition as per the
- ;; return stack.
-exit:
- popr rsi
+;;; Execution semantics for DOES>
+;;; The cell at [cfa-8] holds an adjustment offset.
+dodoes:
+ pushr rsi
+ lea rsi, [rax+8] ; rsi = the DFA of the rax word
+ add rsi,[rax-8] ; adjust rsi to the DOES> part
next
;; Execution semantics for a variable ( -- addr )
- ;; rax points to doer field
+ ;; rax points to CFA field
dovariable:
- push rax+16
+ add rax,8
+ push rax
next
;; Execution semantics for a constant ( -- v )
- ;; rax points to doer field
+ ;; rax points to CFA field
dovalue:
- push qword [rax+16]
+ push qword [rax+8]
next
;; Execution semantics for a string constant ( -- addr n )
- ;; rax points to doer field
+ ;; rax points to CFA field
dostring:
- add rax,16
+ add rax,8
+ xor rbx,rbx
mov bl,[rax]
- mov byte [rsp],bl
- push rax+1
+ inc rax
+ push rax
+ push rbx
next
include 'wordlists.asm'
include 'stdio.asm'
WORD p_program_version,'PROGRAM_VERSION',dostring
- db length
-program_version_string:
- db 'RRQ Forth version 0.1 - 2021-05-13',10
- length = $ - program_version_string
+ STRING 'RRQ Forth version 0.1 - 2021-05-13',10
WORD p_stdin,'STDIN',dovalue
;; Initialised to hold a STREAM for fd 0
DOFORTH p_stream
pop qword [p_stdin_DFA]
- ;; read a word
- push qword 1 ; ( fd ) =stdout
- push qword [p_stdin_DFA]
- FORTH
- dq p_read_word ; ( fd s n )
- dq sys_write
- ENDFORTH
-
+ ;; Initial blurb
push qword 1 ; stdout
- push qword program_version_string ; address of string
- push qword length ; length of string (cheating)
+ DOFORTH p_program_version ; version string => ( s n )
DOFORTH sys_write ; printout
pop rax ; ignore errors
+
+ DOFORTH p_words
push 0
DOFORTH sys_exit