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