;;; 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 rdx,qword [p_wordlist_DFA] ; Current word list
	mov rbx,qword [p_here_DFA] 
	mov rax,qword [rdx]	; set up tfa linking to previous word
	mov qword [rbx],rax	; 
	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)
	cld
p_create_COPY:
	movsb
	dec rcx
	jg p_create_COPY
	mov byte [rdi],0	; extra NUL
	inc rdi
	mov qword [rdi],rbx	; pTFA
	add rdi,8
	mov qword [rdi],0	; OFF
	add rdi,8
	mov qword [rbx+8],rdi	; pCFA
	mov qword [rdi],dovariable ; CFA
	add rdi,8
	mov qword [p_here_DFA],rdi ; allocate the space
	mov qword [rdx],rbx	; Install new word (rdx still wordlist ptr)
	push rbx
	popr rsi
	next

	WORD p_allot,'ALLOT'
	;; ( n -- )
	;; Allocate n bytes on the heap
	dq p_here, p_put_plus, p_exit
	
	WORD p_quote,"'"
	;; ( "word" -- cfa )
	;; Find the following word and push its cfa, or 0
	dq p_input, p_get, p_read_word, p_find
	BRANCH 0,p_quote_end
	dq p_tfa2cfa
p_quote_end:
	dq p_exit

	WORD p_bracketed_quote,"[']",doforth,IMMEDIATE
	;; Compilation ( "word" -- cfa )
	;; Compile down " LIT value "
	dq p_literal, p_literal, p_comma,p_quote, p_comma, p_exit

	WORD p_comma,','
	;; ( v -- )
	;; Put cell value onto the heap and advance "HERE"
	dq p_here, p_literal, 8, p_get_n_increment, p_put, p_exit

	WORD p_Ccomma,'C,'
	;; ( c -- )
	;; Put byte value onto the heap and advance "HERE"
	dq p_here, p_Cput, p_literal, 1, p_here, p_put_plus, p_exit

	WORD p_does,"DOES>",fasm,IMMEDIATE
	;; ( -- )
	;; Change the "DOES offset" of most recent word and assign it
	;; the "dodoes" execution semantics that follows.
	mov rax,qword [rsp]
	mov rbx,rax
	tfa2does rax		; *rax is the DOES offset field
	tfa2dfa rbx
	mov rcx,qword [p_here_DFA]
	sub rcx,rbx
	mov qword [rax],rcx ; save offset from DFA to HERE
	mov qword [rax+8],dodoes
	next

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

	WORD p_literal_string,'S"',fasm,IMMEDIATE ;; " (fool emacs)
	;; ( -- char* n )
	;; Save string on heap to make available at interpretation
	;; not for interactive use!!
	cmp qword [p_state_DFA],0
	je p_literal_string_executing
	pushr rsi
	mov rdi,qword [p_here_DFA]
	mov qword [rdi],p_literal_string
	add rdi,8
	mov qword [p_here_DFA],rdi
	DOFORTH p_double_quote
	pop rcx
	pop rsi
	mov rdi,qword [p_here_DFA]
	mov qword [rdi],rcx
	add rdi,8
p_literal_string_copy:
	dec rcx
	jl p_literal_string_copied
	movsb
	jmp p_literal_string_copy
p_literal_string_copied:
	mov qword [p_here_DFA],rdi
	popr rsi
	next
	
p_literal_string_executing:
	mov rax,qword [rsi]
	add rsi,8
	push rsi
	push rax
	add rsi,rax
	next

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

	WORD p_left_bracket,'[',fasm,IMMEDIATE
	;; ( -- )
	;; Change state to interpreting 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_input,'INPUT',dovariable
	;; The current input stream for evaluate-stream
	dq 0

	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_input, p_get, p_gtR ; save old stream on R-stack
	dq p_input, p_put
p_evaluate_stream_PROMPT:
	dq p_verboseQ, p_get
	BRANCH 0,p_evaluate_stream_LOOP
	dq p_depth, p_dot
	dq p_literal_string
	STRING '> '
	dq p_tell
	dq p_input, p_get
	dq p_clear_stream
p_evaluate_stream_LOOP:
	dq p_input, p_get
	dq p_read_word
	dq p_dup
	BRANCH 0,p_evaluate_stream_END ; branch if 0 on TOP
	dq p_2dup, p_this_word, p_2put
	dq p_find
	dq p_dup
	BRANCH 0,p_evaluate_stream_NOTWORD ; branch if 0 on TOP
	dq p_state
	dq p_get
	BRANCH 0,p_evaluate_stream_INTERPRET
	dq p_dup
	dq p_tfa2flags_get
	dq p_literal, 1 ; the immediate bit
	dq p_and
	BRANCH 0,p_evaluate_stream_COMPILE
p_evaluate_stream_INTERPRET:
	dq p_tfa2cfa
	dq p_execute
	BRANCH ,p_evaluate_stream_AFTER
p_evaluate_stream_COMPILE:
	dq p_tfa2cfa
	dq p_comma
	BRANCH ,p_evaluate_stream_AFTER
p_evaluate_stream_NOTWORD:
	dq p_drop
	dq p_number
	dq p_dup
	BRANCH 0,p_evaluate_stream_BAD ; branch if 0
	dq p_drop
	dq p_state, p_get
	BRANCH 0,p_evaluate_stream_AFTER ; branch if 0
	dq p_literal, p_literal
	dq p_comma, p_comma
p_evaluate_stream_AFTER:
	dq p_input, p_get
	dq p_stream_nchars
	BRANCH 0,p_evaluate_stream_PROMPT
	BRANCH ,p_evaluate_stream_LOOP
p_evaluate_stream_END:
	dq p_2drop
	dq p_literal, 1
p_evaluate_stream_BAD:
	dq p_Rgt, p_input, p_put ; restore previous stream
	dq p_exit

	WORD p_colon,':'
	;; ( -- )
	;; Read next word as a new word into current wordlist, set it
	;; to be a doforth word, and set compiling mode.
	dq p_literal, doforth
	dq p_input, p_get
	dq p_read_word
	dq p_create
	dq p_tfa2cfa
	dq p_put
	dq p_right_bracket
	dq p_exit

	WORD p_semicolon,';',,IMMEDIATE
	;; ( -- )
	;; Lay out p_exit, and set interpreting mode
	dq p_literal, p_exit, p_comma, p_left_bracket, p_exit

	WORD p_immediate,'IMMEDIATE',fasm,IMMEDIATE
	;; ( -- )
	;; Set "immediate flag" of the word being defined
	mov rax,qword [p_wordlist_DFA]
	mov rax,qword [rax]	; tfa of most recent word
	mov qword [rax+16],1	; set the flags field to 1
	next

	WORD p_load_buffer_size,'LOAD-BUFFER-SIZE',dovariable
	;; ( -- a )
	;; The buffer size (in bytes) used by LOAD-FILE
	dq 15000
	
	WORD p_open_file,'OPEN-FILE',fasm
	;; ( chaz* n -- fd )
	;; Open the nominated file
	pushr rsi
	add rsp,8 ; drop n ... assuming NUL-ended string
	push qword 0
	push qword 0
	DOFORTH sys_open
	popr rsi
	next

	WORD p_load_file,'LOAD-FILE'
	;; ( chaz* n -- )
	dq p_open_file
	dq p_dup, p_0less
	BRANCH 1,p_load_file_badfile
	dq p_load_buffer_size, p_get
	dq p_stream, p_dup, p_gtR
	dq p_evaluate_stream
	dq p_Rgt, p_unstream
	BRANCH ,p_load_file_exit
p_load_file_badfile:
	dq p_literal_string
	STRING '** open file error: '
	dq p_tell, p_dot, p_nl, p_emit
	dq p_literal,1
p_load_file_exit:
	dq p_exit