implement forever and while

yay!

Force-Push: yes
Change-Id: I07aaeb486bf448ed736bd86ea5e495731a1da732

1 files changed, 35 insertions, 7 deletions

diff --git a/quine.asm b/quine.asm
index f9a5ad7..2f3dfd5 100644
--- a/quine.asm
+++ b/quine.asm
@@ -11119,7 +11119,7 @@ defword boot_source, 0x40
   dq "  swap here @ swap here ! swap                                  "
   ; (old here, length)
   dq "  ' lit entry-to-execution-token , 0 ,                          "
-  dq "  ' = entry-to-execution-token ,                                "
+  dq "  ' != 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.
   dq "  ' 0branch entry-to-execution-token , dup 8 + ,                "
@@ -11145,7 +11145,7 @@ defword boot_source, 0x40
   dq "  4 roll dup 5 unroll here @ 6 unroll here !                    "
   ; (old here, true start, true length, false start, false length)
   dq "  ' lit entry-to-execution-token , 0 ,                          "
-  dq "  ' = entry-to-execution-token ,                                "
+  dq "  ' != entry-to-execution-token ,                               "
   ;   Branch past the length field, the true-block, and the unconditional
   ; branch in the middle.
   dq "  ' 0branch entry-to-execution-token ,                          "
@@ -11161,14 +11161,42 @@ defword boot_source, 0x40
   dq "  drop drop drop drop 7 8 * + here !                            "
   dq "  ; make-immediate                                              "
 
-  dq ": foo 5 6 < { 42 . } if ; foo ' foo forget                      "
-  dq ": foo 5 6 > { 42 } { 69 } if-else . ; foo ' foo forget          "
+  ; (start, length)
+  dq ": forever                                                       "
+  dq "  ' branch entry-to-execution-token , 8 + -1 * , drop           "
+  dq "  ; 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)
+  dq ": while                                                         "
+  ;   The conditional branch needs five words.
+  dq "  2dup swap dup 5 8 * + swap 3roll memmove                      "
+  dq "  here @ 5 unroll swap dup 3unroll here !                       "
+  ; (old here, test start, test length, body start, body length)
+  dq "  ' lit entry-to-execution-token , 0 ,                          "
+  dq "  ' != entry-to-execution-token ,                               "
+  ; Branch past the length field, the body, and the unconditional branch.
+  dq "  ' 0branch entry-to-execution-token ,                          "
+  dq "  dup 3 8 * + ,                                                 "
+  ; Set "here" to the new end.
+  dq "  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.
+  dq "  ' branch entry-to-execution-token ,                           "
+  dq "  6 8 * + swap drop + swap drop -1 * ,                          "
+  dq "  ; make-immediate                                              "
+
+  ;dq ": foo 5 6 > { 42 . } if ; foo ' foo forget                      "
+  ;dq ": foo 5 6 > { 42 } { 69 } if-else . ; foo ' foo forget          "
+  ;dq ": foo { 5 . } forever ; foo ' foo forget                        "
+  dq ": foo 0 { dup 5 > } { dup . 1 + } while drop ; foo              "
 
   dq "                                                                "
 
-  ; TODO define if/then/else
-  ; TODO define begin/until/again and repeat, or something like them
-  ; TODO consider defining case / endcase
   ; TODO define ( ... ) comments
   ; TODO define negate, true, false, not
   ; TODO define constant (double-check variable)