memory.asm

   1 ;;; This file defines "memory access words"
   2
   3         WORD p_tfa2cfa,'TFA>CFA',fasm
   4         ;; ( tfa -- cfa )
   5         ;; Advance a word tfa pointer to the cfa field
   6         mov rax,qword[rsp]
   7         tfa2cfa rax
   8         mov qword [rsp],rax
   9         next
  10
  11         WORD p_tfa2dfa,'TFA>DFA',fasm
  12         ;; ( tfa -- dfa )
  13         ;; Advance a word tfa pointer to the dfa field
  14         mov rax,qword[rsp]
  15         tfa2dfa rax
  16         mov qword [rsp],rax
  17         next
  18
  19         WORD p_tfa2flags_get,'TFA>FLAGS@',fasm
  20         ;; ( tfa -- flags )
  21         pop rax
  22         push qword[rax+16]
  23         next
  24
  25         WORD p_tfa2namez,'TFA>NAMEZ',fasm
  26         ;; (  tfa -- char* )
  27         pop rax
  28         add rax,32
  29         push rax
  30         next
  31
  32         WORD p_cfa2tfa,'CFA>TFA',fasm
  33         ;; ( cfa -- tfa )
  34         pop rax
  35         cfa2tfa rax
  36         push rax
  37         next
  38
  39         WORD p_cfa2flags_get,'CFA>FLAGS@',fasm
  40         ;; ( cfa -- flags )
  41         pop rax
  42         cfa2tfa rax
  43         push qword[rax+16]
  44         next
  45
  46         WORD p_dfa2tfa,'DFA>TFA',fasm
  47         ;; ( dfa -- tfa )
  48         ;; Advance a word tfa pointer to the dfa field
  49         mov rax,qword[rsp]
  50         mov rax,qword [rax-24]  ; tfa
  51         mov qword [rsp],rax
  52         next
  53
  54         WORD p_get, '@',fasm
  55         ;; ( addr -- v )
  56         ;; Load value v from address addr
  57         pop rax
  58         push qword [rax]
  59         next
  60
  61         WORD p_put, '!',fasm
  62         ;; ( v addr -- )
  63         ;; Store value v at address addr.
  64         pop rax
  65         pop rbx
  66         mov qword [rax], rbx
  67         next
  68
  69         WORD p_Cget, 'C@',fasm
  70         ;; ( addr -- v )
  71         ;; Load the (unsigned) byte v from address addr.
  72         pop rax
  73         xor rbx,rbx
  74         mov bl,byte [rax]
  75         push rbx
  76         next
  77
  78         WORD p_Cput, 'C!',fasm
  79         ;; ( v addr -- )
  80         ;; Store byte value v at address addr.
  81         pop rax
  82         pop rbx
  83         mov byte [rax], bl
  84         next
  85
  86         WORD p_Wget, 'W@',fasm
  87         ;; ( addr -- v )
  88         ;; Load the (unsigned) double-byte v from address addr.
  89         pop rax
  90         xor rbx,rbx
  91         mov bx,word [rax]
  92         push rbx
  93         next
  94
  95         WORD p_Wput, 'W!',fasm
  96         ;; ( v addr -- )
  97         ;; Store byte value v at address addr.
  98         pop rax
  99         pop rbx
 100         mov word [rax], bx
 101         next
 102
 103         WORD p_Dget, 'D@',fasm
 104         ;; ( addr -- v )
 105         ;; Load the (unsigned) double-byte v from address addr.
 106         pop rax
 107         xor rbx,rbx
 108         mov ebx,dword [rax]
 109         push rbx
 110         next
 111
 112         WORD p_Dput, 'D!',fasm
 113         ;; ( v addr -- )
 114         ;; Store byte value v at address addr.
 115         pop rax
 116         pop rbx
 117         mov dword [rax], ebx
 118         next
 119
 120         WORD p_2get, '2@',fasm
 121         ;; ( addr -- v2 v1 )
 122         ;; Load the cell pair {v1,v2} from address addr.
 123         pop rax
 124         push qword [rax+8]      ; v2
 125         push qword [rax]        ; v1
 126         next
 127
 128         WORD p_2put, '2!',fasm
 129         ;; ( v2 v1 addr -- )
 130         ;; Store value pair {v1,v2} at address addr.
 131         pop rax
 132         pop rbx
 133         mov qword [rax], rbx    ; v1
 134         pop rbx
 135         mov qword [rax+8], rbx  ; v2
 136         next
 137
 138         WORD p_erase, 'ERASE',fasm
 139         ;; ( addr u -- )
 140         ;; Clear u bytes at address addr and up.
 141         pop rax
 142         pop rbx
 143         xor rcx,rcx
 144 p_erase_loop:
 145         cmp rax,8
 146         jl p_erase_last
 147         mov qword [rbx],0       ; mov qword[rbx],rcx
 148         add rbx,8
 149         sub rax,8
 150         jmp p_erase_loop
 151 p_erase_more:
 152         mov [rbx],byte 0        ; mov byte [rbx], cl
 153         inc rbx
 154         dec rax
 155 p_erase_last:
 156         jg p_erase_more
 157         next
 158
 159         WORD p_put_plus, '!+',fasm
 160         ;; ( addr n -- )
 161         ;; Add n to the value at addr.
 162         pop rbx
 163         pop rax
 164         add qword [rax],rbx
 165         next
 166
 167         WORD p_shift_left, '<<',fasm
 168         ;; ( x1 n -- x2 )
 169         ;; x2 is the result of shifting x1 one bit toward the
 170         ;; most-significant bit, filling the vacated least-significant
 171         ;; bit with zero.
 172         pop rcx
 173         shl qword [rsp],cl
 174         next
 175
 176         WORD p_shift_right, '>>',fasm
 177         ;; ( x1 n -- x2 )
 178         ;; x2 is the result of shifting x1 one bit toward the
 179         ;; least-significant bit, leaving the most-significant bit
 180         ;; unchanged. (signed right shift)
 181         pop rcx
 182         shr qword [rsp],cl
 183         next
 184
 185         WORD p_shift_signed_right, 's>>',fasm
 186         ;; ( x1 n -- x2 )
 187         ;; x2 is the result of shifting x1 one bit toward the
 188         ;; least-significant bit, leaving the most-significant bit
 189         ;; unchanged. (signed right shift)
 190         pop rcx
 191         sar qword [rsp],cl
 192         next
 193
 194         WORD p_get_n_increment,'@n++',fasm
 195         ;; ( a n -- v )
 196         ;; Fetch value at address then increment that address by n
 197         pop rbx
 198         pop rax
 199         push qword [rax]
 200         add qword [rax],rbx
 201         next
 202
 203         WORD p_get_n_decrement,'@n--',fasm
 204         ;; ( a n -- v )
 205         ;; Fetch value at address then decrement that address by n
 206         pop rbx
 207         pop rax
 208         push qword [rax]
 209         sub qword [rax],rbx
 210         next