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