import MkZipCfgCmm (CmmAGraph, mkNop)
import SMRep
import CostCentre
+import Module
import Constants
import DataCon
import FastString
import PrelInfo
import Outputable
import Util ( lengthIs )
-import Char ( ord )
+import Data.Char
---------------------------------------------------------------
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.
+-}
+
+#if !(defined(__PIC__) && defined(mingw32_HOST_OS))
buildDynCon binder _cc con [arg]
| maybeIntLikeCon con
, StgLitArg (MachInt val) <- arg
, val <= fromIntegral mAX_INTLIKE -- Comparisons at type Integer!
, val >= fromIntegral mIN_INTLIKE -- ...ditto...
- = do { let intlike_lbl = mkRtsGcPtrLabel (sLit "stg_INTLIKE_closure")
+ = do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
val_int = fromIntegral val :: Int
offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
-- INTLIKE closures consist of a header and one word payload
, let val_int = ord 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 = cmmLabelOffW charlike_lbl offsetW
; return (litIdInfo binder (mkConLFInfo con) charlike_amode, mkNop) }
+#endif
-------- buildDynCon: the general case -----------
buildDynCon binder ccs con args
bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg
bind_arg (arg, offset)
= do { emit $ mkTaggedObjectLoad (idToReg arg) base offset tag
- ; pprTrace "bind_arg gets tag" (ppr arg <+> ppr tag) $
- bindArgToReg arg }
+ ; bindArgToReg arg }
bindConArgs _other_con _base args
= ASSERT( null args ) return []