X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmCon.hs;h=368bc534838b219d30cc8fc6431eba76b23213ab;hp=18c2509ccdfd32428de91758ae2614c96a529a34;hb=d9a655dad8e013e41c74dca98fb86c4ed6f29879;hpb=8c84944d5782f2ee60d96c02977f15ba9e7ab935 diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 18c2509..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 @@ -153,9 +158,11 @@ We don't support this optimisation when compiling into Windows DLLs yet because they don't support cross package data references well. -} -#if !(defined(__PIC__) && defined(mingw32_HOST_OS)) 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... @@ -167,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 @@ -177,14 +187,13 @@ buildDynCon binder _cc con [arg] -- CHARLIKE closures consist of a header and one word payload charlike_amode = cmmLabelOffW charlike_lbl offsetW ; return (litIdInfo binder (mkConLFInfo con) charlike_amode, mkNop) } -#endif -------- buildDynCon: the general case ----------- 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