summaryrefslogtreecommitdiff
path: root/compiler/codeGen/CgCon.lhs
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2011-10-14 23:24:48 +0100
committerIan Lynagh <igloo@earth.li>2011-10-14 23:24:48 +0100
commit2e77595f091b7f6a1f4db7dc7d9d3fbcb5402bc2 (patch)
treeb8e6e3ade06ae3e7466f2cc7b1e3a0566186ce26 /compiler/codeGen/CgCon.lhs
parent99640195039a335fb0b49ab3e5c8a42d140e2a7c (diff)
downloadhaskell-2e77595f091b7f6a1f4db7dc7d9d3fbcb5402bc2.tar.gz
de-CPP codeGen/CgCon.lhs
Diffstat (limited to 'compiler/codeGen/CgCon.lhs')
-rw-r--r--compiler/codeGen/CgCon.lhs39
1 files changed, 24 insertions, 15 deletions
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 9c7d001db4..b50ba8d779 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -49,7 +49,10 @@ import Util
import Module
import DynFlags
import FastString
+import Platform
import StaticFlags
+
+import Control.Monad
\end{code}
@@ -66,11 +69,11 @@ cgTopRhsCon :: Id -- Name of thing bound to this RHS
-> FCode (Id, CgIdInfo)
cgTopRhsCon id con args
= do { dflags <- getDynFlags
-#if mingw32_TARGET_OS
- -- Windows DLLs have a problem with static cross-DLL refs.
- ; this_pkg <- getThisPackage
- ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
-#endif
+ ; when (platformOS (targetPlatform dflags) == OSMinGW32) $ do {
+ -- Windows DLLs have a problem with static cross-DLL refs.
+ ; this_pkg <- getThisPackage
+ ; ASSERT( not (isDllConApp this_pkg con args) ) return ()
+ }
; ASSERT( args `lengthIs` dataConRepArity con ) return ()
-- LAY IT OUT
@@ -117,6 +120,16 @@ buildDynCon :: Id -- Name of the thing to which this constr will
-> DataCon -- The data constructor
-> [(CgRep,CmmExpr)] -- Its args
-> FCode CgIdInfo -- Return details about how to find it
+buildDynCon binder ccs con args
+ = do dflags <- getDynFlags
+ buildDynCon' (targetPlatform dflags) binder ccs con args
+
+buildDynCon' :: Platform
+ -> Id
+ -> CostCentreStack
+ -> DataCon
+ -> [(CgRep,CmmExpr)]
+ -> FCode CgIdInfo
-- We used to pass a boolean indicating whether all the
-- args were of size zero, so we could use a static
@@ -138,7 +151,7 @@ which have exclusively size-zero (VoidRep) args, we generate no code
at all.
\begin{code}
-buildDynCon binder _ con []
+buildDynCon' _ binder _ con []
= returnFC (taggedStableIdInfo binder
(mkLblExpr (mkClosureLabel (dataConName con)
(idCafInfo binder)))
@@ -173,11 +186,9 @@ because they don't support cross package data references well.
\begin{code}
-buildDynCon binder _ con [arg_amode]
+buildDynCon' platform binder _ con [arg_amode]
| maybeIntLikeCon con
-#if defined(mingw32_TARGET_OS)
- , not opt_PIC
-#endif
+ , platformOS platform /= OSMinGW32 || not opt_PIC
, (_, CmmLit (CmmInt val _)) <- arg_amode
, let val_int = (fromIntegral val) :: Int
, val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
@@ -187,11 +198,9 @@ buildDynCon binder _ con [arg_amode]
intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
-buildDynCon binder _ con [arg_amode]
+buildDynCon' platform binder _ con [arg_amode]
| maybeCharLikeCon con
-#if defined(mingw32_TARGET_OS)
- , not opt_PIC
-#endif
+ , platformOS platform /= OSMinGW32 || not opt_PIC
, (_, CmmLit (CmmInt val _)) <- arg_amode
, let val_int = (fromIntegral val) :: Int
, val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
@@ -206,7 +215,7 @@ buildDynCon binder _ con [arg_amode]
Now the general case.
\begin{code}
-buildDynCon binder ccs con args
+buildDynCon' _ binder ccs con args
= do {
; let
(closure_info, amodes_w_offsets) = layOutDynConstr con args