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_exit, 'EXIT',fasm
 137         ;; ( -- ) ( R: addr -- )
 138         ;; Returns execution to the calling definition as per the
 139         ;; return stack.
 140 exit:
 141         popr rsi
 142         next
 143
 144         ;; TERMINATE0 terminates the program with code 0
 145         ;; ( -- )
 146         WORD p_terminate, 'TERMINATE0',fasm
 147         pop rdx
 148 terminate_special:
 149         mov eax,60
 150         syscall
 151
 152 ;;; ========================================
 153 ;;; Core extension(s)
 154
 155         ;segment readable writable executable
 156
 157 include 'control.asm'
 158 include 'wordlists.asm'
 159 include 'memory.asm'
 160 include 'stack.asm'
 161 include 'math.asm'
 162 include 'logic.asm'
 163 include 'stdio.asm'
 164 include 'compile.asm'
 165
 166         WORD p_program_version,'PROGRAM_VERSION',dostring
 167         STRING 'RRQ Forth version 0.1 - 2021-05-22',10
 168
 169         WORD p_stdin,'STDIN',dovalue
 170         ;; Initialised to hold a STREAM for fd 0
 171         dq 0
 172
 173         WORD p_args,'MAIN-ARGS',dovalue
 174         ;; Pointer to initial argument block
 175         dq 0       ; *(int argc,(char*[argc]) argv)
 176
 177         WORD p_verboseQ,'VERBOSE?',dovariable
 178         ;; Flags whether the running is in verbose mode ot not
 179         dq 0       ;
 180
 181         WORD p_lparen,'(',fasm,IMMEDIATE
 182         pushr rsi
 183 p_lparen_loop:
 184         DOFORTH  p_stdin, p_read_word
 185         pop rax
 186         pop rbx
 187         cmp rax,0 ; end of stream
 188         je p_lparen_exit
 189         cmp rax,1
 190         jne p_lparen_loop
 191         push rbx
 192         push qword ')'
 193         push 1
 194         DOFORTH p_strncmp
 195         pop rax
 196         cmp rax,0
 197         jne p_lparen_loop
 198 p_lparen_exit:
 199         popr rsi
 200         next
 201
 202 ;;; ******** The main entry point. ********
 203 ;;; This could be set up as a WORD but it isn't
 204
 205 main:
 206         ;; Initial rsp points to the arguments block of size (64 bits)
 207         ;; followed by the argument pointers.
 208         mov qword [p_args_DFA],rsp
 209         mov rbp,RS_TOP
 210         call p_setup_signals_DFA
 211         call main_is_verbose
 212         mov qword [p_verboseQ_DFA],rdx
 213         jmp p_quit_DFA          ; QUIT
 214
 215         ;; Subroutine to check the command line for a "-v"
 216         ;; return boolean in rdx
 217         ;; implementation for that 2 byte asciiz string
 218 main_is_verbose_data:
 219         db '-v',0
 220
 221 main_is_verbose:
 222         mov rbx,qword [p_args_DFA] ; Pointer to main arguments
 223         mov r8,qword [rbx]         ; r8 = count of pointers
 224         xor rdx,rdx
 225         cld
 226 main_is_verbose_next:
 227         dec r8
 228         jl main_is_not_verbose
 229         add rbx,8
 230         mov rsi,qword [rbx]
 231         mov rdi,main_is_verbose_data
 232 main_is_verbose_loop:
 233         cmpsb
 234         jne main_is_verbose_next
 235         cmp byte[rsi-1],0
 236         jne main_is_verbose_loop
 237         not rdx
 238 main_is_not_verbose:
 239         ret
 240
 241 ;;; This word is also the last word before syscalls
 242 last_forth_word:
 243         WORD p_quit,'QUIT',fasm
 244         ;; QUIT is the program entry point ********************
 245
 246         mov rsp,DS_TOP
 247         mov rbp,RS_TOP
 248         cmp qword [p_stdin_DFA],0
 249         jne p_quit_INITIALIZED
 250         ;; Initialize STDIN
 251         push 0
 252         push 10000
 253         DOFORTH p_stream
 254         pop qword [p_stdin_DFA] ; Assign STDIN
 255
 256 p_quit_INITIALIZED:
 257         ;; Initial blurb
 258         FORTH
 259         dq p_verboseQ
 260         dq p_get
 261         BRANCH 0,p_quit_EVAL
 262         dq p_program_version
 263         dq p_tell
 264 p_quit_EVAL:
 265         dq p_stdin
 266         dq p_evaluate_stream
 267         BRANCH 0,p_quit_ERROR
 268         dq p_false
 269         dq sys_exit
 270 p_quit_ERROR:
 271         dq p_literal_string
 272         STRING 10,'*** Unknown word: '
 273         dq p_tell
 274         dq p_this_word
 275         dq p_2get
 276         dq p_tell
 277         dq p_literal_string
 278         STRING 10
 279         dq p_tell
 280         ENDFORTH
 281         mov rbp,RS_TOP          ; reset the return stack
 282         jmp p_quit_INITIALIZED
 283
 284 ;;; ========================================
 285
 286         ;segment readable writable
 287
 288 heap_start:
 289         rb 1048576              ; +1 Mb heap
 290         rb 1048576              ; +1 Mb heap
 291         rb 1048576              ; +1 Mb heap
 292         rb 1048576              ; +1 Mb heap
 293         rb 1048576              ; +1 Mb heap