; This is a forth interpreter for x86_64 (elf64)
	format elf64 executable
	entry main

previous_word = 0	; Used for chaining the words

include 'machine.asm'

;;; ============================================================

	segment readable executable

;;; This is the very first word
	
	;; FORTH is the last word of WORDLIST FORTH
	WORD p_forth,'FORTH',dowordlist
	;; ( -- )
	;; Change to use this wordlist
	dq last_forth_word

	WORD p_system,'SYSTEM',dowordlist
	;; ( -- )
	;; Change to use this wordlist
	dq last_system_word

last_wordlists_word:
	WORD p_wordlists,'WORDLISTS',dowordlist
	;; ( -- )
	;; Change to use this wordlist
	dq p_wordlists_TFA

;;; ========================================
;;; 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
;;; 

	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

	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

	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

	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

	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_dowordlist,'doWORDLIST',dovariable
	;; Execution semantics for DOES>
	;; [cfa-8] holds the adjustment offset ("does offset")
dowordlist:
	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


include 'syscalls.asm'

;;; ========================================
;;; The stacks are placed here.
	
	segment readable writable

	WORD return_stack,'RETURN-STACK',dovariable
	;; The return stack
	BLOCK RS_TOP
	rb 1048576		; 1 Mb return stack
RS_TOP:				; The initial rbp
	
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 = last_wordlists_word

	WORD inline_code,'[ASM]',fasm
	;; ( -- )
	;; This transitions execution into inline assembler in the
	;; calling word defintion. Note that it stops advancing rsi;
	;; code should use FORTH macro to reenter forth execution, or
	;; exit to the calling definition via "jmp exit".
	jmp qword rsi

	WORD p_execute,'EXECUTE',fasm
	;; ( tfa -- )
	;; Execute the word
	pop rax
	tfa2cfa 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
	;; return stack.
exit:
	popr rsi
	next

	;; TERMINATE0 terminates the program with code 0
	;; ( -- )
	WORD p_terminate, 'TERMINATE0',fasm
	pop rdx
terminate_special:
	mov eax,60
	syscall

	WORD p_branch,'BRANCH',fasm
	;; ( -- )
	;; Using subsequent inline cell as branch offset, branch
	;; accordingly
	add rsi,qword [rsi]	
	add rsi,8
	next
	
	WORD p_zero_branch,'0BRANCH',fasm
	;; ( v -- )
	;; Using subsequent inline cell as branch offset, branch
	;; accordingly if the stacked value is zero, otherwise just
	;; skip over the branch offset
	pop rax
	cmp rax,0
	jne p_zero_branch_SKIP
	add rsi,qword [rsi]
p_zero_branch_SKIP:
	add rsi,8
	next

;;; ========================================
;;; Core extension(s)

	segment readable writable executable
	
include 'wordlists.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
	STRING 'RRQ Forth version 0.1 - 2021-05-13',10

	WORD p_stdin,'STDIN',dovalue
	;; Initialised to hold a STREAM for fd 0
	dq 0

;;; The main entry point.
;;; 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
	cmp qword [p_stdin_DFA],0
	jne p_quit_INITIALIZED
	;; Initialize STDIN
	push 0
	push 10000
	DOFORTH p_stream
	pop qword [p_stdin_DFA]	; Assign STDIN

p_quit_INITIALIZED:
	;; Initial blurb
	FORTH
	dq p_program_version
	dq p_tell
	dq p_stdin
	dq p_clear_stream
	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

;;; ========================================

	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