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         ;; ( cfa -- flags )
  21         pop rax
  22         push qword[rax+16]
  23         next
  24
  25         WORD p_cfa2flags_get,'CFA>FLAGS@',fasm
  26         ;; ( cfa -- flags )
  27         pop rax
  28         cfa2tfa rax
  29         push qword[rax+16]
  30         next
  31
  32         WORD p_dfa2tfa,'DFA>TFA',fasm
  33         ;; ( dfa -- tfa )
  34         ;; Advance a word tfa pointer to the dfa field
  35         mov rax,qword[rsp]
  36         mov rax,qword [rax-24]  ; tfa
  37         mov qword [rsp],rax
  38         next
  39
  40         WORD p_get, '@',fasm
  41         ;; ( addr -- v )
  42         ;; Load value v from address addr
  43         pop rax
  44         push qword [rax]
  45         next
  46
  47         WORD p_put, '!',fasm
  48         ;; ( v addr -- )
  49         ;; Store value v at address addr.
  50         pop rax
  51         pop rbx
  52         mov qword [rax], rbx
  53         next
  54
  55         WORD p_Cget, 'C@',fasm
  56         ;; ( addr -- v )
  57         ;; Load the (unsigned) byte v from address addr.
  58         pop rax
  59         mov bl,[rax]
  60         push 0
  61         mov [rsp],bl
  62         next
  63
  64         WORD p_Cput, 'C!',fasm
  65         ;; ( v addr -- )
  66         ;; Store byte value v at address addr.
  67         pop rax
  68         pop rbx
  69         mov byte [rax], bl
  70         next
  71
  72         WORD p_2get, '2@',fasm
  73         ;; ( addr -- v2 v1 )
  74         ;; Load the cell pair {v1,v2} from address addr.
  75         pop rax
  76         push qword [rax+8]      ; v2
  77         push qword [rax]        ; v1
  78         next
  79
  80         WORD p_2put, '2!',fasm
  81         ;; ( v2 v1 addr -- )
  82         ;; Store value pair {v1,v2} at address addr.
  83         pop rax
  84         pop rbx
  85         mov qword [rax], rbx    ; v1
  86         pop rbx
  87         mov qword [rax+8], rbx  ; v2
  88         next
  89
  90         WORD p_erase, 'ERASE',fasm
  91         ;; ( addr u -- )
  92         ;; Clear u bytes at address addr and up.
  93         pop rax
  94         pop rbx
  95         xor rcx,rcx
  96 p_erase_loop:
  97         cmp rax,8
  98         jl p_erase_last
  99         mov qword [rbx],0       ; mov qword[rbx],rcx
 100         add rbx,8
 101         sub rax,8
 102         jmp p_erase_loop
 103 p_erase_more:
 104         mov [rbx],byte 0        ; mov byte [rbx], cl
 105         inc rbx
 106         dec rax
 107 p_erase_last:
 108         jg p_erase_more
 109         next
 110
 111         WORD p_put_plus, '!+',fasm
 112         ;; ( addr n -- )
 113         ;; Add n to the value at addr.
 114         pop rbx
 115         pop rax
 116         add [rax],rbx
 117         next
 118
 119         WORD p_shift_left, '<<',fasm
 120         ;; ( x1 n -- x2 )
 121         ;; x2 is the result of shifting x1 one bit toward the
 122         ;; most-significant bit, filling the vacated least-significant
 123         ;; bit with zero.
 124         pop rcx
 125         shl qword [rsp],cl
 126         next
 127
 128         WORD p_shift_right, '>>',fasm
 129         ;; ( x1 n -- x2 )
 130         ;; x2 is the result of shifting x1 one bit toward the
 131         ;; least-significant bit, leaving the most-significant bit
 132         ;; unchanged. (signed right shift)
 133         pop rcx
 134         shr qword [rsp],cl
 135         next
 136
 137         WORD p_shift_signed_right, 's>>',fasm
 138         ;; ( x1 n -- x2 )
 139         ;; x2 is the result of shifting x1 one bit toward the
 140         ;; least-significant bit, leaving the most-significant bit
 141         ;; unchanged. (signed right shift)
 142         pop rcx
 143         sar qword [rsp],cl
 144         next
 145
 146         WORD p_get_n_increment,'@n++',fasm
 147         ;; ( a n -- v )
 148         ;; Fetch value at address then increment that address by n
 149         pop rbx
 150         pop rax
 151         push qword [rax]
 152         add qword [rax],rbx
 153         next
 154
 155         WORD p_get_n_decrement,'@n--',fasm
 156         ;; ( a n -- v )
 157         ;; Fetch value at address then decrement that address by n
 158         pop rbx
 159         pop rax
 160         push qword [rax]
 161         sub qword [rax],rbx
 162         next