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

7 files changed, 15 insertions, 12 deletions

diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 226d3a1138..498fded724 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -388,7 +388,7 @@ cafTransfers contLbls entry topLbl
           case expr of
               CmmLit (CmmLabel c) -> add c set
               CmmLit (CmmLabelOff c _) -> add c set
-              CmmLit (CmmLabelDiffOff c1 c2 _) -> add c1 $! add c2 set
+              CmmLit (CmmLabelDiffOff c1 c2 _ _) -> add c1 $! add c2 set
               _ -> set
         add l s | hasCAF l  = Set.insert (mkCAFLabel l) s
                 | otherwise = s
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index c91d553c47..fc4fcabcc3 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -169,7 +169,7 @@ hash_block block =
         hash_lit (CmmVec ls) = hash_list hash_lit ls
         hash_lit (CmmLabel _) = 119 -- ugh
         hash_lit (CmmLabelOff _ i) = cvt $ 199 + i
-        hash_lit (CmmLabelDiffOff _ _ i) = cvt $ 299 + i
+        hash_lit (CmmLabelDiffOff _ _ i _) = cvt $ 299 + i
         hash_lit (CmmBlock _) = 191 -- ugh
         hash_lit (CmmHighStackMark) = cvt 313
 
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 946e146f9e..80ca1b1ef2 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -188,7 +188,10 @@ data CmmLit
         -- Don't use it at all unless tablesNextToCode.
         -- It is also used inside the NCG during when generating
         -- position-independent code.
-  | CmmLabelDiffOff CLabel CLabel Int   -- label1 - label2 + offset
+  | CmmLabelDiffOff CLabel CLabel Int Width -- label1 - label2 + offset
+        -- The supported Widths depend on the architecture.  wordWidth
+        -- is supported on all architectures. Additionally W32 is
+        -- supported on x86_64 when using the small memory model.
 
   | CmmBlock {-# UNPACK #-} !BlockId     -- Code label
         -- Invariant: must be a continuation BlockId
@@ -221,7 +224,7 @@ cmmLitType cflags (CmmVec (l:ls))      = let ty = cmmLitType cflags l
                                             else panic "cmmLitType: CmmVec"
 cmmLitType dflags (CmmLabel lbl)       = cmmLabelType dflags lbl
 cmmLitType dflags (CmmLabelOff lbl _)  = cmmLabelType dflags lbl
-cmmLitType dflags (CmmLabelDiffOff {}) = bWord dflags
+cmmLitType dflags (CmmLabelDiffOff _ _ _ width) = cmmBits width
 cmmLitType dflags (CmmBlock _)         = bWord dflags
 cmmLitType dflags (CmmHighStackMark)   = bWord dflags
 
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 20e8858ba8..ea7923264f 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -291,10 +291,10 @@ makeRelativeRefTo :: DynFlags -> CLabel -> CmmLit -> CmmLit
 
 makeRelativeRefTo dflags info_lbl (CmmLabel lbl)
   | tablesNextToCode dflags
-  = CmmLabelDiffOff lbl info_lbl 0
+  = CmmLabelDiffOff lbl info_lbl 0 (wordWidth dflags)
 makeRelativeRefTo dflags info_lbl (CmmLabelOff lbl off)
   | tablesNextToCode dflags
-  = CmmLabelDiffOff lbl info_lbl off
+  = CmmLabelDiffOff lbl info_lbl off (wordWidth dflags)
 makeRelativeRefTo _ _ lit = lit
 
 
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 53dbcddfbb..1ae5526074 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -253,8 +253,8 @@ cmmRegOff reg byte_off = CmmRegOff reg byte_off
 cmmOffsetLit :: CmmLit -> Int -> CmmLit
 cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff l byte_off
 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
-cmmOffsetLit (CmmLabelDiffOff l1 l2 m) byte_off
-                                        = CmmLabelDiffOff l1 l2 (m+byte_off)
+cmmOffsetLit (CmmLabelDiffOff l1 l2 m w) byte_off
+                                        = CmmLabelDiffOff l1 l2 (m+byte_off) w
 cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep
 cmmOffsetLit _                 byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
 
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 1e50c8591b..f3f9d3c0b3 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -495,7 +495,7 @@ pprLit lit = case lit of
     CmmHighStackMark   -> panic "PprC printing high stack mark"
     CmmLabel clbl      -> mkW_ <> pprCLabelAddr clbl
     CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i
-    CmmLabelDiffOff clbl1 _ i
+    CmmLabelDiffOff clbl1 _ i _   -- non-word widths not supported via C
         -- WARNING:
         --  * the lit must occur in the info table clbl2
         --  * clbl1 must be an SRT, a slow entry point or a large bitmap
@@ -506,7 +506,7 @@ pprLit lit = case lit of
 
 pprLit1 :: CmmLit -> SDoc
 pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
-pprLit1 lit@(CmmLabelDiffOff _ _ _) = parens (pprLit lit)
+pprLit1 lit@(CmmLabelDiffOff _ _ _ _) = parens (pprLit lit)
 pprLit1 lit@(CmmFloat _ _)    = parens (pprLit lit)
 pprLit1 other = pprLit other
 
@@ -1083,7 +1083,7 @@ te_BB block = mapM_ te_Stmt (blockToList mid) >> te_Stmt last
 te_Lit :: CmmLit -> TE ()
 te_Lit (CmmLabel l) = te_lbl l
 te_Lit (CmmLabelOff l _) = te_lbl l
-te_Lit (CmmLabelDiffOff l1 _ _) = te_lbl l1
+te_Lit (CmmLabelDiffOff l1 _ _ _) = te_lbl l1
 te_Lit _ = return ()
 
 te_Stmt :: CmmNode e x -> TE ()
diff --git a/compiler/cmm/PprCmmExpr.hs b/compiler/cmm/PprCmmExpr.hs
index fa1124c26c..4538556ea2 100644
--- a/compiler/cmm/PprCmmExpr.hs
+++ b/compiler/cmm/PprCmmExpr.hs
@@ -198,7 +198,7 @@ pprLit lit = sdocWithDynFlags $ \dflags ->
     CmmVec lits        -> char '<' <> commafy (map pprLit lits) <> char '>'
     CmmLabel clbl      -> ppr clbl
     CmmLabelOff clbl i -> ppr clbl <> ppr_offset i
-    CmmLabelDiffOff clbl1 clbl2 i -> ppr clbl1 <> char '-'
+    CmmLabelDiffOff clbl1 clbl2 i _ -> ppr clbl1 <> char '-'
                                   <> ppr clbl2 <> ppr_offset i
     CmmBlock id        -> ppr id
     CmmHighStackMark -> text "<highSp>"