1 ; This is a forth interpreter for x86_64 (elf64)
2 format elf64 executable
7 ;;; ============================================================
9 segment readable writable executable
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
17 ;;; The DO* words are declared as "variables" to provide their
18 ;;; assembled address when used in FORTH.
20 ;;; The register context at entry to an "execution semantcs" code
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
28 previous_word = 0 ; Used for chaining the words
30 WORD p_dofasm,'doFASM',dovariable
31 ;; Execution semantics for assembly words.
36 WORD p_doforth,'doFORTH',dovariable ;
37 ;; Execution semantics for FORTH defition word.
40 lea rsi, [rax+8] ; rsi = the DFA of the rax word
43 WORD p_dodoes,'doDOES',dovariable
44 ;; Execution semantics for DOES>
45 ;; [cfa-8] holds the adjustment offset ("does offset")
48 lea rsi, [rax+8] ; rsi = the DFA of the rax word
49 add rsi,qword [rax-8] ; adjust rsi by the "does offset'
52 WORD p_dovariable,'doVARIABLE',dovariable
53 ;; Execution semantics for a variable ( -- addr )
54 ;; rax points to CFA field
56 lea rax, [rax+8] ; rsi = the DFA of the rax word
60 WORD p_dovalue,'doVALUE',dovariable
61 ;; Execution semantics for a value constant ( -- v )
62 ;; rax points to CFA field
64 lea rax, [rax+8] ; rsi = the DFA of the rax word
68 WORD p_dostring,'doSTRING',dovariable
69 ;; Execution semantics for a string constant ( -- addr n )
70 ;; rax points to CFA field
72 lea rax, [rax+8] ; rsi = the DFA of the rax word
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
83 include 'syscalls.asm'
85 ;;; ========================================
86 ;;; The stacks are placed here.
88 ;segment readable writable
90 WORD return_stack,'RETURN-STACK',dovariable
93 rb 1048576 ; 1 Mb return stack
94 RS_TOP: ; The initial rbp
97 WORD data_stack,'DATA-STACK',dovariable
100 rb 1048576 ; 1 Mb data stack
101 DS_TOP: ; The initial rsp
104 ;;; ========================================
105 ;;; Core execution control words
107 ;segment readable executable
109 include 'signals.asm'
111 ;;; At fasm compilation: reset previous_word to make a new word list
112 ;;; Words above belong to the SYSTEM wordlist, and the following
113 ;;; belong to the FORTH wordlist.
116 WORD p_system,'SYSTEM',dovariable
118 ;; The SYSTEM word list
119 dq last_system_word ; tfa of last SYSTEM word
120 dq p_forth_DFA ; dfa of successor word list
122 WORD inline_code,'[ASM]',fasm
124 ;; This transitions execution into inline assembler in the
125 ;; calling word defintion. Note that it stops advancing rsi;
126 ;; code should use FORTH macro to reenter forth execution, or
127 ;; exit to the calling definition via "jmp exit".
130 WORD p_execute,'EXECUTE',fasm
134 jmp qword [rax] ; goto code of that FORTH word (64 bit jump)
136 WORD p_sysexit, 'EXIT',
138 ;; Terminate RRQFORTH with error code
141 WORD p_return, 'RETURN',fasm
142 ;; ( -- ) ( R: addr -- )
143 ;; Returns execution to the calling definition as per the
149 ;; TERMINATE0 terminates the program with code 0
151 WORD p_terminate, 'TERMINATE0',fasm
157 ;;; ========================================
158 ;;; Core extension(s)
160 ;segment readable writable executable
162 include 'control.asm'
163 include 'wordlists.asm'
170 include 'compile.asm'
172 WORD p_program_version,'PROGRAM_VERSION',dostring
173 STRING 'RRQ Forth version 0.1 - 2021-06-05',10
175 WORD p_stdin,'STDIN',dovalue
176 ;; Initialised to hold a STREAM for fd 0
179 WORD p_args,'MAIN-ARGS',dovalue
180 ;; Pointer to initial argument block
181 dq 0 ; *(int argc,(char*[argc]) argv)
183 WORD p_verboseQ,'VERBOSE?',dovariable
184 ;; Flags whether the running is in verbose mode ot not
187 WORD p_lparen,'(',fasm,IMMEDIATE
190 DOFORTH p_input, p_get, p_read_word
193 cmp rax,0 ; end of stream
207 p_lparen_rparen: db ')',0
209 ;;; ******** The main entry point. ********
210 ;;; This could be set up as a WORD but it isn't
213 ;; Initial rsp points to the arguments block of size (64 bits)
214 ;; followed by the argument pointers.
215 mov qword [p_args_DFA],rsp
217 call p_setup_signals_DFA
219 mov qword [p_verboseQ_DFA],rdx
220 jmp p_quit_DFA ; QUIT
222 ;; Subroutine to check the command line for a "-v"
223 ;; return boolean in rdx
224 ;; implementation for that 2 byte asciiz string
225 main_is_verbose_data:
229 mov rbx,qword [p_args_DFA] ; Pointer to main arguments
230 mov r8,qword [rbx] ; r8 = count of pointers
233 main_is_verbose_next:
235 jl main_is_not_verbose
238 mov rdi,main_is_verbose_data
239 main_is_verbose_loop:
241 jne main_is_verbose_next
243 jne main_is_verbose_loop
248 WORD p_process_args_var,'PROCESS-ARGS-VAR',dovariable
250 ;; Two cells for iterating and load the main args
251 p_process_args_ptr: dq 0
252 p_process_args_end: dq 0
254 WORD p_process_args,'PROCESS-ARGS',fasm
256 mov rax,qword [p_args_DFA] ; args*
257 mov rbx,qword [rax] ; count
261 mov qword [p_process_args_end],rbx
263 mov qword [p_process_args_ptr],rax
265 mov rax,qword [p_process_args_ptr]
266 cmp rax,qword [p_process_args_end]
267 jge p_process_args_done
268 add qword [p_process_args_ptr],8
272 je p_process_args_loop
275 DOFORTH p_strlen, p_load_file, p_drop
276 jmp p_process_args_loop
281 ;;; This word is also the last word before syscalls
283 WORD p_quit,'QUIT',fasm
284 ;; QUIT is the program entry point ********************
287 cmp qword [p_stdin_DFA],0
288 jne p_quit_INITIALIZED
293 pop qword [p_stdin_DFA] ; Assign STDIN
294 DOFORTH p_process_args
297 ;; Setup INPUT from STDIN
305 dq p_stdin, p_evaluate_stream
306 BRANCH 0,p_quit_ERROR
311 STRING 10,'*** Unknown word: '
320 mov rbp,RS_TOP ; reset the return stack
321 jmp p_quit_INITIALIZED
323 ;;; ========================================
325 ;segment readable writable
328 rb 1048576 ; +1 Mb heap
329 rb 1048576 ; +1 Mb heap
330 rb 1048576 ; +1 Mb heap
331 rb 1048576 ; +1 Mb heap
332 rb 1048576 ; +1 Mb heap