output hex transform comments giving the readings of string literals

this is gonna work!!!! we can feel it!!!!

Force-Push: yes!!!!! yes, oh, yes! but in an asexual way
Change-Id: I883ad1fb63aa73b753644c9f91bfa46a3d83d2f3

1 files changed, 94 insertions, 34 deletions

diff --git a/transform.e b/transform.e
index e4acd08..35a720c 100644
--- a/transform.e
+++ b/transform.e
@@ -2626,6 +2626,71 @@ allocate-transformation-state s" transformation-state" variable
 : hex-output-metadata-entry-string 2 8 * + ;
 : hex-output-metadata-next-entry 3 8 * + ;
 
+~ (pointer -- boolean)
+: is-in-label-loop-buffer
+  dup
+  transformation-state transformation-state-output-metadata @
+  hex-output-metadata-label-loop-buffer-start @
+  <=
+  swap
+  transformation-state transformation-state-output-metadata @
+  dup hex-output-metadata-label-loop-buffer-start @
+  swap hex-output-metadata-label-loop-buffer-length @ +
+  > && ;
+
+~ (data start, data length, string pointer --)
+: add-hex-output-metadata-entry
+  transformation-state transformation-state-output-metadata @
+  hex-output-metadata-first-entry
+  { dup @ dup { dup 2 pick >= drop } if } {
+    hex-output-metadata-next-entry
+  } while
+  4 roll pack64 3roll pack64 swap pack64 0 pack64
+  drop ;
+
+: add-hex-output-metadata-top-of-file-entries
+  transformation-state transformation-state-output-metadata @
+  dup hex-output-metadata-label-loop-buffer-start @
+  swap hex-output-metadata-first-entry
+  ~ (label buffer start, metadata output point)
+
+  over pack64 ~ Entry data start
+  0 pack64    ~ Entry data length
+  s"   This file is a commented hexadecimal representation of a compiled "
+  pack64      ~ Entry string
+
+  over pack64 ~ Entry data start
+  0 pack64    ~ Entry data length
+  s" program, the output of Evocation's hex transform. The comments are "
+  pack64      ~ Entry string
+
+  over pack64 ~ Entry data start
+  0 pack64    ~ Entry data length
+  s" intended to allow a human reader to audit it. You can convert it to a "
+  pack64      ~ Entry string
+
+  over pack64 ~ Entry data start
+  0 pack64    ~ Entry data length
+  s" runnable executable by piping it through the program named 'hex' and "
+  pack64      ~ Entry string
+
+  over pack64 ~ Entry data start
+  0 pack64    ~ Entry data length
+  s" chmodding the output 755. The difference between a source and a binary "
+  pack64      ~ Entry string
+
+  over pack64 ~ Entry data start
+  0 pack64    ~ Entry data length
+  s" is comments! Enjoy. :)"
+  pack64      ~ Entry string
+
+  over pack64 ~ Entry data start
+  0 pack64    ~ Entry data length
+  s" " pack64 ~ Entry string
+
+  0 pack64    ~ End-of-entries delimiter
+  drop drop ;
+
 : hex-tilde-alternate [ ' ~ entry-to-execution-token , ]
   ; make-immediate
 
@@ -2731,9 +2796,7 @@ allocate-transformation-state s" transformation-state" variable
     transformation-state transformation-state-output-metadata @
     hex-output-metadata-first-entry
     ~ (length remaining, current output address, metadata scan pointer)
-    { dup @ dup { dup 2 pick >= drop } if
-            ~ dup { dup 2 pick >= } if
-    } {
+    { dup @ dup { dup 2 pick >= drop } if } {
       dup @
       2 pick = {
         ~ We found a matching metadata entry.
@@ -2874,15 +2937,35 @@ allocate-transformation-state s" transformation-state" variable
 
   ~   Now we have a bunch of patches that keep track of output metadata. These
   ~ are all Forth words, nothing too complicated about the actual patching.
+  dup s" reset-labels" stringcmp 0 = {
+    create dropstring
+    s" docol" find entry-to-execution-token execute ,
+    make-hidden
+
+    ~   This is only ever called in one place, the end of a failed iteration
+    ~ of label-loop. We need to reinitialize all the metadata entries whenever
+    ~ that happens, and reset-labels is a good semantic match for that
+    ~ behavior, so it's a good place for the hook.
+    ' add-hex-output-metadata-top-of-file-entries entry-to-execution-token ,
+    ~ Fall through to the inner implementation.
+
+    ' ] entry-to-execution-token execute
+    exit
+  } if
+
   dup s" packstring" stringcmp 0 = {
     create dropstring
     s" docol" find entry-to-execution-token execute ,
     make-hidden
 
     ~ (output point, string pointer)
-    ~ TODO DO NOT SUBMIT
-    ~ s" over" find entry-to-execution-token ,
-    ~ ' hex-sys-write-replacement entry-to-execution-token ,
+    s" 2dup" find entry-to-execution-token ,
+    s" dup" find entry-to-execution-token ,
+    s" stringlen" find entry-to-execution-token ,
+    s" 1+" find entry-to-execution-token ,
+    s" swap" find entry-to-execution-token ,
+    ' add-hex-output-metadata-entry entry-to-execution-token ,
+    ~ Fall through to the inner implementation.
 
     ' ] entry-to-execution-token execute
     exit
@@ -2971,6 +3054,7 @@ allocate-transformation-state s" transformation-state" variable
 ~ after.
 : hex-bye-alternate ;
 
+
 ~   Okay, now here's an interesting one. We need to provide additional
 ~ behavior for "allocate", but only when it is called directly from the body
 ~ of label-loop. That condition of being in the body is only testable
@@ -2988,35 +3072,11 @@ allocate-transformation-state s" transformation-state" variable
   transformation-state transformation-state-output-metadata @
   ~ (result pointer, size, metadata pointer)
   2 pick pack64  ~ Label buffer start
-  swap pack64 ~ Label buffer length
-  ~ (result pointer, metadata output point)
-
-  over pack64 ~ Entry data start
-  0 pack64    ~ Entry data length
-  s"   This is a commented hexadecimal representation of a compiled program,"
-  pack64      ~ Entry string
-
-  over pack64 ~ Entry data start
-  0 pack64    ~ Entry data length
-  s" the output of Evocation's hex transform. The comments are intended to"
-  pack64      ~ Entry string
-
-  over pack64 ~ Entry data start
-  0 pack64    ~ Entry data length
-  s" allow a human reader to audit it. The difference between a source and a "
-  pack64      ~ Entry string
-
-  over pack64 ~ Entry data start
-  0 pack64    ~ Entry data length
-  s" binary is comments! Enjoy. :)"
-  pack64      ~ Entry string
-
-  over pack64 ~ Entry data start
-  0 pack64    ~ Entry data length
-  s" " pack64 ~ Entry string
+  swap pack64    ~ Label buffer length
+  drop
+  ~ (result pointer)
 
-  0 pack64    ~ End-of-entries delimiter
-  drop ;
+  add-hex-output-metadata-top-of-file-entries ;
 
 ~ ... then, we define the alternate.
 ~