rrqforth.asm

   1 ; This is a forth interpreter for x86_64 (elf64)
   2         format elf64 executable
   3         entry main
   4
   5 previous_word = 0       ; Used for chaining the words
   6
   7 include 'machine.asm'
   8
   9 ;;; ============================================================
  10
  11         segment readable executable
  12
  13 ;;; This is the very first word
  14
  15         ;; FORTH is the last word of WORDLIST FORTH
  16         WORD p_forth,'FORTH',dowordlist
  17         ;; ( -- )
  18         ;; Change to use this wordlist
  19         dq last_forth_word
  20
  21         WORD p_system,'SYSTEM',dowordlist
  22         ;; ( -- )
  23         ;; Change to use this wordlist
  24         dq last_system_word
  25
  26 last_wordlists_word:
  27         WORD p_wordlists,'WORDLISTS',dowordlist
  28         ;; ( -- )
  29         ;; Change to use this wordlist
  30         dq p_wordlists_TFA
  31
  32 ;;; ========================================
  33 ;;; These are the core "execution semantics" words, which are placed
  34 ;;; first so as to remain at the same binary address at successive
  35 ;;; compilations, which is helful for declaring special debugging gdb
  36 ;;; aliases.
  37 ;;;
  38 ;;; The DO* words are declared as "variables" to provide their
  39 ;;; assembled address when used in FORTH.
  40 ;;;
  41 ;;; The register context at entry to an "execution semantcs" code
  42 ;;; snippets is:
  43 ;;; rax = cfa* of word to execute
  44 ;;; rsi = cell* in the calling definition, after calling cell
  45 ;;; rsp = data stack pointer
  46 ;;; rbp = return stack pointer
  47 ;;;
  48
  49         WORD p_dofasm,'doFASM',dovariable
  50         ;; Execution semantics for assembly words.
  51 dofasm:
  52         add rax,8
  53         jmp rax
  54
  55         WORD p_doforth,'doFORTH',dovariable ;
  56         ;; Execution semantics for FORTH defition word.
  57 doforth:
  58         pushr rsi
  59         lea rsi, [rax+8]        ; rsi = the DFA of the rax word
  60         next
  61
  62         WORD p_dodoes,'doDOES',dovariable
  63         ;; Execution semantics for DOES>
  64         ;; [cfa-8] holds the adjustment offset ("does offset")
  65 dodoes:
  66         pushr rsi
  67         lea rsi, [rax+8]        ; rsi = the DFA of the rax word
  68         add rsi,qword [rax-8]   ; adjust rsi by the "does offset'
  69         next
  70
  71         WORD p_dovariable,'doVARIABLE',dovariable
  72         ;; Execution semantics for a variable ( -- addr )
  73         ;; rax points to CFA field
  74 dovariable:
  75         lea rax, [rax+8]        ; rsi = the DFA of the rax word
  76         push rax
  77         next
  78
  79         WORD p_dovalue,'doVALUE',dovariable
  80         ;; Execution semantics for a value constant ( -- v )
  81         ;; rax points to CFA field
  82 dovalue:
  83         lea rax, [rax+8]        ; rsi = the DFA of the rax word
  84         push qword [rax]
  85         next
  86
  87         WORD p_dostring,'doSTRING',dovariable
  88         ;; Execution semantics for a string constant ( -- addr n )
  89         ;; rax points to CFA field
  90 dostring:
  91         lea rax, [rax+8]        ; rsi = the DFA of the rax word
  92         pushpname rax
  93         next
  94
  95         WORD p_dowordlist,'doWORDLIST',dovariable
  96         ;; Execution semantics for DOES>
  97         ;; [cfa-8] holds the adjustment offset ("does offset")
  98 dowordlist:
  99         pushr rsi
 100         lea rsi, [rax+8]        ; rsi = the DFA of the rax word
 101         add rsi,qword [rax-8]   ; adjust rsi by the "does offset'
 102         next
 103
 104
 105 include 'syscalls.asm'
 106
 107 ;;; ========================================
 108 ;;; The stacks are placed here.
 109
 110         segment readable writable
 111
 112         WORD return_stack,'RETURN-STACK',dovariable
 113         ;; The return stack
 114         BLOCK RS_TOP
 115         rb 1048576              ; 1 Mb return stack
 116 RS_TOP:                         ; The initial rbp
 117
 118 last_system_word:
 119         WORD data_stack,'DATA-STACK',dovariable
 120         ;; The data stack
 121         BLOCK DS_TOP
 122         rb 1048576              ; 1 Mb data stack
 123 DS_TOP:                         ; The initial rsp
 124
 125 ;;; ========================================
 126 ;;; Core execution control words
 127
 128         segment readable executable
 129
 130 ;;; At fasm compilation: reset previous_word to make a new word list
 131 ;;; Words above belong to the SYSTEM wordlist, and the following
 132 ;;; belong to the FORTH wordlist.
 133 previous_word = last_wordlists_word
 134
 135         WORD inline_code,'[ASM]',fasm
 136         ;; ( -- )
 137         ;; This transitions execution into inline assembler in the
 138         ;; calling word defintion. Note that it stops advancing rsi;
 139         ;; code should use FORTH macro to reenter forth execution, or
 140         ;; exit to the calling definition via "jmp exit".
 141         jmp qword rsi
 142
 143         WORD p_execute,'EXECUTE',fasm
 144         ;; ( tfa -- )
 145         ;; Execute the word
 146         pop rax
 147         tfa2cfa rax
 148         jmp qword [rax]         ; goto code of that FORTH word (64 bit jump)
 149
 150         WORD p_exit, 'EXIT',fasm
 151         ;; ( -- ) ( R: addr -- )
 152         ;; Returns execution to the calling definition as per the
 153         ;; return stack.
 154 exit:
 155         popr rsi
 156         next
 157
 158         ;; TERMINATE0 terminates the program with code 0
 159         ;; ( -- )
 160         WORD p_terminate, 'TERMINATE0',fasm
 161         pop rdx
 162 terminate_special:
 163         mov eax,60
 164         syscall
 165
 166         WORD p_branch,'BRANCH',fasm
 167         ;; ( -- )
 168         ;; Using subsequent inline cell as branch offset, branch
 169         ;; accordingly
 170         add rsi,qword [rsi]
 171         add rsi,8
 172         next
 173
 174         WORD p_zero_branch,'0BRANCH',fasm
 175         ;; ( v -- )
 176         ;; Using subsequent inline cell as branch offset, branch
 177         ;; accordingly if the stacked value is zero, otherwise just
 178         ;; skip over the branch offset
 179         pop rax
 180         cmp rax,0
 181         jne p_zero_branch_SKIP
 182         add rsi,qword [rsi]
 183 p_zero_branch_SKIP:
 184         add rsi,8
 185         next
 186
 187 ;;; ========================================
 188 ;;; Core extension(s)
 189
 190         segment readable writable executable
 191
 192 include 'wordlists.asm'
 193 include 'memory.asm'
 194 include 'stack.asm'
 195 include 'math.asm'
 196 include 'logic.asm'
 197 include 'stdio.asm'
 198 include 'compile.asm'
 199
 200         WORD p_program_version,'PROGRAM_VERSION',dostring
 201         STRING 'RRQ Forth version 0.1 - 2021-05-13',10
 202
 203         WORD p_stdin,'STDIN',dovalue
 204         ;; Initialised to hold a STREAM for fd 0
 205         dq 0
 206
 207 ;;; The main entry point.
 208 ;;; This word is also the last word before syscalls
 209 last_forth_word:
 210         WORD p_quit,'QUIT',fasm
 211         ;; QUIT is the program entry point ********************
 212 main:
 213         mov rsp,DS_TOP
 214         mov rbp,RS_TOP
 215         cmp qword [p_stdin_DFA],0
 216         jne p_quit_INITIALIZED
 217         ;; Initialize STDIN
 218         push 0
 219         push 10000
 220         DOFORTH p_stream
 221         pop qword [p_stdin_DFA] ; Assign STDIN
 222
 223 p_quit_INITIALIZED:
 224         ;; Initial blurb
 225         FORTH
 226         dq p_program_version
 227         dq p_tell
 228         dq p_stdin
 229         dq p_clear_stream
 230         dq p_stdin
 231         dq p_evaluate_stream
 232         BRANCH 0,p_quit_ERROR
 233         dq p_false
 234         dq sys_exit
 235 p_quit_ERROR:
 236         dq p_literal_string
 237         STRING 10,'*** Unknown word: '
 238         dq p_tell
 239         dq p_this_word
 240         dq p_2get
 241         dq p_tell
 242         dq p_literal_string
 243         STRING 10
 244         dq p_tell
 245         ENDFORTH
 246         mov rbp,RS_TOP          ; reset the return stack
 247         jmp main
 248
 249 ;;; ========================================
 250
 251         segment readable writable
 252
 253 heap_start:
 254         rb 1048576              ; +1 Mb heap
 255         rb 1048576              ; +1 Mb heap
 256         rb 1048576              ; +1 Mb heap
 257         rb 1048576              ; +1 Mb heap
 258         rb 1048576              ; +1 Mb heap