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 ;;; This is the very first word
  12
  13         ;; FORTH is the last word of WORDLIST FORTH
  14         WORD p_forth,'FORTH',dovalue
  15         ;; ( -- )
  16         ;; Change to use this wordlist
  17         dq last_forth_word
  18         dq inline_code
  19         mov rax,qword [p_forth_DFA]
  20         mov qword [p_wordlist],rax
  21         popr rsi
  22         next
  23
  24         WORD p_syscall,'SYSCALL',dodoes,,,8
  25         ;; ( -- )
  26         ;; Change to use this wordlist
  27         dq last_syscall_word
  28         dq inline_code
  29         mov rax,qword [p_syscall_DFA]
  30         mov qword [p_wordlist],rax
  31         popr rsi
  32         next
  33
  34 last_wordlists_word:
  35         WORD p_wordlists,'WORDLISTS',dodoes,,,8
  36         ;; ( -- )
  37         ;; Change to use this wordlist
  38         dq p_wordlists_TFA
  39         dq inline_code
  40         mov rax,qword [p_wordlists_DFA]
  41         mov qword [p_wordlist],rax
  42         popr rsi
  43         next
  44
  45 include 'wordlists.asm'
  46
  47         WORD return_stack,'RS',dovariable
  48         ;; The return stack
  49         rb 1048576              ; 1 Mb return stack
  50 RS_TOP:                         ; The initial rbp
  51
  52         WORD data_stack,'DS',dovariable
  53         ;; The data stack
  54         rb 1048576              ; 1 Mb data stack
  55 DS_TOP:                         ; The initial rsp
  56
  57         WORD inline_code,'[ASM]',fasm
  58         ;; ( -- )
  59         ;; This transitions execution into inline assembler in the
  60         ;; calling word defintion. Note that it stops advancing rsi;
  61         ;; code should use FORTH macro to reenter forth execution, or
  62         ;; exit to the calling definition via "jmp exit".
  63         jmp qword rsi
  64
  65         WORD p_execute,'EXECUTE',fasm
  66         ;; ( tfa -- )
  67         ;; Execute the word
  68         pop rax
  69         tfa2cfa rax
  70         jmp qword [rax]         ; goto code of that FORTH word (64 bit jump)
  71
  72         WORD p_exit, 'EXIT',fasm
  73         ;; ( -- ) ( R: addr -- )
  74         ;; Returns execution to the calling definition as per the
  75         ;; return stack.
  76 exit:
  77         popr rsi
  78         next
  79
  80         ;; TERMINATE0 terminates the program with code 0
  81         ;; ( -- )
  82         WORD terminate, 'TERMINATE0',fasm
  83         pop rdx
  84 terminate_special:
  85         mov eax,60
  86         syscall
  87
  88         WORD p_branch,'BRANCH',fasm
  89         ;; ( -- )
  90         ;; Using subsequent inline cell as branch offset, branch
  91         ;; accordingly
  92         add rsi,qword [rsi]
  93         add rsi,8
  94         next
  95
  96         WORD p_zero_branch,'0BRANCH',fasm
  97         ;; ( v -- )
  98         ;; Using subsequent inline cell as branch offset, branch
  99         ;; accordingly if the stacked value is zero, otherwise just
 100         ;; skip over the branch offset
 101         pop rax
 102         cmp rax,0
 103         jne p_zero_branch_SKIP
 104         add rsi,qword [rsi]
 105 p_zero_branch_SKIP:
 106         add rsi,8
 107         next
 108
 109 ;;; Execution semantics for a "fasm" WORD
 110 dofasm:
 111         add rax,8
 112         jmp rax
 113 ;;; Execution semantics for FORTH defition word
 114 ;;; At entry, rsi points into the calling definition, at the cell
 115 ;;; following the cell indicating this word, rax points to the CFA of
 116 ;;; this word.
 117 doforth:
 118         pushr rsi
 119         lea rsi, [rax+8]        ; rsi = the DFA of the rax word
 120         next
 121
 122 ;;; Execution semantics for DOES>
 123 ;;; The cell at [cfa-8] holds an adjustment offset.
 124 dodoes:
 125         pushr rsi
 126         lea rsi, [rax+8]        ; rsi = the DFA of the rax word
 127         add rsi,[rax-8]         ; adjust rsi to the DOES> part
 128         next
 129
 130         ;; Execution semantics for a variable ( -- addr )
 131         ;; rax points to CFA field
 132 dovariable:
 133         add rax,8
 134         push rax
 135         next
 136
 137         ;; Execution semantics for a constant ( -- v )
 138         ;; rax points to CFA field
 139 dovalue:
 140         push qword [rax+8]
 141         next
 142
 143         ;; Execution semantics for a string constant ( -- addr n )
 144         ;; rax points to CFA field
 145 dostring:
 146         cfa2dfa rax
 147         pushpname rax
 148         next
 149
 150 include 'memory.asm'
 151 include 'stack.asm'
 152 include 'math.asm'
 153 include 'logic.asm'
 154 include 'stdio.asm'
 155 include 'compile.asm'
 156
 157         WORD p_program_version,'PROGRAM_VERSION',dostring
 158         STRING 'RRQ Forth version 0.1 - 2021-05-13',10
 159
 160         WORD p_stdin,'STDIN',dovalue
 161         ;; Initialised to hold a STREAM for fd 0
 162         dq 0
 163
 164 ;;; The main entry point.
 165 ;;; This word is also the last word before syscalls
 166 last_forth_word:
 167         WORD p_quit,'QUIT',fasm
 168         ;; QUIT is the program entry point ********************
 169 main:
 170         mov rsp,DS_TOP
 171         mov rbp,RS_TOP
 172         cmp qword [p_stdin_DFA],0
 173         jne p_quit_INITIALIZED
 174         ;; Initialize STDIN
 175         push 0
 176         push 10000
 177         DOFORTH p_stream
 178         pop qword [p_stdin_DFA] ; Assign STDIN
 179
 180 p_quit_INITIALIZED:
 181         ;; Initial blurb
 182         FORTH
 183         dq p_program_version
 184         dq p_tell
 185         dq p_stdin
 186         dq p_clear_stream
 187         dq p_stdin
 188         dq p_evaluate_stream
 189         BRANCH 0,p_quit_ERROR
 190         dq p_false
 191         dq sys_exit
 192 p_quit_ERROR:
 193         dq p_literal_string
 194         STRING 10,'*** Unknown word: '
 195         dq p_tell
 196         dq p_this_word
 197         dq p_2get
 198         dq p_tell
 199         dq p_literal_string
 200         STRING 10
 201         dq p_tell
 202         ENDFORTH
 203         mov rbp,RS_TOP          ; reset the return stack
 204         jmp main
 205
 206         ;; At fasm compilation: reset to make a new word list
 207         previous_word = last_wordlists_word
 208
 209 include 'syscalls.asm'
 210
 211
 212 last_word:
 213
 214 heap_start:
 215         rb 1048576              ; +1 Mb heap
 216         rb 1048576              ; +1 Mb heap
 217         rb 1048576              ; +1 Mb heap