X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=memory.asm;h=a20c438971de084a45e52219c153a79e9a556753;hb=97bcab28825fde3e717ac5489b0f3f19e5e3f5db;hp=6e945ff3331fbe6fd5639f33806dbb795545dde3;hpb=f4d2168559fb02a720623e3c44a48efa4e4a6614;p=rrq%2Frrqforth.git

diff --git a/memory.asm b/memory.asm
index 6e945ff..a20c438 100644
--- a/memory.asm
+++ b/memory.asm
@@ -1,5 +1,56 @@
 ;;; 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
@@ -19,9 +70,9 @@
 	;; ( addr -- v )
 	;; Load the (unsigned) byte v from address addr.
 	pop rax
-	mov bl,[rax]
-	push 0
-	mov [rsp],bl
+	xor rbx,rbx
+	mov bl,byte [rax]
+	push rbx
 	next
 	
 	WORD p_Cput, 'C!',fasm
@@ -32,6 +83,40 @@
 	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.
@@ -71,39 +156,55 @@ p_erase_last:
 	jg p_erase_more
 	next
 
-	WORD p_1plus, '1+',fasm
-	;; ( n1 -- n2 )
-	;; Add one (1) to n1 resulting in n2.
-	inc qword [rsp]
-	next
-
-	WORD p_plus_put, '+!',fasm
-	;; ( n addr -- )
+	WORD p_put_plus, '!+',fasm
+	;; ( addr n -- )
 	;; Add n to the value at addr.
-	pop rax
 	pop rbx
-	add [rax],rbx
-	next
-
-	WORD p_1minus, '1-',fasm
-	;; ( n1 -- n2 )
-	;; Subtract one (1) from n1 resulting in n2. 
-	dec qword [rsp]
+	pop rax
+	add qword [rax],rbx
 	next
 
-	WORD p_2mult, '2*',fasm
-	;; ( x1 -- x2 )
+	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.
-	shl qword [rsp],1
+	pop rcx
+	shl qword [rsp],cl
 	next
 
-	WORD p_2div, '2/',fasm
-	;; ( x1 -- x2 )
+	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)
-	sar qword [rsp],1
+	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