;;; 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
+ ;; ( cfa -- flags )
+ pop rax
+ push qword[rax+16]
+ 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
next
WORD p_2get, '2@',fasm
- ;; ( addr -- v1 v2 )
- ;; Load the cell pair {x2,x1} from address addr.
+ ;; ( addr -- v2 v1 )
+ ;; Load the cell pair {v1,v2} from address addr.
pop rax
- push qword [rax+8]
- push qword [rax]
+ push qword [rax+8] ; v2
+ push qword [rax] ; v1
next
- WORD p_2put, '!',fasm
- ;; ( v1 v2 addr -- )
- ;; Store value pair {v2,v1} at address addr.
+ WORD p_2put, '2!',fasm
+ ;; ( v2 v1 addr -- )
+ ;; Store value pair {v1,v2} at address addr.
pop rax
pop rbx
- mov qword [rax], rbx
+ mov qword [rax], rbx ; v1
pop rbx
- mov qword [rax+8], rbx
+ mov qword [rax+8], rbx ; v2
next
WORD p_erase, 'ERASE',fasm
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