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         WORD p_branch,'BRANCH',fasm
 151         ;; ( -- )
 152         ;; Using subsequent inline cell as branch offset, branch
 153         ;; accordingly
 154         add rsi,qword [rsi]
 155         add rsi,8
 156         next
 157
 158         WORD p_zero_branch,'0BRANCH',fasm
 159         ;; ( v -- )
 160         ;; Using subsequent inline cell as branch offset, branch
 161         ;; accordingly if the stacked value is zero, otherwise just
 162         ;; skip over the branch offset
 163         pop rax
 164         cmp rax,0
 165         jne p_zero_branch_SKIP
 166         add rsi,qword [rsi]
 167 p_zero_branch_SKIP:
 168         add rsi,8
 169         next
 170
 171 ;;; ========================================
 172 ;;; Core extension(s)
 173
 174         ;segment readable writable executable
 175
 176 include 'wordlists.asm'
 177 include 'memory.asm'
 178 include 'stack.asm'
 179 include 'math.asm'
 180 include 'logic.asm'
 181 include 'stdio.asm'
 182 include 'compile.asm'
 183
 184         WORD p_program_version,'PROGRAM_VERSION',dostring
 185         STRING 'RRQ Forth version 0.1 - 2021-05-22',10
 186
 187         WORD p_stdin,'STDIN',dovalue
 188         ;; Initialised to hold a STREAM for fd 0
 189         dq 0
 190
 191         WORD p_args,'ARGS',dostring
 192         ;; Pointer to initial argument block
 193         dq 0       ; *(int argc,(char*[argc]) argv)
 194
 195         WORD p_lparen,'(',fasm,IMMEDIATE
 196         pushr rsi
 197 p_lparen_loop:
 198         DOFORTH  p_stdin, p_read_word
 199         pop rax
 200         pop rbx
 201         cmp rax,0 ; end of stream
 202         je p_lparen_exit
 203         cmp rax,1
 204         jne p_lparen_loop
 205         push rbx
 206         push qword ')'
 207         push 1
 208         DOFORTH p_strncmp
 209         pop rax
 210         cmp rax,0
 211         jne p_lparen_loop
 212 p_lparen_exit:
 213         popr rsi
 214         next
 215
 216 ;;; ******** The main entry point. ********
 217 main:
 218         ;; Initial rsp points to the arguments block of size (64 bits)
 219         ;; followed by the argument pointers.
 220         mov qword [p_args_DFA],rsp
 221         jmp p_quit_DFA          ; QUIT
 222
 223 ;;; This word is also the last word before syscalls
 224 last_forth_word:
 225         WORD p_quit,'QUIT',fasm
 226         ;; QUIT is the program entry point ********************
 227
 228         mov rsp,DS_TOP
 229         mov rbp,RS_TOP
 230         cmp qword [p_stdin_DFA],0
 231         jne p_quit_INITIALIZED
 232         ;; Initialize STDIN
 233         push 0
 234         push 10000
 235         DOFORTH p_stream
 236         pop qword [p_stdin_DFA] ; Assign STDIN
 237
 238 p_quit_INITIALIZED:
 239         ;; Initial blurb
 240         FORTH
 241         dq p_program_version
 242         dq p_tell
 243         dq p_stdin
 244         dq p_evaluate_stream
 245         BRANCH 0,p_quit_ERROR
 246         dq p_false
 247         dq sys_exit
 248 p_quit_ERROR:
 249         dq p_literal_string
 250         STRING 10,'*** Unknown word: '
 251         dq p_tell
 252         dq p_this_word
 253         dq p_2get
 254         dq p_tell
 255         dq p_literal_string
 256         STRING 10
 257         dq p_tell
 258         ENDFORTH
 259         mov rbp,RS_TOP          ; reset the return stack
 260         jmp main
 261
 262 ;;; ========================================
 263
 264         ;segment readable writable
 265
 266 heap_start:
 267         rb 1048576              ; +1 Mb heap
 268         rb 1048576              ; +1 Mb heap
 269         rb 1048576              ; +1 Mb heap
 270         rb 1048576              ; +1 Mb heap
 271         rb 1048576              ; +1 Mb heap