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         ;; ( cfa -- )
 130         ;; Execute the word
 131         pop rax
 132         jmp qword [rax]         ; goto code of that FORTH word (64 bit jump)
 133
 134         WORD p_exit, 'EXIT',fasm
 135         ;; ( -- ) ( R: addr -- )
 136         ;; Returns execution to the calling definition as per the
 137         ;; return stack.
 138 exit:
 139         popr rsi
 140         next
 141
 142         ;; TERMINATE0 terminates the program with code 0
 143         ;; ( -- )
 144         WORD p_terminate, 'TERMINATE0',fasm
 145         pop rdx
 146 terminate_special:
 147         mov eax,60
 148         syscall
 149
 150 ;;; ========================================
 151 ;;; Core extension(s)
 152
 153         ;segment readable writable executable
 154
 155 include 'control.asm'
 156 include 'wordlists.asm'
 157 include 'memory.asm'
 158 include 'stack.asm'
 159 include 'math.asm'
 160 include 'logic.asm'
 161 include 'stdio.asm'
 162 include 'compile.asm'
 163
 164         WORD p_program_version,'PROGRAM_VERSION',dostring
 165         STRING 'RRQ Forth version 0.1 - 2021-05-22',10
 166
 167         WORD p_stdin,'STDIN',dovalue
 168         ;; Initialised to hold a STREAM for fd 0
 169         dq 0
 170
 171         WORD p_args,'ARGS',dostring
 172         ;; Pointer to initial argument block
 173         dq 0       ; *(int argc,(char*[argc]) argv)
 174
 175         WORD p_lparen,'(',fasm,IMMEDIATE
 176         pushr rsi
 177 p_lparen_loop:
 178         DOFORTH  p_stdin, p_read_word
 179         pop rax
 180         pop rbx
 181         cmp rax,0 ; end of stream
 182         je p_lparen_exit
 183         cmp rax,1
 184         jne p_lparen_loop
 185         push rbx
 186         push qword ')'
 187         push 1
 188         DOFORTH p_strncmp
 189         pop rax
 190         cmp rax,0
 191         jne p_lparen_loop
 192 p_lparen_exit:
 193         popr rsi
 194         next
 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