;;; 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)
	;; ( -- chars* n )
	;; Push the value of successor cell onto stack, and skip it
	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
p_number_LOOP:
	dec rbx
	jl p_number_DONE
	lodsb
	mov bl,al		; into bl
	cmp bl,'0'
	jl p_number_BAD
	cmp bl,'9'
	jg p_number_ALPHA
	sub bl,'0'
p_number_CONSUME:
	mov rax,rdi
	mul qword [p_base_DFA]
	add rax,rbx
	mov rdi,rax
	jmp p_number_LOOP
p_number_ALPHA:
	cmp bl,'A'
	jl p_number_BAD
	cmp bl,'Z'
	jg p_number_alpha
	sub bl,'A'-10
	jmp p_number_CONSUME
p_number_alpha:
	cmp bl,'a'
	jl p_number_BAD
	cmp bl,'z'
	jg p_number_BAD
	sub bl,'a'-10
	jmp p_number_CONSUME
p_number_BAD:
	push qword 0
	popr rsi
	next
p_number_DONE:
	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
p_evaluate_stream_LOOP:
	dq p_read_word		; ( -- chars* n )
	dq p_dup
	BRANCH 0,p_evaluate_stream_END
	dq p_2dup		; ( -- chars* n chars* n )
	dq p_this_word		; ( -- chars* n chars* n p )
	dq p_2put		; ( -- chars* n )
	dq p_find		; ( -- [ chars* n 0 ]/[ tfa ] )
	dq p_dup		; ( -- [ chars* n 0 0 ]/[ tfa tfa ] )
	BRANCH 0,p_evaluate_stream_NOTWORD ; ( -- chars* n tfa/0 )
	dq p_execute		; ( -- chars* n tfa/0 )
	BRANCH ,p_evaluate_stream_LOOP
p_evaluate_stream_NOTWORD:
	dq p_drop		; ( -- chars* n )
	dq p_number		; ( -- [ 0 ]/[ v 1 ] )
	dq p_dup
	BRANCH 0,p_evaluate_stream_BAD
	dq p_drop
	BRANCH ,p_evaluate_stream_LOOP
p_evaluate_stream_END:
	dq p_literal
	dq 1
p_evaluate_stream_BAD:
	dq p_exit