;;; Words for adding words

	WORD p_here,'HERE',dovariable
	;; The heap
	dq heap_start
	
	WORD p_create,'CREATE',fasm
	;; CREATE ( chars* n -- tfa )
	;; Add the pstring as a new word in the current wordlist.
	pushr rsi
	mov rax,qword [p_wordlist_DFA] ; Current word list
	mov rax,[rax]		; last word of current wordlist
	mov rbx,qword [p_here_DFA] 
	mov [rbx],rax		; TFA of new word
	mov qword [rbx+16],0	; flags field
	;; copy pname
	pop rcx			; n
	mov qword [rbx+24],rcx	; PFA (length)
	pop rsi			; chars* (source)
	lea rdi,[rbx+32]	; (dest)
	;; clear DF
p_create_COPY:
	movsb
	dec rcx
	jge p_create_COPY
	mov byte [rdi],0	; extra NUL
	inc rdi
	mov qword [rdi],rbx	; pTFA
	add rdi,8
	mov qword [rdi],rbx	; OFF
	add rdi,8
	mov qword [rbx+8],rdi	; pCFA
	add rdi,8
	mov qword [rdi],dovalue	;CFA
	add rdi,8
	mov qword [rax],rbx	; Install new word
	mov qword [p_here_DFA],rdi ; allocate the space
	push rbx
	popr rsi
	next

	WORD p_allot,'ALLOT',fasm
	;; ( n -- )
	;; Allocate n bytes on the heap
	pop rax
	add rax,qword [p_here_DFA]
	mov qword [p_here_DFA],rax
	next
	
	WORD p_comma,',',fasm
	;; ( v -- )
	;; Put cell value onto the heap and advance "HERE"
	mov rax,qword [p_here_DFA]
	pop rbx
	mov qword [rax],rbx
	add rax,8
	mov qword [p_here_DFA],rax
	next
	
	WORD p_Ccomma,'C,',fasm
	;; ( c -- )
	;; Put byte value onto the heap and advance "HERE"
	mov rax,qword [p_here_DFA]
	pop rbx
	mov byte [rax],bl
	inc rax
	mov qword [p_here_DFA],rax
	next

	WORD p_does,'DOES>',fasm,IMMEDIATE
	;; ( -- )
	;; Change the "DOES offset" of latest compilation and assign
	;; it the "dodoes" execution semantics, 
	mov rax,qword [p_wordlist_DFA] 
	mov rax,[rax]		; last word of current wordlist
	tfa2does rax		; *rax is the DOES offset field
	;; offset = qword [p_here_DFA]) - (rax+2*8)
	mov rbx,qword [p_here_DFA]
	sub rbx,rax
	sub rbx,16
	mov qword [rax],rbx
	mov qword [rax+8],dodoes
	next

	WORD p_literal,'LIT',fasm
	;; ( -- v )
	;; Push the value of successor cell onto stack, and skip it
	push qword [rsi]
	add rsi,8
	next

	WORD p_literal_string,'S"',fasm ;; " (fool emacs)
	;; Compilation: ( "..." -- )
	;; Interpretation: ( -- char* n )
	;; Save string on heap to make available at interpretation
	cmp qword [p_state_DFA],0
	je p_literal_string_interpret
	;; compilation mode: read stream until \" onto the heap
	pushr rsi
	mov rdi,[p_here_DFA]
	lea rbx,[p_literal_string_CFA]
	mov qword [rdi],rbx
	add rdi,8
	pop rbx
	mov qword [rdi],rbx
	add rdi,8
	cmp rbx,0
	je p_literal_string_end
	lea rsi,[p_pad_DFA]
p_literal_string_copy:
	lodsb
	stosb
	dec rbx
	jg p_literal_string_copy
p_literal_string_end:
	mov qword [p_here_DFA],rdi
	popr rsi
	next

p_literal_string_interpret:
	mov rax,qword [rsi]
	add rsi,8
	push rsi
	push rax
	add rsi,rax
	next

;;; ========================================
;;; The text interpreter

	WORD p_state,'STATE',dovariable
	;; Interpretation state (0=interpreting, 1=compiling)
	dq 0

	WORD p_left_bracket,'[',fasm,IMMEDIATE
	;; ( -- )
	;; Change state to interpretation state.
	mov qword[p_state_DFA],0
	next

	WORD p_right_bracket,']',fasm
	;; ( -- )
	;; Change state to compilation state.
	mov qword[p_state_DFA],1
	next

	WORD p_base,'BASE',dovariable
	dq 10

	WORD p_decimal,'DECIMAL',fasm
	;; ( -- )
	;; Set BASE to 10
	mov qword [p_base_DFA],10
	next

	WORD p_hex,'HEX',fasm
	;; ( -- )
	;; Set BASE to 16
	mov qword [p_base_DFA],16
	next

	WORD p_number,'NUMBER',fasm
	;; ( chars* n -- [ 0 ]/[ v 1 ] )
	pushr rsi
	pop rcx			; ( -- chars* )
	pop rsi			; ( -- )
	xor rdi,rdi		; value
	mov rbx,1		; sign (byte 0=0 means negative)
	cmp qword [p_base_DFA],10
	jne p_number_LOOP
	cmp byte [rsi],'-'
	jne p_number_LOOP
	mov rbx,0
	inc rsi
	dec rcx
	jle p_number_BAD
p_number_LOOP:
	dec rcx
	jl p_number_DONE
	xor rax,rax		; clearing
	lodsb
	cmp al,'0'
	jl p_number_BAD
	cmp al,'9'
	jg p_number_ALPHA
	sub al,'0'
p_number_CONSUME:
	mov r8,rax
	mov rax,rdi
	mul qword [p_base_DFA]	; uses rdx:rax
	add rax,r8
	mov rdi,rax
	jmp p_number_LOOP
p_number_ALPHA:
	cmp al,'A'
	jl p_number_BAD
	cmp al,'Z'
	jg p_number_alpha
	sub al,'A'-10
	jmp p_number_CONSUME
p_number_alpha:
	cmp al,'a'
	jl p_number_BAD
	cmp al,'z'
	jg p_number_BAD
	sub al,'a'-10
	jmp p_number_CONSUME
p_number_BAD:
	push qword 0
	popr rsi
	next
p_number_DONE:
	cmp rbx,0
	jne p_numper_POSITIVE
	neg rdi
p_numper_POSITIVE:
	push rdi
	push qword 1
	popr rsi
	next

	WORD p_this_word,'THIS-WORD',dovariable
	dq 0,0 			; ( n chars* )

	WORD p_evaluate_stream,'EVALUATE-STREAM'
	;; ( stream* -- *?* flag )
	;; Execute the words from the given stream
	;; returns 1 if stream ends and 0 if an unknown word is found
	dq p_ltR		; Keep the stream on the return stack.
p_evaluate_stream_PROMPT:
	dq p_depth, p_dot, p_literal_string
	STRING ' > '
	dq p_tell, p_Rget, p_clear_stream
p_evaluate_stream_LOOP:
	dq p_Rget, p_read_word, p_dup
	BRANCH 0,p_evaluate_stream_END ; branch if 0 on TOP
	dq p_2dup, p_this_word, p_2put, p_find, p_dup
	BRANCH 0,p_evaluate_stream_NOTWORD ; branch if 0 on TOP
	dq p_state, p_get
	BRANCH 0,p_evaluate_stream_INTERPRET
	dq p_comma
	BRANCH ,p_evaluate_stream_AFTER
p_evaluate_stream_INTERPRET:
	dq p_execute
	BRANCH ,p_evaluate_stream_AFTER
p_evaluate_stream_NOTWORD:
	dq p_drop, p_number
	BRANCH 0,p_evaluate_stream_BAD ; branch if 0
p_evaluate_stream_AFTER:
	dq p_Rget,p_stream_nchars
	BRANCH 0,p_evaluate_stream_PROMPT
	BRANCH ,p_evaluate_stream_LOOP
p_evaluate_stream_END:
	dq p_2drop, p_literal, 1
p_evaluate_stream_BAD:
	dq p_Rgt, p_drop, p_exit