control.asm

   1 ;;; This file defines execution control words
   2
   3         WORD p_branch,'BRANCH',fasm
   4         ;; ( -- )
   5         ;; Using subsequent inline cell as branch offset, branch
   6         ;; accordingly
   7         add rsi,qword [rsi]
   8         add rsi,8
   9         next
  10
  11         WORD p_zero_branch,'0BRANCH',fasm
  12         ;; ( v -- )
  13         ;; Using subsequent inline cell as branch offset, branch
  14         ;; accordingly if the stacked value is zero, otherwise just
  15         ;; skip over the branch offset
  16         pop rax
  17         cmp rax,0
  18         jne p_zero_branch_SKIP
  19         add rsi,qword [rsi]
  20 p_zero_branch_SKIP:
  21         add rsi,8
  22         next
  23
  24         WORD p_true_branch,'1BRANCH',fasm
  25         ;; ( v -- )
  26         ;; Using subsequent inline cell as branch offset, branch
  27         ;; accordingly if the stacked value is non-zero, otherwise
  28         ;; just skip over the branch offset
  29         pop rax
  30         cmp rax,0
  31         je p_true_branch_SKIP
  32         add rsi,qword [rsi]
  33 p_true_branch_SKIP:
  34         add rsi,8
  35         next
  36
  37         WORD p_if,'IF',fasm,IMMEDIATE
  38         ;; Compiling: ( -- a )
  39         ;; Adds a (0BRANCH 0) cell pair into the current definition,
  40         ;; and the address for the subsequent cell on the datastack.
  41         ;; This prepares for a subsequent THEN to resolve the
  42         ;; conditional branch length.
  43         mov rax,qword [p_here_DFA]
  44         mov qword [rax],p_zero_branch_CFA
  45         mov qword [rax+8],0
  46         add rax,16
  47         mov qword [p_here_DFA],rax
  48         push rax
  49         next
  50
  51         WORD p_then,'THEN',fasm,IMMEDIATE
  52         ;; Compiling: ( a -- )
  53         ;; Computes the byte difference from address a and current
  54         ;; "HERE", and writes that at [a].
  55         pop rax
  56         mov rbx,qword [p_here_DFA]
  57         sub rbx,rax
  58         mov qword [rax-8],rbx
  59         next
  60
  61         WORD p_else,'ELSE',fasm,IMMEDIATE
  62         ;; Compiling: ( a1 -- a2 )
  63         ;; To be used between IF and THEN to lay out an unresolved
  64         ;; (BRANCH 0) cell pair that ends the "then-part", and resolve
  65         ;; the pending (0BRANCH 0) distance to egin the "else-part" of
  66         ;; the conditional.
  67         mov rax,qword [p_here_DFA]
  68         mov qword [rax],p_branch_CFA
  69         mov qword [rax+8],0
  70         add rax,16
  71         mov qword [p_here_DFA],rax
  72         pop rax
  73         mov rbx,qword [p_here_DFA]
  74         push rbx
  75         sub rbx,rax
  76         mov qword [rax-8],rbx
  77         next
  78
  79         WORD p_begin,'BEGIN',fasm,IMMEDIATE
  80         ;; Compiling: ( -- a 0 )
  81         ;; Pushes current address as a return point, and a 0 to mark
  82         ;; it.
  83         push qword [p_here_DFA]
  84         push qword 0
  85         next
  86
  87         WORD p_break,'BREAK',fasm,IMMEDIATE
  88         ;; ( 0 * -- 0 a * )
  89         ;; Lays out a (BRANCH 0) cell pair and marks the current
  90         ;; address for later resolution
  91         mov rax,qword [p_here_DFA]
  92         mov qword [rax],p_branch_CFA
  93         mov qword [rax+8],0
  94         add rax,16
  95         mov qword [p_here_DFA],rax
  96         jmp p_ifbreak_elevate
  97
  98         WORD p_ifbreak,'IFBREAK',fasm,IMMEDIATE
  99         ;; ( 0 * -- 0 a * )
 100         ;; Lays out a (1BRANCH 0) cell pair and marks the current
 101         ;; address for later resolution
 102         mov rax,qword [p_here_DFA]
 103         mov qword [rax],p_true_branch_CFA
 104         mov qword [rax+8],0
 105         add rax,16
 106         mov qword [p_here_DFA],rax
 107         ;; Elevate stack entries until a 0 is found. This places the
 108         ;; IFBREAK pointer below any IF-THEN block pointers
 109 p_ifbreak_elevate:
 110         sub rsp,8
 111         mov rbx,rsp
 112 p_ifbreak_loop:
 113         add rbx,8
 114         cmp qword [rbx],0
 115         je p_ifbreak_end
 116         mov rcx,qword [rbx]
 117         mov qword [rbx-8],rcx
 118         jmp p_ifbreak_loop
 119 p_ifbreak_end:
 120         mov qword [rbx-8],rax
 121         next
 122
 123         WORD p_ifagain,'IFAGAIN',fasm,IMMEDIATE
 124         ;; ( a 0 * -- a 0 * )
 125         ;; Lays out a (1BRANCH ?) cell pair to conditionally repeat
 126         ;; from the prior BEGIN.
 127         mov rax,qword [p_here_DFA]
 128         mov qword [rax],p_true_branch_CFA
 129         mov qword [rax+8],0
 130         add rax,16
 131         mov qword [p_here_DFA],rax
 132         mov rbx,rsp
 133 p_ifagain_loop:
 134         cmp qword [rbx],0
 135         je p_ifagain_resolve
 136         add rbx,8
 137         jmp p_ifagain_loop
 138 p_ifagain_resolve:
 139         mov rbx,qword [rbx+8]
 140         sub rbx,rax
 141         mov qword [rax-8],rbx
 142         next
 143
 144         WORD p_end,'END',fasm,IMMEDIATE
 145         ;; Compiling: ( a 0 * -- )
 146         ;; Resolves all open branches for the preceding BEGIN and
 147         ;; optional several IFBREAK
 148         mov rax,rsp
 149 p_end_scan:
 150         cmp qword [rax],0
 151         je p_end_resolve
 152         add rax,8
 153         jmp p_end_scan
 154 p_end_resolve:
 155         mov rax,qword [rax+8] ; address of BEGIN
 156 p_end_next:
 157         pop rbx
 158         cmp rbx,0
 159         je p_end_ending
 160         mov rcx,qword [p_here_DFA]
 161         sub rcx,rbx
 162         mov qword [rbx-8],rcx
 163         jmp p_end_next
 164 p_end_ending:
 165         pop rbx
 166         next
 167
 168         WORD p_again,'AGAIN',fasm,IMMEDIATE
 169         ;; Compiling: ( a 0 * -- )
 170         ;; Lay out unconditional loop-back, then perform END action
 171         mov rax,qword [p_here_DFA]
 172         mov qword [rax],p_branch_CFA
 173         mov qword [rax+8],0
 174         add rax,16
 175         mov qword [p_here_DFA],rax
 176         mov rbx,rsp
 177 p_again_loop:
 178         cmp qword [rbx],0
 179         je p_again_resolve
 180         add rbx,8
 181         jmp p_again_loop
 182 p_again_resolve:
 183         mov rbx,qword [rbx+8]
 184         sub rbx,rax
 185         mov qword [rax-8],rbx
 186         jmp p_end_DFA