memory.asm

   1 ;;; This file defines "memory access words"
   2
   3         WORD p_cfa2flags_get,'CFA>FLAGS@',fasm
   4         ;; ( cfa -- flags )
   5         pop rax
   6         cfa2tfa rax
   7         push qword[rax+16]
   8         next
   9
  10         WORD p_tfa2cfa,'TFA>CFA',fasm
  11         ;; ( tfa -- cfa )
  12         ;; Advance a word tfa pointer to the cfa field
  13         mov rax,qword[rsp]
  14         tfa2cfa rax
  15         mov qword [rsp],rax
  16         next
  17
  18         WORD p_tfa2dfa,'TFA>DFA',fasm
  19         ;; ( tfa -- dfa )
  20         ;; Advance a word tfa pointer to the dfa field
  21         mov rax,qword[rsp]
  22         tfa2dfa rax
  23         mov qword [rsp],rax
  24         next
  25
  26         WORD p_dfa2tfa,'DFA>TFA',fasm
  27         ;; ( dfa -- tfa )
  28         ;; Advance a word tfa pointer to the dfa field
  29         mov rax,qword[rsp]
  30         mov rax,qword [rax-24]  ; tfa
  31         mov qword [rsp],rax
  32         next
  33
  34         WORD p_get, '@',fasm
  35         ;; ( addr -- v )
  36         ;; Load value v from address addr
  37         pop rax
  38         push qword [rax]
  39         next
  40
  41         WORD p_put, '!',fasm
  42         ;; ( v addr -- )
  43         ;; Store value v at address addr.
  44         pop rax
  45         pop rbx
  46         mov qword [rax], rbx
  47         next
  48
  49         WORD p_Cget, 'C@',fasm
  50         ;; ( addr -- v )
  51         ;; Load the (unsigned) byte v from address addr.
  52         pop rax
  53         mov bl,[rax]
  54         push 0
  55         mov [rsp],bl
  56         next
  57
  58         WORD p_Cput, 'C!',fasm
  59         ;; ( v addr -- )
  60         ;; Store byte value v at address addr.
  61         pop rax
  62         pop rbx
  63         mov byte [rax], bl
  64         next
  65
  66         WORD p_2get, '2@',fasm
  67         ;; ( addr -- v2 v1 )
  68         ;; Load the cell pair {v1,v2} from address addr.
  69         pop rax
  70         push qword [rax+8]      ; v2
  71         push qword [rax]        ; v1
  72         next
  73
  74         WORD p_2put, '2!',fasm
  75         ;; ( v2 v1 addr -- )
  76         ;; Store value pair {v1,v2} at address addr.
  77         pop rax
  78         pop rbx
  79         mov qword [rax], rbx    ; v1
  80         pop rbx
  81         mov qword [rax+8], rbx  ; v2
  82         next
  83
  84         WORD p_erase, 'ERASE',fasm
  85         ;; ( addr u -- )
  86         ;; Clear u bytes at address addr and up.
  87         pop rax
  88         pop rbx
  89         xor rcx,rcx
  90 p_erase_loop:
  91         cmp rax,8
  92         jl p_erase_last
  93         mov qword [rbx],0       ; mov qword[rbx],rcx
  94         add rbx,8
  95         sub rax,8
  96         jmp p_erase_loop
  97 p_erase_more:
  98         mov [rbx],byte 0        ; mov byte [rbx], cl
  99         inc rbx
 100         dec rax
 101 p_erase_last:
 102         jg p_erase_more
 103         next
 104
 105         WORD p_1plus, '1+',fasm
 106         ;; ( n1 -- n2 )
 107         ;; Add one (1) to n1 resulting in n2.
 108         inc qword [rsp]
 109         next
 110
 111         WORD p_plus_put, '+!',fasm
 112         ;; ( n addr -- )
 113         ;; Add n to the value at addr.
 114         pop rax
 115         pop rbx
 116         add [rax],rbx
 117         next
 118
 119         WORD p_1minus, '1-',fasm
 120         ;; ( n1 -- n2 )
 121         ;; Subtract one (1) from n1 resulting in n2.
 122         dec qword [rsp]
 123         next
 124
 125         WORD p_2mult, '2*',fasm
 126         ;; ( x1 -- 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         shl qword [rsp],1
 131         next
 132
 133         WORD p_2div, '2/',fasm
 134         ;; ( x1 -- x2 )
 135         ;; x2 is the result of shifting x1 one bit toward the
 136         ;; least-significant bit, leaving the most-significant bit
 137         ;; unchanged. (signed right shift)
 138         sar qword [rsp],1
 139         next
 140