From 7fbdd9e0bccec89c958e2a1e36d5ec058fc69a3d Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Tue, 9 Dec 2008 10:55:15 +0000
Subject: [PATCH] Fix #2838: we should narrow a CmmInt before converting to
 ImmInteger

---
 compiler/cmm/CmmExpr.hs         |   19 +++++++++++++++++++
 compiler/cmm/CmmOpt.hs          |   17 -----------------
 compiler/nativeGen/MachRegs.lhs |    5 ++++-
 3 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index db42564..8e40654 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -10,6 +10,7 @@ module CmmExpr
     , Width(..)
     , widthInBits, widthInBytes, widthInLog, widthFromBytes
     , wordWidth, halfWordWidth, cIntWidth, cLongWidth
+    , narrowU, narrowS
  
     , CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
     , CmmReg(..), cmmRegType
@@ -55,6 +56,9 @@ import Panic
 import Unique
 import UniqSet
 
+import Data.Word
+import Data.Int
+
 -----------------------------------------------------------------------------
 --		CmmExpr
 -- An expression.  Expressions have no side effects.
@@ -636,6 +640,21 @@ widthInLog W64  = 3
 widthInLog W128 = 4
 widthInLog W80  = panic "widthInLog: F80"
 
+-- widening / narrowing
+
+narrowU :: Width -> Integer -> Integer
+narrowU W8  x = fromIntegral (fromIntegral x :: Word8)
+narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
+narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
+narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
+narrowU _ _ = panic "narrowTo"
+
+narrowS :: Width -> Integer -> Integer
+narrowS W8  x = fromIntegral (fromIntegral x :: Int8)
+narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
+narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
+narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
+narrowS _ _ = panic "narrowTo"
 
 -----------------------------------------------------------------------------
 --    		MachOp
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 148e3da..8326a48 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -500,23 +500,6 @@ exactLog2 x_
 
 
 -- -----------------------------------------------------------------------------
--- widening / narrowing
-
-narrowU :: Width -> Integer -> Integer
-narrowU W8  x = fromIntegral (fromIntegral x :: Word8)
-narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
-narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
-narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
-narrowU _ _ = panic "narrowTo"
-
-narrowS :: Width -> Integer -> Integer
-narrowS W8  x = fromIntegral (fromIntegral x :: Int8)
-narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
-narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
-narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
-narrowS _ _ = panic "narrowTo"
-
--- -----------------------------------------------------------------------------
 -- Loopify for C
 
 {-
diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs
index 9699a11..0c21f21 100644
--- a/compiler/nativeGen/MachRegs.lhs
+++ b/compiler/nativeGen/MachRegs.lhs
@@ -229,7 +229,10 @@ data Imm
 strImmLit s = ImmLit (text s)
 
 litToImm :: CmmLit -> Imm
-litToImm (CmmInt i _)        = ImmInteger i
+litToImm (CmmInt i w)        = ImmInteger (narrowS w i)
+                -- narrow to the width: a CmmInt might be out of
+                -- range, but we assume that ImmInteger only contains
+                -- in-range values.  A signed value should be fine here.
 litToImm (CmmFloat f W32)    = ImmFloat f
 litToImm (CmmFloat f W64)    = ImmDouble f
 litToImm (CmmLabel l)        = ImmCLbl l
-- 
1.7.10.4