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_DFA
  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_DFA
  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_ifbreak,'IFBREAK',fasm,IMMEDIATE
  88         ;; ( -- a )
  89         ;; Lays out a (1BRANCH 0) cell pair and marks the current
  90         ;; address for later resolution
  91         mov rax,qword [p_here_DFA]
  92         mov qword [rax],p_true_branch_DFA
  93         mov qword [rax+8],0
  94         add rax,16
  95         mov qword [p_here_DFA],rax
  96         push rax
  97         next
  98
  99         WORD p_ifagain,'IFAGAIN',fasm,IMMEDIATE
 100         ;; ( a 0 * -- a 0 * )
 101         ;; Lays out a (1BRANCH ?) cell pair to conditionally repeat
 102         ;; from the prior BEGIN.
 103         mov rax,qword [p_here_DFA]
 104         mov qword [rax],p_true_branch_DFA
 105         mov qword [rax+8],0
 106         add rax,16
 107         mov qword [p_here_DFA],rax
 108         mov rbx,rsp
 109 p_ifagain_loop:
 110         cmp qword [rbx],0
 111         je p_ifagain_resolve
 112         add rbx,8
 113         jmp p_ifagain_loop
 114 p_ifagain_resolve:
 115         mov rbx,qword [rbx+8]
 116         sub rbx,rax
 117         mov qword [rax-8],rbx
 118         next
 119
 120         WORD p_end,'END',fasm,IMMEDIATE
 121         ;; Compiling: ( a 0 * -- )
 122         ;; Resolves all open branches for the preceding BEGIN and
 123         ;; optional several IFBREAK
 124         mov rax,rsp
 125         cmp qword [rax],0
 126         je p_end_resolve
 127         add rax,8
 128         jmp p_end_DFA
 129 p_end_resolve:
 130         mov rax,qword [rax+8] ; address of BEGIN
 131 p_end_next:
 132         pop rbx
 133         cmp rbx,0
 134         je p_end_ending
 135         mov rcx,rax
 136         sub rcx,rbx
 137         mov qword [rbx-8],rcx
 138         jmp p_end_next
 139 p_end_ending:
 140         pop rbx
 141         next
 142
 143