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