do some stack walking

this isn't directly useful yet, but it helps build intuitions about what kinds of situations the hex transform needs to be able to annotate

Force-Push: yes
Change-Id: I5607649df2db38eeb17d486d5117b07d0b9d03ef

1 files changed, 61 insertions, 8 deletions

diff --git a/transform.e b/transform.e
index 9637aee..6328e82 100644
--- a/transform.e
+++ b/transform.e
@@ -3244,16 +3244,19 @@ allocate-transformation-state s" transformation-state" variable
   ' ] entry-to-execution-token execute
   ;
 
+
 ~  This word gets installed as a trap at the beginning of every Forth word,
 ~ so that it can examine the control stack and produce kinds of metadata that
 ~ require information that only exists at runtime. See
 ~ hex-semicolon-alterante, below, for details of how it's installed.
 ~
 ~   It is worth noting that hex-trap can coexist with the more-targeted traps
-~ installed by hex-colon-alternate. It runs before them, because
+~ installed by hex-colon-alternate, above. It runs before them, because
 ~ hex-colon-alternate prepends its stuff first and then
-~ hex-semicolon-alternate slides that all forward to prepend some more.
+~ hex-semicolon-alternate slides that all forward to prepend the call to
+~ hex-trace.
 : hex-trace
+  exit
   ~ value@ here @ swap 0 hex-output-metadata-entry-type-line-comment
   ~ add-hex-output-metadata-entry
   newline
@@ -3267,14 +3270,59 @@ allocate-transformation-state s" transformation-state" variable
   ~ transform implementation", above, and make sure it's fresh in your mind.
   ~
   ~   It's important to notice that, as we walk it, the values of "here" and
-  ~ "latest" reflect the log and dictionary of the code being transformed, not
-  ~ the log and dictionary of the outer program. Therefore, we can use
-  ~ containing-entry to find the entry headers. We can't use is-in-log,
-  ~ though, because the output buffer is
-  control@ { dup r0 @ > }
-  { dup @ symbolize-pointer newline 8 + } while
+  ~ "latest" reflect the log and dictionary of the code being transformed, ie.
+  ~ they are the ones in the output buffer, not the log and dictionary of the
+  ~ outer program. Therefore, we can use containing-entry to find the entry
+  ~ headers for words inside the transform, and if we want to look at words
+  ~ outside the transform we can wrap containing-entry in
+  ~ swap-transform-variables. We can't use is-in-log, though, because the
+  ~ label-loop buffer is inside the output buffer, which is inside the outer
+  ~ log, so it doesn't make the distinctions we need it to.
+  ~
+  ~   Every word inside the transform will have hex-transform-one exactly once
+  ~ in its call chain, so we walk the control stack only up to that point.
+  control@
+  { ~   First, check to make sure we haven't run off the bottom of the control
+    ~ stack. Remember, the control stack is an array of pointers, so this is a
+    ~ simple bounds check.
+    dup r0 @ >
+
+    ~   If it is, we also want to look at what it points to.
+    dup {
+      ~   Dereference the pointer we've been iterating (... we're actually
+      ~ looking at a pointer to a pointer ...), and check that it's not inside
+      ~ hex-transform-one's body.
+      drop dup @
+
+      ~   The inner dictionary is inside the outer log, so we'll get an entry
+      ~ header regardless of which dictionary we consider, but it may not be
+      ~ the one we care about. If we want to get the correct entry pointer, we
+      ~ have to make sure we're looking at the outer dictionary.
+      swap-transform-variables
+
+      ~ Check what entry the control pointer is in.
+      containing-entry
+
+      ~   Get the entry for hex-transform-one to compare against.  This would
+      ~ be a forward reference, so we need to look it up at runtime.
+      s" hex-transform-one" find
+
+      ~ Now switch back.
+      swap-transform-variables
+
+      ~ If they're equal, we want to stop the loop.
+      !=
+    } if }
+  { dup @
+
+    symbolize-pointer space
+
+    ~   Iterate to the next pointer in the control stack. It's an array of
+    ~ pointers, so this is just arithmetic.
+    8 + } while
   drop ;
 
+
 ~   We want to trace every call to a Forth word, for use in generating
 ~ metadata. To do this, we want to add a prefix trap to the calls, but we
 ~ can't put the logic in hex-colon-alternate because we don't know which
@@ -3333,6 +3381,7 @@ allocate-transformation-state s" transformation-state" variable
   [ ' ; entry-to-execution-token , ]
   ; make-immediate
 
+
 : hex-semicolon-assembly-alternate
   latest @ entry-to-name
   dup s" sys-write" stringcmp 0 = {
@@ -3354,6 +3403,7 @@ allocate-transformation-state s" transformation-state" variable
   [ ' ;asm entry-to-execution-token , ]
   ; make-immediate
 
+
 ~   Because docol requires it, we provide a special mini-version of the label
 ~ system. We only do L@' and L!', because that's all we need. Unlike with the
 ~ label transform, these are NOT real labels; they're restricted similarly to
@@ -3384,6 +3434,7 @@ allocate-transformation-state s" transformation-state" variable
   transformation-state transformation-state-label-scratch !
   ; make-immediate
 
+
 ~   We have to provide alternates for the globals that are bootstrapped by
 ~ warm-start in normal execution, because code under the hex transform never
 ~ gets its own copy of warm-start. They don't have to do anything special,
@@ -3397,6 +3448,7 @@ 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
@@ -3458,6 +3510,7 @@ allocate-transformation-state s" transformation-state" variable
     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.