hex transform of packalign now implemented

hex.e doesn't actually call packalign, so this was tested by temporarily modifying it to do so (not checked in)

Force-Push: yes
Change-Id: Ie266c3bda6e65e055da5d88acfe248d6487ab6cc

1 files changed, 70 insertions, 0 deletions

diff --git a/transform.e b/transform.e
index 69e7d05..26f4adb 100644
--- a/transform.e
+++ b/transform.e
@@ -2629,6 +2629,7 @@ allocate-transformation-state s" transformation-state" variable
 : hex-output-metadata-entry-type-line-comment 0 ;
 : hex-output-metadata-entry-type-line-break 1 ;
 : hex-output-metadata-entry-type-string-literal 2 ;
+: hex-output-metadata-entry-type-alignment 3 ;
 
 ~   Initialize the contents of the output metadata to all zeroes. This is
 ~ called from hex-transform at its top level, at the very start, to make sure
@@ -2858,6 +2859,15 @@ allocate-transformation-state s" transformation-state" variable
           0x22 value@ emitstring drop
           newline
         } if
+
+        dup hex-output-metadata-entry-type @
+        hex-output-metadata-entry-type-alignment = {
+          newline
+          ." ~ Alignment padding to width "
+          dup hex-output-metadata-entry-string @ .
+          newline
+        } if
+
       } if
       hex-output-metadata-next-entry
     } while
@@ -3030,6 +3040,66 @@ allocate-transformation-state s" transformation-state" variable
     exit
   } if
 
+  dup s" packalign" stringcmp 0 = {
+    create dropstring
+    s" docol" find entry-to-execution-token execute ,
+    make-hidden
+
+    ~ (output point, alignment byte count)
+    s" 2dup" find entry-to-execution-token ,
+
+    ~   We can't use unpackalign because this patch happens at the time
+    ~ packalign is being defined, and it would be a forward reference. We do
+    ~ the equivalent by hand.
+    s" dup" find entry-to-execution-token ,
+    s" 3unroll" find entry-to-execution-token ,
+    s" dup" find entry-to-execution-token ,
+    s" 3unroll" find entry-to-execution-token ,
+    s" 1-" find entry-to-execution-token ,
+    s" +" find entry-to-execution-token ,
+    s" swap" find entry-to-execution-token ,
+    s" /%" find entry-to-execution-token ,
+    s" swap" find entry-to-execution-token ,
+    s" drop" find entry-to-execution-token ,
+    s" *" find entry-to-execution-token ,
+    ~ (output point, alignment byte count, padding end)
+
+    ~ We can't use pick, either.
+    s" 3roll" find entry-to-execution-token ,
+    s" dup" find entry-to-execution-token ,
+    s" dup" find entry-to-execution-token ,
+    s" lit" find entry-to-execution-token ,
+    5 ,
+    s" unroll" find entry-to-execution-token ,
+    ~ (output point, alignment byte count, padding end, output point,
+    ~  output point)
+
+    s" 3unroll" find entry-to-execution-token ,
+    s" -" find entry-to-execution-token ,
+    ~ (output point, alignment byte count, padding start, padding length)
+
+    ' hex-output-metadata-entry-type-alignment entry-to-execution-token ,
+    ~ (output point, alignment byte count, padding start, padding length,,
+    ~  entry type)
+
+    ~ Again, no pick.
+    s" lit" find entry-to-execution-token ,
+    4 ,
+    s" roll" find entry-to-execution-token ,
+    s" dup" find entry-to-execution-token ,
+    s" lit" find entry-to-execution-token ,
+    5 ,
+    s" unroll" find entry-to-execution-token ,
+
+    ~ (output point, alignment byte count, padding start, padding length,
+    ~  entry type, alignment byte count)
+    ' add-hex-output-metadata-entry entry-to-execution-token ,
+    ~ (output point, alignment byte count)
+    ~ Fall through to the inner implementation.
+
+    ' ] entry-to-execution-token execute
+    exit
+  } if
 
   ~   If no special case matches, we fall back to just being a regular colon.
   ~ We already read the word name above, so we have to do the rest of the