stack.asm

   1 ;;; Words for stack manipulations
   2
   3         WORD p_dsp,'D[n]',fasm
   4         ;; ( n -- a )
   5         ;; Push the address of the n:th cell below n onto the stack
   6         pop rax
   7         shl rax,3
   8         add rax,rsp
   9         push rax
  10         next
  11
  12         WORD p_depth,'DEPTH',fasm
  13         ;; ( -- v )
  14         ;; Push stack depth (before push)
  15         lea rax,[DS_TOP]
  16         sub rax,rsp
  17         shr rax,3
  18         push rax
  19         next
  20
  21         WORD p_dup, 'DUP',fasm
  22         ;; ( v -- v v )
  23         ;; Duplicate top ov stack value.
  24         ;; push qword [rsp] ??
  25         mov rax,qword [rsp]
  26         push rax
  27         next
  28
  29         WORD p_2dup, '2DUP',fasm
  30         ;; ( x1 x2 -- x1 x2 x1 x2 )
  31         ;; Duplicate cell pair x1 x2.
  32         push qword [rsp+8]
  33         push qword [rsp+8]
  34         next
  35
  36         WORD p_drop, 'DROP',fasm
  37         ;; ( x -- )
  38         ;; Remove x from the stack.
  39         add rsp,8
  40         next
  41
  42         WORD p_2drop, '2DROP',fasm
  43         ;; ( x1 x2 -- )
  44         ;; Drop cell pair x1 x2 from the stack.
  45         add rsp,16
  46         next
  47
  48         WORD p_over, 'OVER',fasm
  49         ;; ( x1 x2 -- x1 x2 x1 )
  50         ;; Place a copy of x1 on top of the stack.
  51         push qword [rsp+8]
  52         next
  53
  54         WORD p_2over, '2OVER',fasm
  55         ;; ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
  56         ;; Copy cell pair x1 x2 to the top of the stack.
  57         push qword [rsp+24]
  58         push qword [rsp+24]
  59         next
  60
  61         WORD p_swap, 'SWAP',fasm
  62         ;; ( x1 x2 -- x2 x1 )
  63         ;; Exchange the top two stack items.
  64         mov rax,qword [rsp]
  65         mov rbx,qword [rsp+8]
  66         mov qword [rsp+8],rax
  67         mov qword [rsp],rbx
  68         next
  69
  70         WORD p_2swap, '2SWAP',fasm
  71         ;; ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
  72         ;; Exchange the top two cell pairs.
  73         mov rax,qword [rsp]
  74         mov rbx,qword [rsp+16]
  75         mov qword [rsp], rbx
  76         mov qword [rsp+16],rax
  77         mov rax,qword [rsp+8]
  78         mov rbx,qword [rsp+24]
  79         mov qword [rsp+8], rbx
  80         mov qword [rsp+24],rax
  81         next
  82
  83         WORD p_rot, 'ROT',fasm
  84         ;; ( x1 x2 x3 -- x2 x3 x1 )
  85         ;; Rotate the top three stack entries.
  86         mov rax,qword [rsp+16]
  87         mov rbx,qword [rsp+8]
  88         mov qword [rsp+16],rbx
  89         mov rbx,qword [rsp]
  90         mov qword [rsp+8],rbx
  91         mov qword [rsp],rax
  92         next
  93
  94         ;; ( xu xu-1 ... x0 u -- xu-1 ... x0 xu )
  95         ;; Remove u. Rotate u+1 items on the top of the stack. An
  96         ;; ambiguous condition exists if there are less than u+2 items
  97         ;; on the stack before ROLL is executed.
  98         WORD p_roll, 'ROLL',fasm
  99         pop rcx
 100         shl rcx,3
 101         add rcx,rsp
 102         mov rax,[rcx+8]
 103 p_roll_loop:
 104         cmp rcx,rsp
 105         je p_roll_eq
 106         mov rbx,[rcx]
 107         mov [rcx+8],rbx
 108         sub rcx,8
 109         jmp p_roll_loop
 110 p_roll_eq:
 111         mov [rsp],rax
 112         next
 113
 114         WORD p_nip, 'NIP',fasm
 115         ;; ( x1 x2 -- x2 )
 116         ;; Discard the second stack item.
 117         pop rax
 118         mov qword [rsp],rax
 119         next
 120
 121         WORD p_pick, 'PICK',fasm
 122         ;; ( xu...x1 x0 u -- xu...x1 x0 xu )
 123         ;; Remove u. Copy the xu to the top of the stack. An ambiguous
 124         ;; condition exists if there are less than u+2 items on the
 125         ;; stack before PICK is executed.
 126         pop rax
 127         shl rax,3               ; 8 bytes per index
 128         push qword [rsp+rax]
 129         next
 130
 131         WORD p_tuck, 'TUCK',fasm
 132         ;; ( x1 x2 -- x2 x1 x2 )
 133         ;; copy the top stack value into below second stack value.
 134         pop rax
 135         pop rbx
 136         push rax
 137         push rbx
 138         push rax
 139         next
 140
 141 ;;; ========================================
 142 ;;; Return stack operations
 143
 144         WORD p_gtR, '>R',fasm
 145         ;; ( x -- ) ( R: -- x )
 146         ;; Move x to the return stack.
 147         pop rax
 148         pushr rax
 149         next
 150
 151         WORD p_Rgt, 'R>',fasm
 152         ;; ( -- x ) ( R: x -- )
 153         ;; Move x from the return stack to the data stack.
 154         popr rax
 155         push rax
 156         next
 157
 158         WORD p_Rget, 'R@',fasm
 159         ;; ( -- x ) ( R: x -- x )
 160         ;; Copy x from the return stack to the data stack.
 161         push qword [rbp]
 162         next
 163
 164         WORD p_rbp,'RSP',fasm
 165         ;; Push the return stack pointer to the data stack
 166         push rbp
 167         next
 168
 169         WORD p_rbpn,'R[n]',fasm
 170         ;; ( n -- a )
 171         ;; push the address of the n:th cell on the return stack
 172         mov rax,qword [rsp]
 173         shl rax,3
 174         add rax,rbp
 175         mov qword [rsp],rax
 176         next