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

include 'machine.asm'

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

	segment readable writable executable

;;; This is the very first word
	
	;; FORTH is the last word of WORDLIST FORTH
	WORD p_forth,'FORTH',dovalue
	;; ( -- )
	;; Change to use this wordlist
	dq last_forth_word
	dq inline_code
	mov rax,qword [p_forth_DFA]
	mov qword [p_wordlist],rax
	popr rsi
	next

	WORD p_syscall,'SYSCALL',dodoes,,,8
	;; ( -- )
	;; Change to use this wordlist
	dq last_syscall_word
	dq inline_code
	mov rax,qword [p_syscall_DFA]
	mov qword [p_wordlist],rax
	popr rsi
	next

last_wordlists_word:
	WORD p_wordlists,'WORDLISTS',dodoes,,,8
	;; ( -- )
	;; Change to use this wordlist
	dq p_wordlists_TFA
	dq inline_code
	mov rax,qword [p_wordlists_DFA]
	mov qword [p_wordlist],rax
	popr rsi
	next
	
include 'wordlists.asm'

	WORD return_stack,'RS',dovariable
	;; The return stack
	rb 1048576		; 1 Mb return stack
RS_TOP:				; The initial rbp
	
	WORD data_stack,'DS',dovariable
	;; The data stack
	rb 1048576		; 1 Mb data stack
DS_TOP:				; The initial rsp

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

;;; Execution semantics for a "fasm" WORD
dofasm:
	add rax,8
	jmp rax
;;; 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

;;; Execution semantics for DOES>
;;; The cell at [cfa-8] holds an adjustment offset.
dodoes:
	pushr rsi
	lea rsi, [rax+8] 	; rsi = the DFA of the rax word
	add rsi,[rax-8]		; adjust rsi to the DOES> part
	next

	;; Execution semantics for a variable ( -- addr )
	;; rax points to CFA field
dovariable:
	add rax,8
	push rax
	next

	;; Execution semantics for a constant ( -- v )
	;; rax points to CFA field
dovalue:
	push qword [rax+8]
	next

	;; Execution semantics for a string constant ( -- addr n )
	;; rax points to CFA field
dostring:
	cfa2dfa rax
	pushpname rax
	next

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

	;; At fasm compilation: reset to make a new word list
	previous_word = last_wordlists_word

include 'syscalls.asm'

	
last_word:
	
heap_start:
	rb 1048576		; +1 Mb heap
	rb 1048576		; +1 Mb heap
	rb 1048576		; +1 Mb heap