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

include 'machine.asm'

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

	segment readable writable executable
	
;;; ========================================
;;; 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

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

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

include 'signals.asm'

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

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

	;segment readable writable executable
	
include 'control.asm'
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-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_input, p_get, 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
	mov rbp,RS_TOP
	call p_setup_signals_DFA
	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 ********************
	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:
	;; Setup INPUT from STDIN
	FORTH
	dq p_verboseQ
	dq p_get
	BRANCH 0,p_quit_EVAL
	dq p_program_version
	dq p_tell
p_quit_EVAL:
	dq p_stdin, 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 p_quit_INITIALIZED

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

	;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