add a metadata structure for the hex transform

the structure will eventually be populated from a few places, but for now, the proof-of-concept installs a complex hook that runs only on the call to "allocate" done at the top of "label-loop".

the comment output code works: the metadata entries are output in the appropriate places in the dump! yay

Force-Push: yes
Change-Id: I15f20241e84b535c8407f9a190b22c9cb85227e6

1 files changed, 123 insertions, 9 deletions

diff --git a/transform.e b/transform.e
index ddf3208..61cc4e0 100644
--- a/transform.e
+++ b/transform.e
@@ -286,14 +286,16 @@
 : transformation-state-user-stack-depth 3 8 * + ;
 : transformation-state-label-scratch 4 8 * + ;
 : transformation-state-delimiter 5 8 * + ;
+: transformation-state-output-metadata 6 8 * + ;
 : allocate-transformation-state
-  6 8 * allocate
+  7 8 * allocate
   dup transformation-state-saved-here 0 swap !
   dup transformation-state-saved-latest 0 swap !
   dup transformation-state-output-buffer-start 0 swap !
   dup transformation-state-user-stack-depth 0 swap !
   dup transformation-state-label-scratch 0 swap !
-  dup transformation-state-delimiter 0 swap ! ;
+  dup transformation-state-delimiter 0 swap !
+  dup transformation-state-output-metadata 0 swap ! ;
 allocate-transformation-state s" transformation-state" variable
 
 
@@ -2706,6 +2708,25 @@ allocate-transformation-state s" transformation-state" variable
 ~ (length to write, base address --)
 : hex-sys-write-replacement
   { over } {
+    ~   The output metadata is an array of structs in the format: referenced
+    ~ data pointer; referenced data length; string pointer. It ends with a
+    ~ value of 0 where the referenced data pointer would be.
+    transformation-state transformation-state-output-metadata @
+    ~ (length remaining, current output address, metadata scan pointer)
+    { dup @ dup { dup 2 pick >= drop } if
+            ~ dup { dup 2 pick >= } if
+    } {
+      dup @
+      2 pick = {
+        ~ We found a matching metadata entry.
+        ~ (length remaining, current output address, metadata scan pointer)
+
+        dup 2 8 * + @ ." ~ " emitstring newline
+      } if
+      3 8 * +
+    } while
+    drop
+
     dup 8@ .hex8 space
     1+ swap 1- swap
   } while ;
@@ -2909,6 +2930,84 @@ allocate-transformation-state s" transformation-state" variable
 : hex-latest-alternate latest ;
 : hex-here-alternate here ;
 
+~   The code we're compiling may try to exit when it's done. We want to return
+~ to our caller instead; we turn that into an nop. This isn't quite correct,
+~ but it will work as long as the inner code doesn't try to do anything else
+~ 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
+~ immediately, though "allocate" is not an immediate word and the effect of it
+~ needs to happen later. This is crucial functionality that we can't work
+~ without. So, we use a replacement and an alternate that work in tandem.
+~
+~   First, we define the replacement...
+~
+~ (size -- pointer)
+: hex-allocate-replacement
+  allocate
+
+  transformation-state transformation-state-output-metadata @
+  ~ (result pointer, metadata output point)
+
+  over pack64
+  0 pack64
+  s"   This is a commented hexadecimal representation of a compiled program,"
+  pack64
+
+  over pack64
+  0 pack64
+  s" the output of Evocation's hex transform. The comments are intended to"
+  pack64
+
+  over pack64
+  0 pack64
+  s" allow a human reader to audit it. The difference between a source and a "
+  pack64
+
+  over pack64
+  0 pack64
+  s" binary is comments! Enjoy. :)"
+  pack64
+
+  over pack64
+  0 pack64
+  s" " pack64
+
+  0 pack64
+  drop ;
+
+~ ... then, we define the alternate.
+~
+~   The alternate is flagged as immediate, which means hex-transform-one will
+~ treat it as always having the highest priority. It checks what mode we're
+~ in; if we're immediate, it runs the inner "allocate" if it exists or the
+~ outer one if not. If we're compiling, it checks if we're in the body of
+~ label-loop and compiles an execution token for the replacement if so, or the
+~ inner "allocate" if not.
+~
+~   If that was confusing: The point is, by having the immediate effect be
+~ compilation, we get to have it both ways.
+: hex-allocate-alternate
+  interpreter-flags @ 0x01 & {
+    ~ Compile mode.
+    latest @ entry-to-name dup s" label-loop" stringcmp 0 = {
+      ~ In label-loop.
+      drop
+      ' hex-allocate-replacement entry-to-execution-token ,
+    } {
+      ~ Not in label-loop.
+      drop
+      s" allocate" find entry-to-execution-token ,
+    } if-else
+  } {
+    ~ Immediate mode.
+    s" allocate" find
+    dup { entry-to-execution-token execute } { drop allocate } if-else
+  } if-else ; make-immediate
+
 ~   This implements the hex transform for a single word. It is directly
 ~ analogous to "interpret", and reading interpret.e may help in understanding
 ~ it, though it's meant to still make sense on its own.
@@ -2981,6 +3080,9 @@ allocate-transformation-state s" transformation-state" variable
   dup s" r0" stringcmp 0 = { swap drop ' hex-r0-alternate swap } if
   dup s" latest" stringcmp 0 = { swap drop ' hex-latest-alternate swap } if
   dup s" here" stringcmp 0 = { swap drop ' hex-here-alternate swap } if
+  dup s" bye" stringcmp 0 = { swap drop ' hex-bye-alternate swap } if
+  dup s" allocate" stringcmp 0 = {
+    swap drop ' hex-allocate-alternate swap } if
   ~ (name as stack string, 0 or alternate entry pointer, name pointer)
 
   find
@@ -3124,11 +3226,14 @@ allocate-transformation-state s" transformation-state" variable
 ~ an input string. It is directly analogous to "quit", in interpret.e, but is
 ~ more complex.
 ~
-~ (output buffer start, output point, input string pointer, delimiter pointer
+~ (comment buffer start, output buffer start, output point,
+~  input string pointer, delimiter pointer
 ~  -- output buffer start, output point)
 : hex-transform
   main-input-buffer dup push-input-buffer
   3roll attach-string-to-input-buffer
+  ~ (comment buffer start, output buffer start, output point,
+  ~  delimiter pointer)
 
   ~   Save the old values of "here" and "latest", and set the initial values
   ~ of the internal ones. These values need to persist across iterations,
@@ -3136,17 +3241,26 @@ allocate-transformation-state s" transformation-state" variable
   ~ updates having taken effect. So we do the swap just once, here outside the
   ~ loop, and set it back when the loop ends.
   ~
-  ~   We also take this opportunity to initialize the output-buffer-start and
-  ~ user-stack-depth fields of transformation-state.
+  ~   We also take this opportunity to initialize the other fields of
+  ~ transformation-state. While it might be nice to do these in some sort of
+  ~ logical order, it gets unreadable quickly, so we initialize them in the
+  ~ most convenient order given how we received our parameters.
   here @ transformation-state transformation-state-saved-here !
   latest @ transformation-state transformation-state-saved-latest !
-  2 pick transformation-state transformation-state-output-buffer-start !
-  0 transformation-state transformation-state-user-stack-depth !
-  swap here !
-  0 latest !
   transformation-state transformation-state-delimiter !
+  here !
+  0 latest !
+  transformation-state transformation-state-output-buffer-start !
+  0 transformation-state transformation-state-user-stack-depth !
+  transformation-state transformation-state-output-metadata !
   ~ Now the stack has nothing of ours on it, so client code can do its thing.
 
+  ~   Initialize the contents of the output metadata. See
+  ~ hex-sys-write-replacement for more notes on its format.
+  transformation-state transformation-state-output-metadata @
+  0 pack64
+  drop
+
   ~   It's important that the stack has nothing of ours on it that persists
   ~ across iterations, so that client code can add and remove stuff there as
   ~ it sees fit.