Commit 176fa33f authored by dias@eecs.harvard.edu's avatar dias@eecs.harvard.edu

Merging in the new codegen branch

This merge does not turn on the new codegen (which only compiles
a select few programs at this point),
but it does introduce some changes to the old code generator.

The high bits:
1. The Rep Swamp patch is finally here.
   The highlight is that the representation of types at the
   machine level has changed.
   Consequently, this patch contains updates across several back ends.
2. The new Stg -> Cmm path is here, although it appears to have a
   fair number of bugs lurking.
3. Many improvements along the CmmCPSZ path, including:
   o stack layout
   o some code for infotables, half of which is right and half wrong
   o proc-point splitting
parent e06951a7
......@@ -623,6 +623,7 @@ data CafInfo
| NoCafRefs -- ^ A function or static constructor
-- that refers to no CAFs.
deriving (Eq, Ord)
-- | Assumes that the 'Id' has CAF references: definitely safe
vanillaCafInfo :: CafInfo
......
module BlockId
( BlockId(..), mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet
, BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv
, BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv, mapBlockEnv
, BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, sizeBlockSet, mkBlockSet
, foldBlockEnv, blockLbl, infoTblLbl
) where
import CLabel
import IdInfo
import Name
import Outputable
import UniqFM
import Unique
......@@ -36,6 +40,11 @@ instance Show BlockId where
instance Outputable BlockId where
ppr = ppr . getUnique
blockLbl :: BlockId -> CLabel
blockLbl id = mkEntryLabel (mkFCallName (getUnique id) "block") NoCafRefs
infoTblLbl :: BlockId -> CLabel
infoTblLbl id = mkInfoTableLabel (mkFCallName (getUnique id) "block") NoCafRefs
type BlockEnv a = UniqFM {- BlockId -} a
emptyBlockEnv :: BlockEnv a
......@@ -46,6 +55,10 @@ lookupBlockEnv :: BlockEnv a -> BlockId -> Maybe a
lookupBlockEnv = lookupUFM
extendBlockEnv :: BlockEnv a -> BlockId -> a -> BlockEnv a
extendBlockEnv = addToUFM
mapBlockEnv :: (a -> b) -> BlockEnv a -> BlockEnv b
mapBlockEnv = mapUFM
foldBlockEnv :: (BlockId -> a -> b -> b) -> b -> BlockEnv a -> b
foldBlockEnv f = foldUFM_Directly (\u x y -> f (mkBlockId u) x y)
type BlockSet = UniqSet BlockId
emptyBlockSet :: BlockSet
......
......@@ -51,6 +51,7 @@ module CLabel (
mkModuleInitLabel,
mkPlainModuleInitLabel,
mkModuleInitTableLabel,
mkSplitMarkerLabel,
mkDirty_MUT_VAR_Label,
......@@ -67,6 +68,7 @@ module CLabel (
mkRtsSlowTickyCtrLabel,
moduleRegdLabel,
moduleRegTableLabel,
mkSelectorInfoLabel,
mkSelectorEntryLabel,
......@@ -77,6 +79,7 @@ module CLabel (
mkRtsRetLabel,
mkRtsCodeLabel,
mkRtsDataLabel,
mkRtsGcPtrLabel,
mkRtsInfoLabelFS,
mkRtsEntryLabelFS,
......@@ -103,16 +106,18 @@ module CLabel (
mkHpcTicksLabel,
mkHpcModuleNameLabel,
hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
isMathFun,
CLabelType(..), labelType, labelDynamic,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
pprCLabel
) where
#include "HsVersions.h"
import IdInfo
import StaticFlags
import Packages
import DataCon
......@@ -155,6 +160,7 @@ CLabel is an abstract type that supports the following operations:
data CLabel
= IdLabel -- A family of labels related to the
Name -- definition of a particular Id or Con
CafInfo
IdLabelInfo
| CaseLabel -- A family of labels related to a particular
......@@ -177,7 +183,10 @@ data CLabel
-- because we don't always recompile modules which depend on a module
-- whose version has changed.
| PlainModuleInitLabel -- without the vesrion & way info
| PlainModuleInitLabel -- without the version & way info
Module
| ModuleInitTableLabel -- table of imported modules to init
Module
| ModuleRegdLabel
......@@ -262,7 +271,8 @@ data RtsLabelInfo
| RtsEntry LitString -- misc rts entry points
| RtsRetInfo LitString -- misc rts ret info tables
| RtsRet LitString -- misc rts return points
| RtsData LitString -- misc rts data bits, eg CHARLIKE_closure
| RtsData LitString -- misc rts data bits
| RtsGcPtr LitString -- GcPtrs eg CHARLIKE_closure
| RtsCode LitString -- misc rts code
| RtsInfoFS FastString -- misc rts info tables
......@@ -292,29 +302,29 @@ data DynamicLinkerLabelInfo
-- Constructing CLabels
-- These are always local:
mkSRTLabel name = IdLabel name SRT
mkSlowEntryLabel name = IdLabel name Slow
mkRednCountsLabel name = IdLabel name RednCounts
mkSRTLabel name c = IdLabel name c SRT
mkSlowEntryLabel name c = IdLabel name c Slow
mkRednCountsLabel name c = IdLabel name c RednCounts
-- These have local & (possibly) external variants:
mkLocalClosureLabel name = IdLabel name Closure
mkLocalInfoTableLabel name = IdLabel name InfoTable
mkLocalEntryLabel name = IdLabel name Entry
mkLocalClosureTableLabel name = IdLabel name ClosureTable
mkClosureLabel name = IdLabel name Closure
mkInfoTableLabel name = IdLabel name InfoTable
mkEntryLabel name = IdLabel name Entry
mkClosureTableLabel name = IdLabel name ClosureTable
mkLocalConInfoTableLabel con = IdLabel con ConInfoTable
mkLocalConEntryLabel con = IdLabel con ConEntry
mkLocalStaticInfoTableLabel con = IdLabel con StaticInfoTable
mkLocalStaticConEntryLabel con = IdLabel con StaticConEntry
mkConInfoTableLabel name = IdLabel name ConInfoTable
mkStaticInfoTableLabel name = IdLabel name StaticInfoTable
mkConEntryLabel name = IdLabel name ConEntry
mkStaticConEntryLabel name = IdLabel name StaticConEntry
mkLocalClosureLabel name c = IdLabel name c Closure
mkLocalInfoTableLabel name c = IdLabel name c InfoTable
mkLocalEntryLabel name c = IdLabel name c Entry
mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
mkClosureLabel name c = IdLabel name c Closure
mkInfoTableLabel name c = IdLabel name c InfoTable
mkEntryLabel name c = IdLabel name c Entry
mkClosureTableLabel name c = IdLabel name c ClosureTable
mkLocalConInfoTableLabel c con = IdLabel con c ConInfoTable
mkLocalConEntryLabel c con = IdLabel con c ConEntry
mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
mkLocalStaticConEntryLabel c con = IdLabel con c StaticConEntry
mkConInfoTableLabel name c = IdLabel name c ConInfoTable
mkStaticInfoTableLabel name c = IdLabel name c StaticInfoTable
mkConEntryLabel name c = IdLabel name c ConEntry
mkStaticConEntryLabel name c = IdLabel name c StaticConEntry
mkLargeSRTLabel uniq = LargeSRTLabel uniq
mkBitmapLabel uniq = LargeBitmapLabel uniq
......@@ -334,6 +344,9 @@ mkModuleInitLabel mod way = ModuleInitLabel mod way
mkPlainModuleInitLabel :: Module -> CLabel
mkPlainModuleInitLabel mod = PlainModuleInitLabel mod
mkModuleInitTableLabel :: Module -> CLabel
mkModuleInitTableLabel mod = ModuleInitTableLabel mod
-- Some fixed runtime system labels
mkSplitMarkerLabel = RtsLabel (RtsCode (sLit "__stg_split_marker"))
......@@ -350,6 +363,7 @@ mkCAFBlackHoleInfoTableLabel = RtsLabel (RtsInfo (sLit "stg_CAF_BLACKHOLE"))
mkRtsPrimOpLabel primop = RtsLabel (RtsPrimOp primop)
moduleRegdLabel = ModuleRegdLabel
moduleRegTableLabel = ModuleInitTableLabel
mkSelectorInfoLabel upd off = RtsLabel (RtsSelectorInfoTable upd off)
mkSelectorEntryLabel upd off = RtsLabel (RtsSelectorEntry upd off)
......@@ -383,6 +397,7 @@ mkRtsRetInfoLabel str = RtsLabel (RtsRetInfo str)
mkRtsRetLabel str = RtsLabel (RtsRet str)
mkRtsCodeLabel str = RtsLabel (RtsCode str)
mkRtsDataLabel str = RtsLabel (RtsData str)
mkRtsGcPtrLabel str = RtsLabel (RtsGcPtr str)
mkRtsInfoLabelFS str = RtsLabel (RtsInfoFS str)
mkRtsEntryLabelFS str = RtsLabel (RtsEntryFS str)
......@@ -422,9 +437,9 @@ mkDeadStripPreventer lbl = DeadStripPreventer lbl
-- Converting between info labels and entry/ret labels.
infoLblToEntryLbl :: CLabel -> CLabel
infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
infoLblToEntryLbl (IdLabel n c InfoTable) = IdLabel n c Entry
infoLblToEntryLbl (IdLabel n c ConInfoTable) = IdLabel n c ConEntry
infoLblToEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
......@@ -433,9 +448,9 @@ infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
entryLblToInfoLbl :: CLabel -> CLabel
entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
entryLblToInfoLbl (IdLabel n c Entry) = IdLabel n c InfoTable
entryLblToInfoLbl (IdLabel n c ConEntry) = IdLabel n c ConInfoTable
entryLblToInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
......@@ -443,6 +458,12 @@ entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
-- -----------------------------------------------------------------------------
-- Does a CLabel refer to a CAF?
hasCAF :: CLabel -> Bool
hasCAF (IdLabel _ MayHaveCafRefs Closure) = True
hasCAF _ = False
-- -----------------------------------------------------------------------------
-- Does a CLabel need declaring before use or not?
--
......@@ -452,13 +473,14 @@ needsCDecl :: CLabel -> Bool
-- False <=> it's pre-declared; don't bother
-- don't bother declaring SRT & Bitmap labels, we always make sure
-- they are defined before use.
needsCDecl (IdLabel _ SRT) = False
needsCDecl (IdLabel _ _ SRT) = False
needsCDecl (LargeSRTLabel _) = False
needsCDecl (LargeBitmapLabel _) = False
needsCDecl (IdLabel _ _) = True
needsCDecl (IdLabel _ _ _) = True
needsCDecl (CaseLabel _ _) = True
needsCDecl (ModuleInitLabel _ _) = True
needsCDecl (PlainModuleInitLabel _) = True
needsCDecl (ModuleInitTableLabel _) = True
needsCDecl ModuleRegdLabel = False
needsCDecl (StringLitLabel _) = False
......@@ -520,12 +542,11 @@ externallyVisibleCLabel (StringLitLabel _) = False
externallyVisibleCLabel (AsmTempLabel _) = False
externallyVisibleCLabel (ModuleInitLabel _ _) = True
externallyVisibleCLabel (PlainModuleInitLabel _)= True
externallyVisibleCLabel (ModuleInitTableLabel _)= False
externallyVisibleCLabel ModuleRegdLabel = False
externallyVisibleCLabel (RtsLabel _) = True
externallyVisibleCLabel (ForeignLabel _ _ _) = True
externallyVisibleCLabel (IdLabel name SRT) = False
-- SRTs don't need to be external
externallyVisibleCLabel (IdLabel name _) = isExternalName name
externallyVisibleCLabel (IdLabel name _ _) = isExternalName name
externallyVisibleCLabel (CC_Label _) = True
externallyVisibleCLabel (CCS_Label _) = True
externallyVisibleCLabel (DynamicLinkerLabel _ _) = False
......@@ -540,13 +561,25 @@ externallyVisibleCLabel (LargeSRTLabel _) = False
-- For generating correct types in label declarations:
data CLabelType
= CodeLabel
| DataLabel
= CodeLabel -- Address of some executable instructions
| DataLabel -- Address of data, not a GC ptr
| GcPtrLabel -- Address of a (presumably static) GC object
isCFunctionLabel :: CLabel -> Bool
isCFunctionLabel lbl = case labelType lbl of
CodeLabel -> True
_other -> False
isGcPtrLabel :: CLabel -> Bool
isGcPtrLabel lbl = case labelType lbl of
GcPtrLabel -> True
_other -> False
labelType :: CLabel -> CLabelType
labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel
labelType (RtsLabel (RtsData _)) = DataLabel
labelType (RtsLabel (RtsGcPtr _)) = GcPtrLabel
labelType (RtsLabel (RtsCode _)) = CodeLabel
labelType (RtsLabel (RtsInfo _)) = DataLabel
labelType (RtsLabel (RtsEntry _)) = CodeLabel
......@@ -563,20 +596,19 @@ labelType (CaseLabel _ CaseReturnInfo) = DataLabel
labelType (CaseLabel _ _) = CodeLabel
labelType (ModuleInitLabel _ _) = CodeLabel
labelType (PlainModuleInitLabel _) = CodeLabel
labelType (ModuleInitTableLabel _) = DataLabel
labelType (LargeSRTLabel _) = DataLabel
labelType (LargeBitmapLabel _) = DataLabel
labelType (IdLabel _ info) = idInfoLabelType info
labelType _ = DataLabel
labelType (IdLabel _ _ info) = idInfoLabelType info
labelType _ = DataLabel
idInfoLabelType info =
case info of
InfoTable -> DataLabel
Closure -> DataLabel
Closure -> GcPtrLabel
ConInfoTable -> DataLabel
StaticInfoTable -> DataLabel
ClosureTable -> DataLabel
-- krc: aie! a ticky counter label is data
RednCounts -> DataLabel
_ -> CodeLabel
......@@ -593,7 +625,7 @@ labelDynamic :: PackageId -> CLabel -> Bool
labelDynamic this_pkg lbl =
case lbl of
RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
IdLabel n k -> isDllName this_pkg n
IdLabel n _ k -> isDllName this_pkg n
#if mingw32_TARGET_OS
ForeignLabel _ _ d -> d
#else
......@@ -603,6 +635,7 @@ labelDynamic this_pkg lbl =
#endif
ModuleInitLabel m _ -> not opt_Static && this_pkg /= (modulePackageId m)
PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
ModuleInitTableLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
......@@ -720,6 +753,7 @@ pprCLbl (LargeBitmapLabel u) = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLi
pprCLbl (RtsLabel (RtsCode str)) = ptext str
pprCLbl (RtsLabel (RtsData str)) = ptext str
pprCLbl (RtsLabel (RtsGcPtr str)) = ptext str
pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
......@@ -789,7 +823,7 @@ pprCLbl ModuleRegdLabel
pprCLbl (ForeignLabel str _ _)
= ftext str
pprCLbl (IdLabel name flavor) = ppr name <> ppIdFlavor flavor
pprCLbl (IdLabel name _ flavor) = ppr name <> ppIdFlavor flavor
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
......@@ -799,6 +833,8 @@ pprCLbl (ModuleInitLabel mod way)
<> char '_' <> text way
pprCLbl (PlainModuleInitLabel mod)
= ptext (sLit "__stginit_") <> ppr mod
pprCLbl (ModuleInitTableLabel mod)
= ptext (sLit "__stginittable_") <> ppr mod
pprCLbl (HpcTicksLabel mod)
= ptext (sLit "_hpc_tickboxes_") <> ppr mod <> ptext (sLit "_hpc")
......
......@@ -7,21 +7,21 @@
-----------------------------------------------------------------------------
module Cmm (
GenCmm(..), Cmm, RawCmm,
GenCmmTop(..), CmmTop, RawCmmTop,
ListGraph(..),
GenCmm(..), Cmm, RawCmm,
GenCmmTop(..), CmmTop, RawCmmTop,
ListGraph(..),
cmmMapGraph, cmmTopMapGraph,
cmmMapGraphM, cmmTopMapGraphM,
CmmInfo(..), UpdateFrame(..),
CmmInfo(..), UpdateFrame(..),
CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
CmmReturnInfo(..),
CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind,
CmmFormalsWithoutKinds, CmmFormalWithoutKind,
CmmKinded(..),
CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals,
HintedCmmFormal, HintedCmmFormals, HintedCmmActual, HintedCmmActuals,
CmmSafety(..),
CmmCallTarget(..),
CmmStatic(..), Section(..),
CmmCallTarget(..), CallishMachOp(..), pprCallishMachOp,
ForeignHint(..), CmmHinted(..),
CmmStatic(..), Section(..),
module CmmExpr,
) where
......@@ -29,10 +29,10 @@ module Cmm (
import BlockId
import CmmExpr
import MachOp
import CLabel
import ForeignCall
import SMRep
import ClosureInfo
import Outputable
import FastString
......@@ -46,7 +46,7 @@ import Data.Word
-- with assembly-language labels.
-----------------------------------------------------------------------------
-- Cmm, CmmTop, CmmBasicBlock
-- Cmm, CmmTop, CmmBasicBlock
-----------------------------------------------------------------------------
-- A file is a list of top-level chunks. These may be arbitrarily
......@@ -59,7 +59,7 @@ import Data.Word
--
-- We expect there to be two main instances of this type:
-- (a) C--, i.e. populated with various C-- constructs
-- (Cmm and RawCmm below)
-- (Cmm and RawCmm below)
-- (b) Native code, populated with data/instructions
--
-- A second family of instances based on ZipCfg is work in progress.
......@@ -72,7 +72,7 @@ data GenCmmTop d h g
= CmmProc -- A procedure
h -- Extra header such as the info table
CLabel -- Used to generate both info & entry labels
CmmFormalsWithoutKinds -- Argument locals live on entry (C-- procedure params)
CmmFormals -- Argument locals live on entry (C-- procedure params)
-- XXX Odd that there are no kinds, but there you are ---NR
g -- Control-flow graph for the procedure's code
......@@ -164,11 +164,11 @@ data CmmInfoTable
data ClosureTypeInfo
= ConstrInfo ClosureLayout ConstrTag ConstrDescription
| FunInfo ClosureLayout C_SRT FunType FunArity ArgDescr SlowEntry
| ThunkInfo ClosureLayout C_SRT
| FunInfo ClosureLayout C_SRT FunArity ArgDescr SlowEntry
| ThunkInfo ClosureLayout C_SRT
| ThunkSelectorInfo SelectorOffset C_SRT
| ContInfo
[Maybe LocalReg] -- Forced stack parameters
[Maybe LocalReg] -- stack layout
C_SRT
data CmmReturnInfo = CmmMayReturn
......@@ -180,7 +180,6 @@ type ClosureTypeTag = StgHalfWord
type ClosureLayout = (StgHalfWord, StgHalfWord) -- ptrs, nptrs
type ConstrTag = StgHalfWord
type ConstrDescription = CmmLit
type FunType = StgHalfWord
type FunArity = StgHalfWord
type SlowEntry = CmmLit
-- We would like this to be a CLabel but
......@@ -201,19 +200,19 @@ data UpdateFrame =
-- control to a new function.
-----------------------------------------------------------------------------
data CmmStmt
data CmmStmt -- Old-style
= CmmNop
| CmmComment FastString
| CmmAssign CmmReg CmmExpr -- Assign to register
| CmmStore CmmExpr CmmExpr -- Assign to memory location. Size is
-- given by cmmExprRep of the rhs.
-- given by cmmExprType of the rhs.
| CmmCall -- A call (forign, native or primitive), with
CmmCallTarget
CmmFormals -- zero or more results
CmmActuals -- zero or more arguments
HintedCmmFormals -- zero or more results
HintedCmmActuals -- zero or more arguments
CmmSafety -- whether to build a continuation
CmmReturnInfo
......@@ -228,27 +227,27 @@ data CmmStmt
-- Undefined outside range, and when there's a Nothing
| CmmJump CmmExpr -- Jump to another C-- function,
CmmActuals -- with these parameters.
HintedCmmActuals -- with these parameters. (parameters never used)
| CmmReturn -- Return from a native C-- function,
CmmActuals -- with these return values.
HintedCmmActuals -- with these return values. (parameters never used)
type CmmKind = MachHint
data CmmKinded a = CmmKinded { kindlessCmm :: a, cmmKind :: CmmKind }
deriving (Eq)
type CmmActual = CmmKinded CmmExpr
type CmmFormal = CmmKinded LocalReg
type CmmActual = CmmExpr
type CmmFormal = LocalReg
type CmmActuals = [CmmActual]
type CmmFormals = [CmmFormal]
type CmmFormalWithoutKind = LocalReg
type CmmFormalsWithoutKinds = [CmmFormalWithoutKind]
data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: ForeignHint }
deriving( Eq )
type HintedCmmActuals = [HintedCmmActual]
type HintedCmmFormals = [HintedCmmFormal]
type HintedCmmFormal = CmmHinted CmmFormal
type HintedCmmActual = CmmHinted CmmActual
data CmmSafety = CmmUnsafe | CmmSafe C_SRT
-- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
instance UserOfLocalRegs a => UserOfLocalRegs (CmmKinded a) where
foldRegsUsed f set (CmmKinded a _) = foldRegsUsed f set a
instance UserOfLocalRegs CmmStmt where
foldRegsUsed f set s = stmt s set
where stmt (CmmNop) = id
......@@ -267,13 +266,18 @@ instance UserOfLocalRegs CmmCallTarget where
foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e
foldRegsUsed _ set (CmmPrim {}) = set
instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmKinded a) where
foldRegsDefd f z (CmmKinded x _) = foldRegsDefd f z x
instance UserOfSlots CmmCallTarget where
foldSlotsUsed f set (CmmCallee e _) = foldSlotsUsed f set e
foldSlotsUsed _ set (CmmPrim {}) = set
--just look like a tuple, since it was a tuple before
-- ... is that a good idea? --Isaac Dupree
instance (Outputable a) => Outputable (CmmKinded a) where
ppr (CmmKinded a k) = ppr (a, k)
instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
instance UserOfSlots a => UserOfSlots (CmmHinted a) where
foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)
instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where
foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
{-
Discussion
......@@ -332,6 +336,51 @@ data CmmCallTarget
-- code by the backend.
deriving Eq
data ForeignHint
= NoHint | AddrHint | SignedHint
deriving( Eq )
-- Used to give extra per-argument or per-result
-- information needed by foreign calling conventions
-- CallishMachOps tend to be implemented by foreign calls in some backends,
-- so we separate them out. In Cmm, these can only occur in a
-- statement position, in contrast to an ordinary MachOp which can occur
-- anywhere in an expression.
data CallishMachOp
= MO_F64_Pwr
| MO_F64_Sin
| MO_F64_Cos
| MO_F64_Tan
| MO_F64_Sinh
| MO_F64_Cosh
| MO_F64_Tanh
| MO_F64_Asin
| MO_F64_Acos
| MO_F64_Atan
| MO_F64_Log
| MO_F64_Exp
| MO_F64_Sqrt
| MO_F32_Pwr
| MO_F32_Sin
| MO_F32_Cos
| MO_F32_Tan
| MO_F32_Sinh
| MO_F32_Cosh
| MO_F32_Tanh
| MO_F32_Asin
| MO_F32_Acos
| MO_F32_Atan
| MO_F32_Log
| MO_F32_Exp
| MO_F32_Sqrt
| MO_WriteBarrier
deriving (Eq, Show)
pprCallishMachOp :: CallishMachOp -> SDoc
pprCallishMachOp mo = text (show mo)
-----------------------------------------------------------------------------
-- Static Data
-----------------------------------------------------------------------------
......
......@@ -15,7 +15,7 @@ module CmmBrokenBlock (
adaptBlockToFormat,
selectContinuations,
ContFormat,
makeContinuationEntries,
makeContinuationEntries
) where
#include "HsVersions.h"
......@@ -24,7 +24,6 @@ import BlockId
import Cmm
import CmmUtils
import CLabel
import MachOp (MachHint(..))
import CgUtils (callerSaveVolatileRegs)
import ClosureInfo
......@@ -69,14 +68,14 @@ data BrokenBlock
-- | How a block could be entered
-- See Note [An example of CPS conversion]
data BlockEntryInfo
= FunctionEntry CmmInfo CLabel CmmFormalsWithoutKinds
= FunctionEntry CmmInfo CLabel CmmFormals
-- ^ Block is the beginning of a function, parameters are:
-- 1. Function header info