rrqforth.asm

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