X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmCon.hs;h=368bc534838b219d30cc8fc6431eba76b23213ab;hp=452a352bab215c669139c1becd43c31665ba6f65;hb=cbd7463c986d54422de15cb3b56184de116ef7ba;hpb=a02e7f40afc1aab7fe466f949f505c1d7250713d

diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index 452a352..368bc53 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -25,9 +25,9 @@ import StgCmmUtils
 import StgCmmClosure
 import StgCmmProf
 
-import Cmm
+import CmmExpr
 import CLabel
-import MkZipCfgCmm (CmmAGraph, mkNop)
+import MkGraph
 import SMRep
 import CostCentre
 import Module
@@ -39,8 +39,13 @@ import Literal
 import PrelInfo
 import Outputable
 import Util             ( lengthIs )
+
 import Data.Char
 
+#if defined(mingw32_TARGET_OS)
+import StaticFlags	( opt_PIC )
+#endif
+
 
 ---------------------------------------------------------------
 --	Top-level constructors
@@ -147,10 +152,17 @@ work with any old argument, but for @Int@-like ones the argument has
 to be a literal.  Reason: @Char@ like closures have an argument type
 which is guaranteed in range.
 
-Because of this, we use can safely return an addressing mode. -}
+Because of this, we use can safely return an addressing mode. 
+
+We don't support this optimisation when compiling into Windows DLLs yet
+because they don't support cross package data references well.
+-}
 
 buildDynCon binder _cc con [arg]
   | maybeIntLikeCon con 
+#if defined(mingw32_TARGET_OS)
+  , not opt_PIC
+#endif
   , StgLitArg (MachInt val) <- arg
   , val <= fromIntegral mAX_INTLIKE 	-- Comparisons at type Integer!
   , val >= fromIntegral mIN_INTLIKE	-- ...ditto...
@@ -162,7 +174,10 @@ buildDynCon binder _cc con [arg]
 	; return (litIdInfo binder (mkConLFInfo con) intlike_amode, mkNop) }
 
 buildDynCon binder _cc con [arg]
-  | maybeCharLikeCon con 
+  | maybeCharLikeCon con
+#if defined(mingw32_TARGET_OS)
+  , not opt_PIC
+#endif
   , StgLitArg (MachChar val) <- arg
   , let val_int = ord val :: Int
   , val_int <= mAX_CHARLIKE
@@ -178,7 +193,7 @@ buildDynCon binder ccs con args
   = do	{ let (cl_info, args_w_offsets) = layOutDynConstr con (addArgReps args)
 		-- No void args in args_w_offsets
 	; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets
- 	; return (regIdInfo binder lf_info tmp, init) }
+	; regIdInfo binder lf_info tmp init }
   where
     lf_info = mkConLFInfo con