update

[rrq/rrqforth.git] / memory.asm

diff --git a/memory.asm b/memory.asm
index 6e945ff3331fbe6fd5639f33806dbb795545dde3..80ce28075e6c69a6e5523f3336ed7532a0dbe6f3 100644 (file)
--- 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