format elf64 executable
entry main
-;;; ========================================
-;;; The pushr macro pushes x onto the return stack
-;;; The popr macro pops x from the return stack
-macro pushr x {
- sub rbp, 8
- mov [rbp], x
-}
-
-macro popr x {
- mov x, [rbp]
- add rbp, 8
-}
+include 'machine.asm'
-;;; ========================================
-;;; The next macro "moves" execution to the next FORTH instruction,
-;;; using rsi as instruction pointer. It points to the doer field of a
-;;; word, which points to the assembly code that implements the
-;;; execution effect of the word. That doer code is entered with rsi
-;;; referring to the subsequent address in the colling word, and rax
-;;; referring to the doer field of the called word.
-
-macro next {
- lodsq ; mov rax, [rsi] + add rsi,8
- jmp qword [rax] ; goto code of that FORTH word (64 bit jump)
-}
+;;; ============================================================
+ segment readable writable executable
+
;;; ========================================
-;;; The FORTH macro transitions to inline FORTH execution.
-macro FORTH {
- local forthcode
- mov rsi,forthcode
+;;; These are the core "execution semantics" words, which are placed
+;;; first so as to remain at the same binary address at successive
+;;; compilations, which is helful for declaring special debugging gdb
+;;; aliases.
+;;;
+;;; The DO* words are declared as "variables" to provide their
+;;; assembled address when used in FORTH.
+;;;
+;;; The register context at entry to an "execution semantcs" code
+;;; snippets is:
+;;; rax = cfa* of word to execute
+;;; rsi = cell* in the calling definition, after calling cell
+;;; rsp = data stack pointer
+;;; rbp = return stack pointer
+;;;
+
+previous_word = 0 ; Used for chaining the words
+
+ WORD p_dofasm,'doFASM',dovariable
+ ;; Execution semantics for assembly words.
+dofasm:
+ add rax,8
+ jmp rax
+
+ WORD p_doforth,'doFORTH',dovariable ;
+ ;; Execution semantics for FORTH defition word.
+doforth:
+ pushr rsi
+ lea rsi, [rax+8] ; rsi = the DFA of the rax word
next
- ;; align 8
-forthcode:
-}
-;;; ========================================
-;;; The ENDFORTH macro transitions back to inline assembler after FORTH
-;;; ========================================
-macro ENDFORTH {
- dq inline_code
-}
+ WORD p_dodoes,'doDOES',dovariable
+ ;; Execution semantics for DOES>
+ ;; [cfa-8] holds the adjustment offset ("does offset")
+dodoes:
+ pushr rsi
+ lea rsi, [rax+8] ; rsi = the DFA of the rax word
+ add rsi,qword [rax-8] ; adjust rsi by the "does offset'
+ next
-;;; ========================================
-;;; The DOFORTH lays out a single FORTH call
-;;; ========================================
-macro DOFORTH label {
- FORTH
- dq label
- ENDFORTH
-}
+ WORD p_dovariable,'doVARIABLE',dovariable
+ ;; Execution semantics for a variable ( -- addr )
+ ;; rax points to CFA field
+dovariable:
+ lea rax, [rax+8] ; rsi = the DFA of the rax word
+ push rax
+ next
-;;; Macro WORD starts a FORTH word definition in this code
-;;;
- previous_word = 0 ; Used for chaining the words
-
- IMMEDIATE = 1 ; optional flag
-
-macro WORD label, name, doer, flags {
- ;; align 8
-label#_TFA:
- ;; TFA
- dq previous_word
- previous_word = label#_TFA
- ;; PFA
-label#_PFA:
- db flags + 0
- db label - $ - 2
- db name
- db 0
- ;; align 8
-
-label#_OFF:
- dq 0 ; The DOES offset. Defaults to 0.
- ;; also CFA = pointer to "doer"
-label:
- if doer eq
- dq doforth
- else
- if doer in <fasm>
- dq label#_DFA
- else
- dq doer
- end if
- end if
- ;; DFA
-label#_DFA:
-}
+ WORD p_dovalue,'doVALUE',dovariable
+ ;; Execution semantics for a value constant ( -- v )
+ ;; rax points to CFA field
+dovalue:
+ lea rax, [rax+8] ; rsi = the DFA of the rax word
+ push qword [rax]
+ next
-;;; ============================================================
-;;; FORTH machine model
-;;; rsp = data stack pointer
-;;; rbp = return stack pointer
-;;; rsi = instruction pointer
+ WORD p_dostring,'doSTRING',dovariable
+ ;; Execution semantics for a string constant ( -- addr n )
+ ;; rax points to CFA field
+dostring:
+ lea rax, [rax+8] ; rsi = the DFA of the rax word
+ pushpname rax
+ next
-;;; ============================================================
+ WORD p_calltrace,'calltrace',dovalue
+ ;; Common call point for debugging
+ ;; rax = cfa of called word
+ ;; rsi = cell* of next forth word
+ ;; [$rsp] = from where the call was
+ ret
- segment readable writable executable
+include 'syscalls.asm'
+
+;;; ========================================
+;;; The stacks are placed here.
+
+ ;segment readable writable
- WORD return_stack,'RS',dovariable
+ WORD return_stack,'RETURN-STACK',dovariable
;; The return stack
+ BLOCK RS_TOP
rb 1048576 ; 1 Mb return stack
RS_TOP: ; The initial rbp
- WORD data_stack,'DS',dovariable
+last_system_word:
+ WORD data_stack,'DATA-STACK',dovariable
;; The data stack
+ BLOCK DS_TOP
rb 1048576 ; 1 Mb data stack
DS_TOP: ; The initial rsp
+
+;;; ========================================
+;;; Core execution control words
+
+ ;segment readable executable
+
+;;; At fasm compilation: reset previous_word to make a new word list
+;;; Words above belong to the SYSTEM wordlist, and the following
+;;; belong to the FORTH wordlist.
+previous_word = 0
+
+ WORD p_system,'SYSTEM',dovariable
+ ;; ( -- dfa )
+ ;; The SYSTEM word list
+ dq last_system_word ; tfa of last SYSTEM word
+ dq p_forth_DFA ; dfa of successor word list
+
WORD inline_code,'[ASM]',fasm
;; ( -- )
;; This transitions execution into inline assembler in the
;; exit to the calling definition via "jmp exit".
jmp qword rsi
-;;; Execution semantics for FORTH defition word
-;;; At entry, rsi points into the calling definition, at the cell
-;;; following the cell indicating this word, rax points to the CFA of
-;;; this word.
-doforth:
- pushr rsi
- lea rsi, [rax+8] ; rsi = the DFA of the rax word
- next
-
+ WORD p_execute,'EXECUTE',fasm
+ ;; ( cfa -- )
+ ;; Execute the word
+ pop rax
+ jmp qword [rax] ; goto code of that FORTH word (64 bit jump)
+
WORD p_exit, 'EXIT',fasm
;; ( -- ) ( R: addr -- )
;; Returns execution to the calling definition as per the
popr rsi
next
- ;; Execution semantics for a variable ( -- addr )
- ;; rax points to doer field
-dovariable:
- push rax+16
- next
-
- ;; Execution semantics for a constant ( -- v )
- ;; rax points to doer field
-dovalue:
- push qword [rax+16]
- next
+ ;; TERMINATE0 terminates the program with code 0
+ ;; ( -- )
+ WORD p_terminate, 'TERMINATE0',fasm
+ pop rdx
+terminate_special:
+ mov eax,60
+ syscall
- ;; Execution semantics for a string constant ( -- addr n )
- ;; rax points to doer field
-dostring:
- add rax,16
- mov bl,[rax]
- mov byte [rsp],bl
- push rax+1
- next
+;;; ========================================
+;;; Core extension(s)
+ ;segment readable writable executable
+
+include 'control.asm'
include 'wordlists.asm'
-include 'syscalls.asm'
include 'memory.asm'
include 'stack.asm'
include 'math.asm'
+include 'logic.asm'
include 'stdio.asm'
+include 'compile.asm'
WORD p_program_version,'PROGRAM_VERSION',dostring
- db length
-program_version_string:
- db 'RRQ Forth version 0.1 - 2021-05-13',10
- length = $ - program_version_string
+ STRING 'RRQ Forth version 0.1 - 2021-05-22',10
WORD p_stdin,'STDIN',dovalue
;; Initialised to hold a STREAM for fd 0
dq 0
+
+ WORD p_args,'MAIN-ARGS',dovalue
+ ;; Pointer to initial argument block
+ dq 0 ; *(int argc,(char*[argc]) argv)
+
+ WORD p_verboseQ,'VERBOSE?',dovariable
+ ;; Flags whether the running is in verbose mode ot not
+ dq 0 ;
+
+ WORD p_lparen,'(',fasm,IMMEDIATE
+ pushr rsi
+p_lparen_loop:
+ DOFORTH p_stdin, p_read_word
+ pop rax
+ pop rbx
+ cmp rax,0 ; end of stream
+ je p_lparen_exit
+ cmp rax,1
+ jne p_lparen_loop
+ push rbx
+ push qword ')'
+ push 1
+ DOFORTH p_strncmp
+ pop rax
+ cmp rax,0
+ jne p_lparen_loop
+p_lparen_exit:
+ popr rsi
+ next
+;;; ******** The main entry point. ********
+;;; This could be set up as a WORD but it isn't
+
+main:
+ ;; Initial rsp points to the arguments block of size (64 bits)
+ ;; followed by the argument pointers.
+ mov qword [p_args_DFA],rsp
+ call main_is_verbose
+ mov qword [p_verboseQ_DFA],rdx
+ jmp p_quit_DFA ; QUIT
+
+ ;; Subroutine to check the command line for a "-v"
+ ;; return boolean in rdx
+ ;; implementation for that 2 byte asciiz string
+main_is_verbose_data:
+ db '-v',0
+
+main_is_verbose:
+ mov rbx,qword [p_args_DFA] ; Pointer to main arguments
+ mov r8,qword [rbx] ; r8 = count of pointers
+ xor rdx,rdx
+ cld
+main_is_verbose_next:
+ dec r8
+ jl main_is_not_verbose
+ add rbx,8
+ mov rsi,qword [rbx]
+ mov rdi,main_is_verbose_data
+main_is_verbose_loop:
+ cmpsb
+ jne main_is_verbose_next
+ cmp byte[rsi-1],0
+ jne main_is_verbose_loop
+ not rdx
+main_is_not_verbose:
+ ret
+
+;;; This word is also the last word before syscalls
+last_forth_word:
WORD p_quit,'QUIT',fasm
;; QUIT is the program entry point ********************
-main:
+
mov rsp,DS_TOP
mov rbp,RS_TOP
- ;; Initialize STREAM STDIN
+ cmp qword [p_stdin_DFA],0
+ jne p_quit_INITIALIZED
+ ;; Initialize STDIN
push 0
push 10000
DOFORTH p_stream
- pop qword [p_stdin_DFA]
+ pop qword [p_stdin_DFA] ; Assign STDIN
- ;; read a word
- push qword 1 ; ( fd ) =stdout
- push qword [p_stdin_DFA]
+p_quit_INITIALIZED:
+ ;; Initial blurb
FORTH
- dq p_read_word ; ( fd s n )
- dq sys_write
+ dq p_verboseQ
+ dq p_get
+ BRANCH 0,p_quit_EVAL
+ dq p_program_version
+ dq p_tell
+p_quit_EVAL:
+ dq p_stdin
+ dq p_evaluate_stream
+ BRANCH 0,p_quit_ERROR
+ dq p_false
+ dq sys_exit
+p_quit_ERROR:
+ dq p_literal_string
+ STRING 10,'*** Unknown word: '
+ dq p_tell
+ dq p_this_word
+ dq p_2get
+ dq p_tell
+ dq p_literal_string
+ STRING 10
+ dq p_tell
ENDFORTH
+ mov rbp,RS_TOP ; reset the return stack
+ jmp main
- push qword 1 ; stdout
- push qword program_version_string ; address of string
- push qword length ; length of string (cheating)
- DOFORTH sys_write ; printout
- pop rax ; ignore errors
-
- push 0
- DOFORTH sys_exit
-
- ;; TERMINATE0 terminates the program with code 0
- ;; ( v -- )
- WORD terminate, 'TERMINATE',fasm
- pop rdx
-terminate_special:
- mov eax,60
- syscall
-
-last_word:
- ;; FORTH is the last word of VOCABULARY FORTH
- WORD forth,'FORTH',dovalue
- dq forth_TFA
- dq 0
+;;; ========================================
+ ;segment readable writable
heap_start:
+ rb 1048576 ; +1 Mb heap
+ rb 1048576 ; +1 Mb heap
+ rb 1048576 ; +1 Mb heap
+ rb 1048576 ; +1 Mb heap
+ rb 1048576 ; +1 Mb heap
projects / rrq / rrqforth.git / blobdiff