Allow CmmLabelDiffOff with different widths

Summary:
This change makes it possible to generate a static 32-bit relative label
offset on x86_64. Currently we can only generate word-sized label
offsets.

This will be used in D4634 to shrink info tables.  See D4632 for more
details.

Test Plan: See D4632

Reviewers: bgamari, niteria, michalt, erikd, jrtc27, osa1

Subscribers: thomie, carter

Differential Revision: https://phabricator.haskell.org/D4633

3 files changed, 18 insertions, 8 deletions

diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 87111499fc..bc7bbaab1b 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -154,6 +154,7 @@ data LlvmStatic
   -- static expressions, could split out but leave
   -- for moment for ease of use. Not many of them.
 
+  | LMTrunc LlvmStatic LlvmType        -- ^ Truncate
   | LMBitc LlvmStatic LlvmType         -- ^ Pointer to Pointer conversion
   | LMPtoI LlvmStatic LlvmType         -- ^ Pointer to Integer conversion
   | LMAdd LlvmStatic LlvmStatic        -- ^ Constant addition operation
@@ -167,6 +168,8 @@ instance Outputable LlvmStatic where
   ppr (LMStaticArray d t) = ppr t <> text " [" <> ppCommaJoin d <> char ']'
   ppr (LMStaticStruc d t) = ppr t <> text "<{" <> ppCommaJoin d <> text "}>"
   ppr (LMStaticPointer v) = ppr v
+  ppr (LMTrunc v t)
+      = ppr t <> text " trunc (" <> ppr v <> text " to " <> ppr t <> char ')'
   ppr (LMBitc v t)
       = ppr t <> text " bitcast (" <> ppr v <> text " to " <> ppr t <> char ')'
   ppr (LMPtoI v t)
@@ -277,6 +280,7 @@ getStatType (LMStaticStr   _ t) = t
 getStatType (LMStaticArray _ t) = t
 getStatType (LMStaticStruc _ t) = t
 getStatType (LMStaticPointer v) = getVarType v
+getStatType (LMTrunc       _ t) = t
 getStatType (LMBitc        _ t) = t
 getStatType (LMPtoI        _ t) = t
 getStatType (LMAdd         t _) = getStatType t
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 9be0876e21..678fffa4c1 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -1721,7 +1721,7 @@ genLit opt (CmmLabelOff label off) = do
     (v1, s1) <- doExpr (getVarType vlbl) $ LlvmOp LM_MO_Add vlbl voff
     return (v1, stmts `snocOL` s1, stat)
 
-genLit opt (CmmLabelDiffOff l1 l2 off) = do
+genLit opt (CmmLabelDiffOff l1 l2 off w) = do
     dflags <- getDynFlags
     (vl1, stmts1, stat1) <- genLit opt (CmmLabel l1)
     (vl2, stmts2, stat2) <- genLit opt (CmmLabel l2)
@@ -1730,13 +1730,17 @@ genLit opt (CmmLabelDiffOff l1 l2 off) = do
     let ty2 = getVarType vl2
     if (isInt ty1) && (isInt ty2)
        && (llvmWidthInBits dflags ty1 == llvmWidthInBits dflags ty2)
-
        then do
             (v1, s1) <- doExpr (getVarType vl1) $ LlvmOp LM_MO_Sub vl1 vl2
             (v2, s2) <- doExpr (getVarType v1 ) $ LlvmOp LM_MO_Add v1 voff
-            return (v2, stmts1 `appOL` stmts2 `snocOL` s1 `snocOL` s2,
-                        stat1 ++ stat2)
-
+            let ty = widthToLlvmInt w
+            let stmts = stmts1 `appOL` stmts2 `snocOL` s1 `snocOL` s2
+            if w /= wordWidth dflags
+              then do
+                (v3, s3) <- doExpr ty $ Cast LM_Trunc v2 ty
+                return (v3, stmts `snocOL` s3, stat1 ++ stat2)
+              else
+                return (v2, stmts, stat1 ++ stat2)
         else
             panic "genLit: CmmLabelDiffOff encountered with different label ty!"
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 89b8fe7013..36d51e9e18 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -148,12 +148,14 @@ genStaticLit (CmmLabelOff label off) = do
     let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
     return $ LMAdd var offset
 
-genStaticLit (CmmLabelDiffOff l1 l2 off) = do
+genStaticLit (CmmLabelDiffOff l1 l2 off w) = do
     dflags <- getDynFlags
     var1 <- genStaticLit (CmmLabel l1)
     var2 <- genStaticLit (CmmLabel l2)
-    let var = LMSub var1 var2
-        offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
+    let var
+          | w == wordWidth dflags = LMSub var1 var2
+          | otherwise = LMTrunc (LMSub var1 var2) (widthToLlvmInt w)
+        offset = LMStaticLit $ LMIntLit (toInteger off) (LMInt $ widthInBits w)
     return $ LMAdd var offset
 
 genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b