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         mov bl,[rax]
  74         push 0
  75         mov [rsp],bl
  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_2get, '2@',fasm
  87         ;; ( addr -- v2 v1 )
  88         ;; Load the cell pair {v1,v2} from address addr.
  89         pop rax
  90         push qword [rax+8]      ; v2
  91         push qword [rax]        ; v1
  92         next
  93
  94         WORD p_2put, '2!',fasm
  95         ;; ( v2 v1 addr -- )
  96         ;; Store value pair {v1,v2} at address addr.
  97         pop rax
  98         pop rbx
  99         mov qword [rax], rbx    ; v1
 100         pop rbx
 101         mov qword [rax+8], rbx  ; v2
 102         next
 103
 104         WORD p_erase, 'ERASE',fasm
 105         ;; ( addr u -- )
 106         ;; Clear u bytes at address addr and up.
 107         pop rax
 108         pop rbx
 109         xor rcx,rcx
 110 p_erase_loop:
 111         cmp rax,8
 112         jl p_erase_last
 113         mov qword [rbx],0       ; mov qword[rbx],rcx
 114         add rbx,8
 115         sub rax,8
 116         jmp p_erase_loop
 117 p_erase_more:
 118         mov [rbx],byte 0        ; mov byte [rbx], cl
 119         inc rbx
 120         dec rax
 121 p_erase_last:
 122         jg p_erase_more
 123         next
 124
 125         WORD p_put_plus, '!+',fasm
 126         ;; ( addr n -- )
 127         ;; Add n to the value at addr.
 128         pop rbx
 129         pop rax
 130         add [rax],rbx
 131         next
 132
 133         WORD p_shift_left, '<<',fasm
 134         ;; ( x1 n -- x2 )
 135         ;; x2 is the result of shifting x1 one bit toward the
 136         ;; most-significant bit, filling the vacated least-significant
 137         ;; bit with zero.
 138         pop rcx
 139         shl qword [rsp],cl
 140         next
 141
 142         WORD p_shift_right, '>>',fasm
 143         ;; ( x1 n -- x2 )
 144         ;; x2 is the result of shifting x1 one bit toward the
 145         ;; least-significant bit, leaving the most-significant bit
 146         ;; unchanged. (signed right shift)
 147         pop rcx
 148         shr qword [rsp],cl
 149         next
 150
 151         WORD p_shift_signed_right, 's>>',fasm
 152         ;; ( x1 n -- x2 )
 153         ;; x2 is the result of shifting x1 one bit toward the
 154         ;; least-significant bit, leaving the most-significant bit
 155         ;; unchanged. (signed right shift)
 156         pop rcx
 157         sar qword [rsp],cl
 158         next
 159
 160         WORD p_get_n_increment,'@n++',fasm
 161         ;; ( a n -- v )
 162         ;; Fetch value at address then increment that address by n
 163         pop rbx
 164         pop rax
 165         push qword [rax]
 166         add qword [rax],rbx
 167         next
 168
 169         WORD p_get_n_decrement,'@n--',fasm
 170         ;; ( a n -- v )
 171         ;; Fetch value at address then decrement that address by n
 172         pop rbx
 173         pop rax
 174         push qword [rax]
 175         sub qword [rax],rbx
 176         next