get hex dumps basically working

still needs character visualization

also implement ndup ndrop and some similar stuff

Force-Push: yes
Change-Id: I8f0ccdc9643afcd5b9a216b835b74c2c729d1d12

1 files changed, 35 insertions, 20 deletions

diff --git a/quine.asm b/quine.asm
index 0d9e38d..7286da3 100644
--- a/quine.asm
+++ b/quine.asm
@@ -11222,13 +11222,23 @@ defword boot_source, 0x40
   ;
   ;   While it might be nice, for performance reasons, to do these in
   ; assembler, for now it's more important to have them at all.
-  dq ": over swap dup 3unroll ;                                       "
-  dq ": pick 2 + dup roll dup 3roll unroll ;                          "
-
+  dq ": 1- 1 - ;                                                      "
+  dq ": 1+ 1 + ;                                                      "
   dq ": max 2dup >= { swap drop } { drop } if-else ;                  "
   dq ": min 2dup <= { swap drop } { drop } if-else ;                  "
 
-  dq ": && * 0 != ;                                                   "
+  dq ": over swap dup 3unroll ;                                       "
+  dq ": pick 2 + dup roll dup 3roll unroll ;                          "
+  ; Standard Forth doesn't have equivalents of our ndrop and ndup. The HP
+  ; calls them DROPN and DUPN but that doesn't go well with ie. 2dup or 3roll,
+  ; so we do it like this.
+  dq ": ndrop { dup } { swap drop 1- } while drop ;                   "
+  dq ": ndup dup 1+ swap { dup }                                      "
+  dq "  { swap dup pick 3unroll swap 1- } while 2drop ;               "
+  dq ": 3drop drop drop drop ;                                        "
+  dq ": 3dup 2 pick 2 pick 2 pick ;                                   "
+
+  dq ": && 0 != swap 0 != * ;                                         "
   dq ": || | 0 != ;                                                   "
   dq ": not 0 = ;                                                     "
   dq ": negate -1 * ;                                                 "
@@ -11238,7 +11248,8 @@ defword boot_source, 0x40
   ; Some output formatting tools.
   dq ": space 32 value@ emitstring drop ;                             "
   dq ": newline 10 value@ emitstring drop ;                           "
-  dq ": indent { dup } { space 1 - } while drop ;                     "
+  dq ": indent { dup } { space 1- } while drop ;                      "
+  dq ": .hexn 16 swap .base-unsigned ;                                "
 
   ; Some debugging tools.
   dq ": stack                                                         "
@@ -11255,7 +11266,7 @@ defword boot_source, 0x40
 
   dq ": next-newer-entry                                              "
   dq "  latest @                                                      "
-  dq "  2dup = { drop drop 0 exit } if                                "
+  dq "  2dup = { 2drop 0 exit } if                                    "
   dq "  { dup { 2dup @ != } if }                                      "
   dq "  { @ } while swap drop ;                                       "
 
@@ -11266,36 +11277,40 @@ defword boot_source, 0x40
 
   dq ": word-heading                                                  "
   dq "  dup entry-to-name dup emitstring space                        "
-  dq "  stringlen 1 + 70 swap - 0 max indent .hex64 newline ;         "
+  dq "  stringlen 1+ 70 swap - 0 max indent .hex64 newline ;          "
 
   dq ": list-dictionary                                               "
   dq "  oldest-entry { dup }                                          "
   dq "  { dup word-heading next-newer-entry } while drop ;            "
 
+  ; (content end, content start, label start)
   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 "  2 indent dup .hex32 dup 4 unroll                              "
+  dq "  0 { dup 16 > }                                                "
+  dq "  { dup 7 & 0 = { space } if space                              "
+  dq "    2dup + dup 4 pick <= swap 5 pick > &&                       "
+  dq "      { 2dup + 8@ .hex8 } { space space } if-else               "
+  dq "    1+ } while                                                  "
+  dq "  newline 5 ndrop ;                                             "
+
+  ; (end, start)
+  dq ": show-hex-between                                              "
+  dq "  dup 16 1- invert &                                            "
+  dq "  { dup 3 pick >= }                                             "
+  dq "  { 3dup show-hex-row 16 + } while 3 ndrop ;                    "
 
   dq ": describe                                                      "
   dq "  dup word-heading                                              "
-  dq "  dup guess-entry-end swap entry-to-execution-token swap        "
+  dq "  dup guess-entry-end swap entry-to-execution-token             "
   dq "  show-hex-between ;                                            "
 
   ;dq ": foo 5 { dup }                                                 "
-  ;dq "  { 4 indent 97 value@ emitstring drop newline 1 - }            "
+  ;dq "  { 4 indent 97 value@ emitstring drop newline 1- }             "
   ;dq "  while drop ; foo                                              "
   ;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 ' foo forget "
+  ;dq ": foo 0 { dup 5 > } { dup . 1+ } while drop ; foo ' foo forget  "
 
   ;dq "list-dictionary                                                 "
   dq "' indent describe                                               "