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

diff --git a/memory.asm b/memory.asm
index 6e945ff..80ce280 100644
--- a/memory.asm
+++ b/memory.asm
@@ -1,5 +1,49 @@
 ;;; 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_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
@@ -71,39 +115,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
+	pop rax
 	add [rax],rbx
 	next
 
-	WORD p_1minus, '1-',fasm
-	;; ( n1 -- n2 )
-	;; Subtract one (1) from n1 resulting in n2. 
-	dec qword [rsp]
-	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