Remove CPP from nativeGen/RegAlloc/Graph/TrivColorable.hs

[ghc-hetmet.git] / compiler / codeGen / CgCon.lhs

diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index a700ccd..8768008 100644 (file)
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -32,8 +32,8 @@ import CgTicky
 import CgInfoTbls
 import CLabel
 import ClosureInfo
-import CmmUtils
-import Cmm
+import OldCmmUtils
+import OldCmm
 import SMRep
 import CostCentre
 import Constants
@@ -46,7 +46,9 @@ import PrelInfo
 import Outputable
 import ListSetOps
 import Util
+import Module
 import FastString
+import StaticFlags
 \end{code}
 
 
@@ -163,13 +165,21 @@ which is guaranteed in range.
 
 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.
+
 \begin{code}
+
+
 buildDynCon binder _ con [arg_amode]
   | maybeIntLikeCon con 
+#if defined(mingw32_TARGET_OS)
+  , not opt_PIC
+#endif
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
   , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
-  = do         { let intlike_lbl   = mkRtsGcPtrLabel (sLit "stg_INTLIKE_closure")
+  = do         { let intlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
              offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
                -- INTLIKE closures consist of a header and one word payload
              intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
@@ -177,14 +187,18 @@ buildDynCon binder _ con [arg_amode]
 
 buildDynCon binder _ con [arg_amode]
   | maybeCharLikeCon con 
+#if defined(mingw32_TARGET_OS)
+  , not opt_PIC
+#endif
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
   , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
-  = do         { let charlike_lbl   = mkRtsGcPtrLabel (sLit "stg_CHARLIKE_closure")
+  = do         { let charlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
              offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
                -- CHARLIKE closures consist of a header and one word payload
              charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
        ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
+
 \end{code}
 
 Now the general case.
@@ -296,6 +310,11 @@ sure the @amodes@ passed don't conflict with each other.
 cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
 
 cgReturnDataCon con amodes
+  | isUnboxedTupleCon con = returnUnboxedTuple amodes
+      -- when profiling we can't shortcut here, we have to enter the closure
+      -- for it to be marked as "used" for LDV profiling.
+  | opt_SccProfilingOn    = build_it_then enter_it
+  | otherwise
   = ASSERT( amodes `lengthIs` dataConRepArity con )
     do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
        ; case sequel of
@@ -319,11 +338,12 @@ cgReturnDataCon con amodes
                        | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
                        | otherwise         -> build_it_then (jump_to deflt_lbl) }
     
-           _   -- The usual case
-             | isUnboxedTupleCon con -> returnUnboxedTuple amodes
-              | otherwise -> build_it_then emitReturnInstr
+           _otherwise  -- The usual case
+              -> build_it_then emitReturnInstr
        }
   where
+    enter_it    = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
+                           CmmJump (entryCode (closureInfoPtr (CmmReg nodeReg))) [] ]
     jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
     build_it_then return_code
       = do {   -- BUILD THE OBJECT IN THE HEAP
@@ -430,7 +450,7 @@ cgDataCon data_con
                = do { code_blks <- getCgStmts the_code
                     ; emitClosureCodeAndInfoTable cl_info [] code_blks }
                where
-                 the_code = do { ticky_code
+                 the_code = do { _ <- ticky_code
                                ; ldvEnter (CmmReg nodeReg)
                                ; body_code }