some exploratory work towards "describe"

I'm reimplementing it, instead of hooking into the early implementation, because it's just SO much easier to read in the real syntax. also it's not really needed during bootstrapping, so probably that one can eventually be removed.

Force-Push: yes
Change-Id: If3d25eba1b280e14ee418d86d5098efcc069a529

1 files changed, 47 insertions, 5 deletions

diff --git a/quine.asm b/quine.asm
index d11ba48..a2cb18f 100644
--- a/quine.asm
+++ b/quine.asm
@@ -11126,6 +11126,21 @@ defword boot_source, 0x40
   ; (old here, length)
   dq "  drop 5 8 * + here ! ; make-immediate                          "
 
+  ; (start pointer, length)
+  dq ": unless 2dup swap dup 5 8 * + 3unroll swap                     "
+  ; (start pointer, length, start pointer, adjusted start pointer, length)
+  dq "  memmove                                                       "
+  ; (start pointer, length)
+  dq "  swap here @ swap here ! swap                                  "
+  ; (old here, length)
+  dq "  ' lit entry-to-execution-token , 0 ,                          "
+  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 + ,                "
+  ; (old here, length)
+  dq "  drop 5 8 * + here ! ; make-immediate                          "
+
   ; (true start, true length, false start, false length)
   dq ": if-else                                                       "
   ;dq "  dup 4 roll dup 5 unroll +                                     "
@@ -11200,7 +11215,7 @@ defword boot_source, 0x40
   dq "  { dup @ is-in-heap } { @ } while                              "
   dq "  0 swap ! ;                                                    "
   ; Do it immediately, so that we don't accidentally rely on any of that.
-  dq "unlink-pre-heap-words                                           "
+  ;dq "unlink-pre-heap-words                                           "
 
   ; Now some fancier stack combinators.
   ;
@@ -11215,6 +11230,8 @@ defword boot_source, 0x40
   dq ": not 0 = ;                                                     "
   dq ": negate -1 * ;                                                 "
 
+  dq ": align-floor dup 3unroll /% swap drop * ;                      "
+
   ; Some output formatting tools.
   dq ": space 32 value@ emitstring drop ;                             "
   dq ": newline 10 value@ emitstring drop ;                           "
@@ -11239,11 +11256,35 @@ defword boot_source, 0x40
   dq "  { dup { 2dup @ != } if }                                      "
   dq "  { @ } while swap drop ;                                       "
 
+  dq ": guess-entry-end                                               "
+  dq "  dup entry-flags@ 64 and 64 = { exit } if                      "
+  dq "  dup next-newer-entry dup { drop exit } unless                 "
+  dq "  swap drop ;                                                   "
+
+  dq ": word-heading                                                  "
+  dq "  dup entry-to-name dup emitstring space                        "
+  dq "  stringlen 1 + 70 swap - 0 max indent .hex64 newline ;         "
+
   dq ": list-dictionary                                               "
   dq "  oldest-entry { dup }                                          "
-  dq "  { dup entry-to-name dup emitstring space                      "
-  dq "    stringlen 1 + 70 swap - 0 max indent dup .hex64 newline     "
-  dq "    next-newer-entry } while drop ;                             "
+  dq "  { dup word-heading next-newer-entry } while drop ;            "
+
+  dq ": show-hex-row                                                  "
+  ; TODO string literals would be nice
+  dq "  2 indent over .hex64 58 value@ emitstring drop                "
+  dq "  0 { dup 4 > }                                                 "
+  dq "  { space 2 pick over + @ .hex64                                "
+  dq "    1 + } while newline drop drop drop ;                        "
+
+  dq ": show-hex-between stackhex                                     "
+  dq "  { 2dup > }                                                    "
+  dq "  { 2dup show-hex-row swap 32 + swap } while drop drop ;        "
+  ;dq "  { space over .hex64 swap 8 + swap } while drop drop ;         "
+
+  dq ": describe                                                      "
+  dq "  dup word-heading                                              "
+  dq "  dup guess-entry-end swap entry-to-execution-token swap        "
+  dq "  show-hex-between ;                                            "
 
   ;dq ": foo 5 { dup }                                                 "
   ;dq "  { 4 indent 97 value@ emitstring drop newline 1 - }            "
@@ -11253,7 +11294,8 @@ defword boot_source, 0x40
   ;dq ": foo { 5 . } forever ; foo ' foo forget                        "
   ;dq ": foo 0 { dup 5 > } { dup . 1 + } while drop ; foo ' foo forget "
 
-  dq "unlink-pre-heap-words list-dictionary                           "
+  ;dq "list-dictionary                                                 "
+  dq "' indent describe                                               "
   dq "                                                                "
 
   ; TODO define ( ... ) comments