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 include 'signals.asm'
 110
 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.
 114 previous_word = 0
 115
 116         WORD p_system,'SYSTEM',dovariable
 117         ;; ( -- dfa )
 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
 121
 122         WORD inline_code,'[ASM]',fasm
 123         ;; ( -- )
 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".
 128         jmp qword rsi
 129
 130         WORD p_execute,'EXECUTE',fasm
 131         ;; ( cfa -- )
 132         ;; Execute the word
 133         pop rax
 134         jmp qword [rax]         ; goto code of that FORTH word (64 bit jump)
 135
 136         WORD p_sysexit, 'EXIT',
 137         ;; ( v -- )
 138         ;; Terminate RRQFORTH with error code
 139         dq sys_exit
 140
 141         WORD p_return, 'RETURN',fasm
 142         ;; ( -- ) ( R: addr -- )
 143         ;; Returns execution to the calling definition as per the
 144         ;; return stack.
 145 exit:
 146         popr rsi
 147         next
 148
 149         ;; TERMINATE0 terminates the program with code 0
 150         ;; ( -- )
 151         WORD p_terminate, 'TERMINATE0',fasm
 152         pop rdx
 153 terminate_special:
 154         mov eax,60
 155         syscall
 156
 157 ;;; ========================================
 158 ;;; Core extension(s)
 159
 160         ;segment readable writable executable
 161
 162 include 'control.asm'
 163 include 'wordlists.asm'
 164 include 'memory.asm'
 165 include 'stack.asm'
 166 include 'math.asm'
 167 include 'logic.asm'
 168 include 'stdio.asm'
 169 include 'temp.asm'
 170 include 'compile.asm'
 171
 172         WORD p_program_version,'PROGRAM_VERSION',dostring
 173         STRING 'RRQ Forth version 0.1 - 2021-06-05',10
 174
 175         WORD p_stdin,'STDIN',dovalue
 176         ;; Initialised to hold a STREAM for fd 0
 177         dq 0
 178
 179         WORD p_args,'MAIN-ARGS',dovalue
 180         ;; Pointer to initial argument block
 181         dq 0       ; *(int argc,(char*[argc]) argv)
 182
 183         WORD p_verboseQ,'VERBOSE?',dovariable
 184         ;; Flags whether the running is in verbose mode ot not
 185         dq 0       ;
 186
 187         WORD p_lparen,'(',fasm,IMMEDIATE
 188         pushr rsi
 189 p_lparen_loop:
 190         DOFORTH  p_input, p_get, p_read_word
 191         pop rax
 192         pop rbx
 193         cmp rax,0 ; end of stream
 194         je p_lparen_exit
 195         cmp rax,1
 196         jne p_lparen_loop
 197         push rbx
 198         push p_lparen_rparen
 199         push 1
 200         DOFORTH p_strncmp
 201         pop rax
 202         cmp rax,0
 203         jne p_lparen_loop
 204 p_lparen_exit:
 205         popr rsi
 206         next
 207 p_lparen_rparen: db ')',0
 208
 209 ;;; ******** The main entry point. ********
 210 ;;; This could be set up as a WORD but it isn't
 211
 212 main:
 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
 216         mov rbp,RS_TOP
 217         call p_setup_signals_DFA
 218         call main_is_verbose
 219         mov qword [p_verboseQ_DFA],rdx
 220         jmp p_quit_DFA          ; QUIT
 221
 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:
 226         db '-v',0
 227
 228 main_is_verbose:
 229         mov rbx,qword [p_args_DFA] ; Pointer to main arguments
 230         mov r8,qword [rbx]         ; r8 = count of pointers
 231         xor rdx,rdx
 232         cld
 233 main_is_verbose_next:
 234         dec r8
 235         jl main_is_not_verbose
 236         add rbx,8
 237         mov rsi,qword [rbx]
 238         mov rdi,main_is_verbose_data
 239 main_is_verbose_loop:
 240         cmpsb
 241         jne main_is_verbose_next
 242         cmp byte[rsi-1],0
 243         jne main_is_verbose_loop
 244         not rdx
 245 main_is_not_verbose:
 246         ret
 247
 248         WORD p_process_args_var,'PROCESS-ARGS-VAR',dovariable
 249         ;; ( -- a )
 250         ;; Two cells for iterating and load the main args
 251 p_process_args_ptr: dq 0
 252 p_process_args_end: dq 0
 253
 254         WORD p_process_args,'PROCESS-ARGS',fasm
 255         pushr rsi
 256         mov rax,qword [p_args_DFA] ; args*
 257         mov rbx,qword [rax] ; count
 258         shl rbx,3
 259         add rax,8
 260         add rbx,rax ; end
 261         mov qword [p_process_args_end],rbx
 262         add rax,8
 263         mov qword [p_process_args_ptr],rax
 264 p_process_args_loop:
 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
 269         mov rax,qword [rax]
 270         mov bl,[rax]
 271         cmp bl,'-'
 272         je p_process_args_loop
 273         push rax
 274         push rax
 275         FORTH
 276         dq p_strlen, p_load_file
 277         BRANCH 0, p_quit_ERROR
 278         ENDFORTH
 279         jmp p_process_args_loop
 280 p_process_args_done:
 281         popr rsi
 282         next
 283
 284 ;;; This word is also the last word before syscalls
 285 last_forth_word:
 286         WORD p_quit,'QUIT',fasm
 287         ;; QUIT is the program entry point ********************
 288         mov rsp,DS_TOP
 289         mov rbp,RS_TOP
 290         cmp qword [p_stdin_DFA],0
 291         jne p_quit_INITIALIZED
 292         ;; Initialize STDIN
 293         push 0
 294         push 10000
 295         DOFORTH p_stream
 296         pop qword [p_stdin_DFA] ; Assign STDIN
 297         DOFORTH p_process_args
 298
 299 p_quit_INITIALIZED:
 300         ;; Setup INPUT from STDIN
 301         FORTH
 302         dq p_verboseQ, p_get
 303         BRANCH 0,p_quit_EVAL
 304         dq p_program_version, p_tell
 305 p_quit_EVAL:
 306         dq p_stdin, p_evaluate_stream
 307         BRANCH 0,p_quit_ERROR
 308         dq p_false, sys_exit
 309 p_quit_ERROR:
 310         dq p_literal_string
 311         STRING 10,'*** Unknown word: '
 312         dq p_tell
 313         dq p_this_word, p_2get, p_tell
 314         dq p_nl, p_emit
 315         ENDFORTH
 316         mov rbp,RS_TOP          ; reset the return stack
 317         jmp p_quit_INITIALIZED
 318
 319 ;;; ========================================
 320
 321         ;segment readable writable
 322
 323 heap_start:
 324         rb 1048576              ; +1 Mb heap
 325         rb 1048576              ; +1 Mb heap
 326         rb 1048576              ; +1 Mb heap
 327         rb 1048576              ; +1 Mb heap
 328         rb 1048576              ; +1 Mb heap