handle memory sliding in the hex transform

wow!!!! that was big

Force-Push: yes
Change-Id: I504ae746d4424e46819357e6dad6d6eadec16b81

1 files changed, 139 insertions, 2 deletions

diff --git a/transform.e b/transform.e
index c98871b..fc88992 100644
--- a/transform.e
+++ b/transform.e
@@ -4269,6 +4269,68 @@ allocate-transformation-state s" transformation-state" variable
   hex-output-metadata-entry-type-string-literal swap
   add-hex-output-metadata-entry ;
 
+~   The purpose of this word is to make sure that the memory-sliding
+~ techniques used by the high-level flow control words are appropriately
+~ reflected in the output metadata. This is accomplished by finding all
+~ entries whose data start pointer or string content pointer is within the
+~ slid region, and adjusting the relevant pointer appropriately.
+~
+~   Notice that this strategy means there's no metadata entry describing the
+~ old location of the slid memory, though sliding is non-destructive. The
+~ assumption is that that location is going to be overwritten with new code,
+~ which will have its own metadata entries created as the new code is written.
+~ Otherwise, since we don't do anything to erase metadata entries pertaining
+~ to overwritten locations, old and new metadata entries would overlap and
+~ cause confusion. The assumption is correct for all existing uses of
+~ memory-sliding as of the time this was written, but it's possible it will
+~ need to be revisited someday.
+~
+~   This word is called for both memcopy and memmove. It's called by
+~ hex-memory-slide-replacement, which is itself installed by a variety of
+~ means for different situations; see its documentation for more detail.
+~
+~ (source, destination, length --)
+: hex-memory-slide-trace
+  2 pick is-in-label-loop-buffer
+  2 pick is-in-label-loop-buffer &&
+  {
+    ~   At the time this runs, the metadata entry array isn't sorted, so we
+    ~ check the whole thing.
+    transformation-state transformation-state-output-metadata @
+    hex-output-metadata-first-entry
+    ~ (source, destination, length, initial metadata scan pointer)
+    { dup @ } {
+      ~ (source, destination, length, metadata scan pointer)
+
+      dup hex-output-metadata-entry-data-start @ 4 pick <=
+      ~ (source, destination, length, metadata scan pointer, lower bound okay)
+      over hex-output-metadata-entry-data-start @ 5 pick 4 pick + >
+      && {
+        ~ (source, destination, length, metadata scan pointer)
+        dup hex-output-metadata-entry-data-start @ 4 pick - 3 pick +
+        over hex-output-metadata-entry-data-start !
+      } if
+
+      dup hex-output-metadata-entry-type @
+      dup hex-output-metadata-entry-type-string-literal =
+      swap hex-output-metadata-entry-type-raw-string-literal = || {
+        dup hex-output-metadata-entry-content @
+        ~ (source, destination, length, scan pointer, content pointer)
+        dup 5 pick <=
+        ~ (source, destination, length, scan pointer, content pointer,
+        ~  lower bound okay)
+        over 6 pick 5 pick + > && {
+          ~ (source, destination, length, scan pointer, content pointer)
+          4 pick - 3 pick +
+          over hex-output-metadata-entry-content !
+        } { drop } if-else
+      } if
+
+      hex-output-metadata-next-entry
+    } while 4 ndrop
+  } { drop drop drop } if-else ;
+
+
 ~   By overriding colon, we can special-case the definitions of particular
 ~ words. It's very metacircular.
 ~
@@ -4870,6 +4932,60 @@ allocate-transformation-state s" transformation-state" variable
   } if-else ; make-immediate
 
 
+~   In order to handle code that slides compiled code around, most notably the
+~ high-level flow-control words, we trap memcopy and memmove. These are
+~ assembly words, so trapping them with hex-colon-alternate is inconvenient;
+~ instead we patch their callers. This is like the "allocate" trap, but
+~ simpler. There's no special logic needed here, we just unconditionally
+~ install the trap.
+~
+~   This word is responsible for processing the hook. For code running
+~ directly under the hex transform, it's installed by hex-memcopy-alternate
+~ and hex-memmove-alternate, immediately below. For code running in a nested
+~ label transform, see hex-label-word-replacement, further down. Note
+~ carefully that when it's in a nested transform, the hook only runs in
+~ immediate mode; running it in compile mode would affect the program being
+~ compiled.
+~
+~   It is worth noting that, as of the time this code was written, there is
+~ never actually any memory sliding of compiled code that occurs outside of a
+~ nested transform. This aligns with intuition, since sliding is really only
+~ done in the high-level flow-control words. However, should it happen in the
+~ future, we still want it to work, so it's implemented.
+~
+~   The actual metadata handling is done by hex-memory-slide-trace, which is
+~ above, near the other words that trace memory operations. We let the
+~ replacement handle preserving the parameters so that the trace doesn't need
+~ to, since that would be a difference between it and the other words similar
+~ to it.
+~
+~ (source, destination, length -- source, destination, length)
+: hex-memory-slide-replacement
+  2 pick 2 pick 2 pick hex-memory-slide-trace ;
+
+~   These two alternates are responsible for installing
+~ hex-memory-slide-replacement, immediately above, in invocations of memcopy
+~ and memmove that occur directly under the hex transform. For invocations
+~ that occur in nested transforms, see hex-label-word-replacement, further
+~ down.
+: hex-memcopy-alternate
+  interpreter-flags @ 0x01 & {
+    ' hex-memory-slide-replacement entry-to-execution-token ,
+    s" memcopy" find entry-to-execution-token ,
+  } {
+    hex-memory-slide-replacement
+    s" memcopy" find entry-to-execution-token execute
+  } if-else ; make-immediate
+: hex-memmove-alternate
+  interpreter-flags @ 0x01 & {
+    ' hex-memory-slide-replacement entry-to-execution-token ,
+    s" memmove" find entry-to-execution-token ,
+  } {
+    hex-memory-slide-replacement
+    s" memmove" find entry-to-execution-token execute
+  } if-else ; make-immediate
+
+
 ~   Similar to how we handle "allocate" as a replacement which is installed by
 ~ an alternate, we do the same for tilde, but for a different reason. The
 ~ semantics of ordinary, non-transformed tilde skip over comment text while
@@ -5349,8 +5465,15 @@ allocate-transformation-state s" transformation-state" variable
 ~ performing substantive changes to the label transform's behavior, as
 ~ required by the hex transform.
 ~
-~   Most notably, it calls hex-label-tilde-alternate any time a tilde is
-~ encountered as a word. It also calls hex-skip-space before reading a word.
+~   The most important changes to the base language that this word makes are
+~ to call hex-label-tilde-alternate any time a tilde is encountered as a word,
+~ and to call hex-skip-space before reading a word.
+~
+~   This word is also responsible for invoking hex-memory-slide-replacement
+~ when memcopy or memmove are encountered in immediate mode. Note that this
+~ really pushes right up against the limit of what it's possible for a
+~ transform to do without altering the compilation's output; invoking the
+~ replacement in compile mode would do so.
 : hex-label-word-replacement
   hex-skip-space
   word
@@ -5367,6 +5490,18 @@ allocate-transformation-state s" transformation-state" variable
     0
     2 nexit
   } if
+  dup s" memcopy" stringcmp 0 = {
+    interpreter-flags @ 0x01 & not {
+      drop hex-memory-slide-replacement exit
+      ~ Fall through, returning control to label-transform-one.
+    } if
+  } if
+  dup s" memmove" stringcmp 0 = {
+    interpreter-flags @ 0x01 & not {
+      drop hex-memory-slide-replacement exit
+      ~ Fall through, returning control to label-transform-one.
+    } if
+  } if
   drop ;
 
 
@@ -5474,6 +5609,8 @@ allocate-transformation-state s" transformation-state" variable
   dup s" bye" stringcmp 0 = { swap drop ' hex-bye-alternate swap } if
   dup s" allocate" stringcmp 0 = {
     swap drop ' hex-allocate-alternate swap } if
+  dup s" memcopy" stringcmp 0 = { swap drop ' hex-memcopy-alternate swap } if
+  dup s" memmove" stringcmp 0 = { swap drop ' hex-memmove-alternate swap } if
   dup s" word" stringcmp 0 = { swap drop ' hex-word-alternate swap } if
   dup s" ~" stringcmp 0 = { swap drop ' hex-tilde-alternate swap } if
   ~ (name as stack string, 0 or alternate entry pointer, name pointer)