bug fix for lpar comment

[rrq/rrqforth.git] / control.asm

diff --git a/control.asm b/control.asm
index e4051d7ca3001a1d96f51356fbf124c6ba000007..b6bfe0f005e964ce1773fa025d7d618e01ea95e4 100644 (file)
--- a/control.asm
+++ b/control.asm
@@ -41,7 +41,7 @@ p_true_branch_SKIP:
        ;; 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],p_zero_branch_CFA
        mov qword [rax+8],0
        add rax,16
        mov qword [p_here_DFA],rax
@@ -65,7 +65,7 @@ p_true_branch_SKIP:
        ;; 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],p_branch_CFA
        mov qword [rax+8],0
        add rax,16
        mov qword [p_here_DFA],rax
@@ -84,16 +84,40 @@ p_true_branch_SKIP:
        push qword 0
        next
        
+       WORD p_break,'BREAK',fasm,IMMEDIATE
+       ;; ( 0 * -- 0 a * )
+       ;; Lays out a (BRANCH 0) cell pair and marks the current
+       ;; address for later resolution
+       mov rax,qword [p_here_DFA]
+       mov qword [rax],p_branch_CFA
+       mov qword [rax+8],0
+       add rax,16
+       mov qword [p_here_DFA],rax
+       jmp p_ifbreak_elevate
+
        WORD p_ifbreak,'IFBREAK',fasm,IMMEDIATE
-       ;; ( -- a )
+       ;; ( 0 * -- 0 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],p_true_branch_CFA
        mov qword [rax+8],0
        add rax,16
        mov qword [p_here_DFA],rax
-       push rax
+       ;; Elevate stack entries until a 0 is found. This places the
+       ;; IFBREAK pointer below any IF-THEN block pointers
+p_ifbreak_elevate:
+       sub rsp,8
+       mov rbx,rsp
+p_ifbreak_loop:
+       add rbx,8
+       cmp qword [rbx],0
+       je p_ifbreak_end
+       mov rcx,qword [rbx]
+       mov qword [rbx-8],rcx
+       jmp p_ifbreak_loop
+p_ifbreak_end:
+       mov qword [rbx-8],rax
        next
 
        WORD p_ifagain,'IFAGAIN',fasm,IMMEDIATE
@@ -101,7 +125,7 @@ p_true_branch_SKIP:
        ;; 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],p_true_branch_CFA
        mov qword [rax+8],0
        add rax,16
        mov qword [p_here_DFA],rax
@@ -122,17 +146,18 @@ p_ifagain_resolve:
        ;; Resolves all open branches for the preceding BEGIN and
        ;; optional several IFBREAK
        mov rax,rsp
+p_end_scan:
        cmp qword [rax],0
        je p_end_resolve
        add rax,8
-       jmp p_end_DFA
+       jmp p_end_scan
 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
+       mov rcx,qword [p_here_DFA]
        sub rcx,rbx
        mov qword [rbx-8],rcx
        jmp p_end_next