;;; This file defines "memory access words"

	WORD p_tfa2cfa,'TFA>CFA',fasm
	;; ( tfa -- cfa )
	;; Advance a word tfa pointer to the cfa field
	mov rax,qword[rsp]
	tfa2cfa rax
	mov qword [rsp],rax
	next
	
	WORD p_tfa2dfa,'TFA>DFA',fasm
	;; ( tfa -- dfa )
	;; Advance a word tfa pointer to the dfa field
	mov rax,qword[rsp]
	tfa2dfa rax
	mov qword [rsp],rax
	next

	WORD p_tfa2flags_get,'TFA>FLAGS@',fasm
	;; ( tfa -- flags )
	pop rax
	push qword[rax+16]
	next

	WORD p_tfa2namez,'TFA>NAMEZ',fasm
	;; (  tfa -- char* )
	pop rax
	add rax,32
	push rax
	next

	WORD p_cfa2tfa,'CFA>TFA',fasm
	;; ( cfa -- tfa )
	pop rax
	cfa2tfa rax
	push rax
	next

	WORD p_cfa2flags_get,'CFA>FLAGS@',fasm
	;; ( cfa -- flags )
	pop rax
	cfa2tfa rax
	push qword[rax+16]
	next

	WORD p_dfa2tfa,'DFA>TFA',fasm
	;; ( dfa -- tfa )
	;; Advance a word tfa pointer to the dfa field
	mov rax,qword[rsp]
	mov rax,qword [rax-24]	; tfa
	mov qword [rsp],rax
	next

	WORD p_get, '@',fasm
	;; ( addr -- v )
	;; Load value v from address addr
	pop rax
	push qword [rax]
	next

	WORD p_put, '!',fasm
	;; ( v addr -- )
	;; Store value v at address addr.
	pop rax
	pop rbx
	mov qword [rax], rbx
	next

	WORD p_Cget, 'C@',fasm
	;; ( addr -- v )
	;; Load the (unsigned) byte v from address addr.
	pop rax
	xor rbx,rbx
	mov bl,byte [rax]
	push rbx
	next
	
	WORD p_Cput, 'C!',fasm
	;; ( v addr -- )
	;; Store byte value v at address addr.
	pop rax
	pop rbx
	mov byte [rax], bl
	next

	WORD p_Wget, 'W@',fasm
	;; ( addr -- v )
	;; Load the (unsigned) double-byte v from address addr.
	pop rax
	xor rbx,rbx
	mov bx,word [rax]
	push rbx
	next
	
	WORD p_Wput, 'W!',fasm
	;; ( v addr -- )
	;; Store byte value v at address addr.
	pop rax
	pop rbx
	mov word [rax], bx
	next

	WORD p_Dget, 'D@',fasm
	;; ( addr -- v )
	;; Load the (unsigned) double-byte v from address addr.
	pop rax
	xor rbx,rbx
	mov ebx,dword [rax]
	push rbx
	next
	
	WORD p_Dput, 'D!',fasm
	;; ( v addr -- )
	;; Store byte value v at address addr.
	pop rax
	pop rbx
	mov dword [rax], ebx
	next

	WORD p_2get, '2@',fasm
	;; ( addr -- v2 v1 )
	;; Load the cell pair {v1,v2} from address addr.
	pop rax
	push qword [rax+8]	; v2
	push qword [rax]	; v1
	next

	WORD p_2put, '2!',fasm
	;; ( v2 v1 addr -- )
	;; Store value pair {v1,v2} at address addr.
	pop rax
	pop rbx
	mov qword [rax], rbx	; v1
	pop rbx
	mov qword [rax+8], rbx	; v2
	next

	WORD p_erase, 'ERASE',fasm
	;; ( addr u -- )
	;; Clear u bytes at address addr and up.
	pop rax
	pop rbx
	xor rcx,rcx
p_erase_loop:
	cmp rax,8
	jl p_erase_last
	mov qword [rbx],0 	; mov qword[rbx],rcx
	add rbx,8
	sub rax,8
	jmp p_erase_loop
p_erase_more:
	mov [rbx],byte 0	; mov byte [rbx], cl
	inc rbx
	dec rax
p_erase_last:
	jg p_erase_more
	next

	WORD p_put_plus, '!+',fasm
	;; ( addr n -- )
	;; Add n to the value at addr.
	pop rbx
	pop rax
	add qword [rax],rbx
	next

	WORD p_shift_left, '<<',fasm
	;; ( x1 n -- x2 )
	;; x2 is the result of shifting x1 one bit toward the
	;; most-significant bit, filling the vacated least-significant
	;; bit with zero.
	pop rcx
	shl qword [rsp],cl
	next

	WORD p_shift_right, '>>',fasm
	;; ( x1 n -- x2 )
	;; x2 is the result of shifting x1 one bit toward the
	;; least-significant bit, leaving the most-significant bit
	;; unchanged. (signed right shift)
	pop rcx
	shr qword [rsp],cl
	next
	
	WORD p_shift_signed_right, 's>>',fasm
	;; ( x1 n -- x2 )
	;; x2 is the result of shifting x1 one bit toward the
	;; least-significant bit, leaving the most-significant bit
	;; unchanged. (signed right shift)
	pop rcx
	sar qword [rsp],cl
	next
	
	WORD p_get_n_increment,'@n++',fasm
	;; ( a n -- v )
	;; Fetch value at address then increment that address by n
	pop rbx
	pop rax
	push qword [rax]
	add qword [rax],rbx
	next

	WORD p_get_n_decrement,'@n--',fasm
	;; ( a n -- v )
	;; Fetch value at address then decrement that address by n
	pop rbx
	pop rax
	push qword [rax]
	sub qword [rax],rbx
	next