1 files changed, 129 insertions, 0 deletions
diff --git a/flow-control.e b/flow-control.e
new file mode 100644
index 0000000..a1b066d
--- /dev/null
+++ b/flow-control.e
@@ -0,0 +1,129 @@
+~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~ ~~ High-level flow-control ~~
+~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~
+~   We use a novel suffix-based approach to flow control. We define words
+~ { and } which describe the boundaries of blocks of code, leaving a
+~ description on the value stack, while still compiling the contents
+~ normally.
+~
+~   Then follow-up words such as "if" can use that information to slide
+~ the blocks around and insert any needed branches and other logic.
+~
+~   Both the label transform and the log-load transform go out of their way
+~ to make sure these words work. Because of that, we actually get to use these
+~ before defining them... just keep in mind nothing under the transform is
+~ calling THESE versions.
+
+
+~ (-- start pointer)
+: { here @ ; make-immediate
+
+~ (start pointer -- start pointer, length)
+: } dup here @ swap - ; make-immediate
+
+
+~ (start pointer, length --)
+: if
+  2dup swap dup 5 8 * + 3unroll swap
+  ~ (start pointer, length, adjusted start pointer, start pointer, length)
+  memmove
+  ~ (start pointer, length)
+
+  swap here @ swap here ! swap
+  ~ (old here, length)
+
+  ' lit entry-to-execution-token , 0 ,
+  ' != entry-to-execution-token ,
+
+  ~   The branch length needs to be one word longer than the block length,
+  ~ because the length field itself is part of the scope of the branch.
+  ' 0branch entry-to-execution-token , dup 8 + ,
+  ~ (old here, length)
+
+  drop 5 8 * + here !
+  ; make-immediate
+
+
+~ (start pointer, length --)
+: unless 2dup swap dup 5 8 * + 3unroll swap
+  ~ (start pointer, length, start pointer, adjusted start pointer, length)
+  memmove
+  ~ (start pointer, length)
+  swap here @ swap here ! swap
+  ~ (old here, length)
+  ' lit entry-to-execution-token , 0 ,
+  ' = entry-to-execution-token ,
+  ~   The branch length needs to be one word longer than the block length,
+  ~ because the length field itself is part of the scope of the branch.
+  ' 0branch entry-to-execution-token , dup 8 + ,
+  ~ (old here, length)
+  drop 5 8 * + here ! ; make-immediate
+
+
+~ (true start, true length, false start, false length --)
+: if-else
+  dup 4 roll dup 5 unroll +
+
+  ~   First we slide the false-block forward, then the true-block. We slide
+  ~ them both directly into their final positions, leaving space at the start
+  ~ for a test and branch, and space in between for an unconditional branch.
+  ~ Those spaces will take five words, and two words, respectively. So the
+  ~ false-block gets moved by seven words, and the true-block gets moved by
+  ~ five words.
+  2dup swap dup 7 8 * + swap 3roll memmove
+  4 roll dup 5 unroll 4 roll dup 5 unroll
+  swap dup 5 8 * + swap 3roll memmove
+  ~ (true start, true length, false start, false length)
+
+  ~   Now we write out the initial test-and-branch.
+  4 roll dup 5 unroll here @ 6 unroll here !
+  ~ (old here, true start, true length, false start, false length)
+  ' lit entry-to-execution-token , 0 ,
+  ' != entry-to-execution-token ,
+  ~   Branch past the length field, the true-block, and the unconditional
+  ~ branch in the middle.
+  ' 0branch entry-to-execution-token ,
+  3roll dup 4 unroll 3 8 * + ,
+
+  ~  Next, write out the unconditional branch in the middle.
+  swap dup 3unroll 5 8 * + here !
+  ' branch entry-to-execution-token ,
+  ~  Branch past the length field and the false-block.
+  dup 8 + ,
+
+  ~  Set "here" to point to the true end.
+  drop drop drop drop 7 8 * + here !
+  ; make-immediate
+
+
+~ (start, length --)
+: forever
+  ' branch entry-to-execution-token , 8 + -1 * , drop
+  ; make-immediate
+
+
+~   This slides the body forward, leaving the test where it is. It puts a
+~ conditional branch in-between them, then appends an unconditional branch
+~ at the end.
+~
+~ (test start, test length, body start, body length --)
+: while
+  ~   The conditional branch needs five words.
+  2dup swap dup 5 8 * + swap 3roll memmove
+  here @ 5 unroll swap dup 3unroll here !
+  ~ (old here, test start, test length, body start, body length)
+  ' lit entry-to-execution-token , 0 ,
+  ' != entry-to-execution-token ,
+  ~ Branch past the length field, the body, and the unconditional branch.
+  ' 0branch entry-to-execution-token ,
+  dup 3 8 * + ,
+  ~ Set "here" to the new end.
+  5 8 * 6 roll + here !
+  ~ (test start, test length, body start, body length)
+  ~   Unconditionally branch backwards past the branch word, the body, the
+  ~ conditional branch, and the test.
+  ' branch entry-to-execution-token ,
+  6 8 * + swap drop + swap drop -1 * ,
+  ; make-immediate
+