+;;; This file defines execution control words
+
+ WORD p_branch,'BRANCH',fasm
+ ;; ( -- )
+ ;; Using subsequent inline cell as branch offset, branch
+ ;; accordingly
+ add rsi,qword [rsi]
+ add rsi,8
+ next
+
+ WORD p_zero_branch,'0BRANCH',fasm
+ ;; ( v -- )
+ ;; Using subsequent inline cell as branch offset, branch
+ ;; accordingly if the stacked value is zero, otherwise just
+ ;; skip over the branch offset
+ pop rax
+ cmp rax,0
+ jne p_zero_branch_SKIP
+ add rsi,qword [rsi]
+p_zero_branch_SKIP:
+ add rsi,8
+ next
+
+ WORD p_true_branch,'1BRANCH',fasm
+ ;; ( v -- )
+ ;; Using subsequent inline cell as branch offset, branch
+ ;; accordingly if the stacked value is non-zero, otherwise
+ ;; just skip over the branch offset
+ pop rax
+ cmp rax,0
+ je p_true_branch_SKIP
+ add rsi,qword [rsi]
+p_true_branch_SKIP:
+ add rsi,8
+ next
+
+ WORD p_if,'IF',fasm,IMMEDIATE
+ ;; Compiling: ( -- a )
+ ;; Adds a (0BRANCH 0) cell pair into the current definition,
+ ;; and the address for the subsequent cell on the datastack.
+ ;; This prepares for a subsequent THEN to resolve the
+ ;; conditional branch length.
+ mov rax,qword [p_here_DFA]
+ mov qword [rax],p_zero_branch_DFA
+ mov qword [rax+8],0
+ add rax,16
+ mov qword [p_here_DFA],rax
+ push rax
+ next
+
+ WORD p_then,'THEN',fasm,IMMEDIATE
+ ;; Compiling: ( a -- )
+ ;; Computes the byte difference from address a and current
+ ;; "HERE", and writes that at [a].
+ pop rax
+ mov rbx,qword [p_here_DFA]
+ sub rbx,rax
+ mov qword [rax-8],rbx
+ next
+
+ WORD p_else,'ELSE',fasm,IMMEDIATE
+ ;; Compiling: ( a1 -- a2 )
+ ;; To be used between IF and THEN to lay out an unresolved
+ ;; (BRANCH 0) cell pair that ends the "then-part", and resolve
+ ;; the pending (0BRANCH 0) distance to egin the "else-part" of
+ ;; the conditional.
+ mov rax,qword [p_here_DFA]
+ mov qword [rax],p_branch_DFA
+ mov qword [rax+8],0
+ add rax,16
+ mov qword [p_here_DFA],rax
+ pop rax
+ mov rbx,qword [p_here_DFA]
+ push rbx
+ sub rbx,rax
+ mov qword [rax-8],rbx
+ next
+
+ WORD p_begin,'BEGIN',fasm,IMMEDIATE
+ ;; Compiling: ( -- a 0 )
+ ;; Pushes current address as a return point, and a 0 to mark
+ ;; it.
+ push qword [p_here_DFA]
+ push qword 0
+ next
+
+ WORD p_ifbreak,'IFBREAK',fasm,IMMEDIATE
+ ;; ( -- a )
+ ;; Lays out a (1BRANCH 0) cell pair and marks the current
+ ;; address for later resolution
+ mov rax,qword [p_here_DFA]
+ mov qword [rax],p_true_branch_DFA
+ mov qword [rax+8],0
+ add rax,16
+ mov qword [p_here_DFA],rax
+ push rax
+ next
+
+ WORD p_ifagain,'IFAGAIN',fasm,IMMEDIATE
+ ;; ( a 0 * -- a 0 * )
+ ;; Lays out a (1BRANCH ?) cell pair to conditionally repeat
+ ;; from the prior BEGIN.
+ mov rax,qword [p_here_DFA]
+ mov qword [rax],p_true_branch_DFA
+ mov qword [rax+8],0
+ add rax,16
+ mov qword [p_here_DFA],rax
+ mov rbx,rsp
+p_ifagain_loop:
+ cmp qword [rbx],0
+ je p_ifagain_resolve
+ add rbx,8
+ jmp p_ifagain_loop
+p_ifagain_resolve:
+ mov rbx,qword [rbx+8]
+ sub rbx,rax
+ mov qword [rax-8],rbx
+ next
+
+ WORD p_end,'END',fasm,IMMEDIATE
+ ;; Compiling: ( a 0 * -- )
+ ;; Resolves all open branches for the preceding BEGIN and
+ ;; optional several IFBREAK
+ mov rax,rsp
+ cmp qword [rax],0
+ je p_end_resolve
+ add rax,8
+ jmp p_end_DFA
+p_end_resolve:
+ mov rax,qword [rax+8] ; address of BEGIN
+p_end_next:
+ pop rbx
+ cmp rbx,0
+ je p_end_ending
+ mov rcx,rax
+ sub rcx,rbx
+ mov qword [rbx-8],rcx
+ jmp p_end_next
+p_end_ending:
+ pop rbx
+ next
+
+