Forked from
Glasgow Haskell Compiler / GHC
42665 commits behind, 2 commits ahead of the upstream repository.
-
batterseapower authored
I observed that the [CmmStatics] within CmmData uses the list in a very stylised way. The first item in the list is almost invariably a CmmDataLabel. Many parts of the compiler pattern match on this list and fail if this is not true. This patch makes the invariant explicit by introducing a structured type CmmStatics that holds the label and the list of remaining [CmmStatic]. There is one wrinkle: the x86 backend sometimes wants to output an alignment directive just before the label. However, this can be easily fixed up by parameterising the native codegen over the type of CmmStatics (though the GenCmmTop parameterisation) and using a pair (Alignment, CmmStatics) there instead. As a result, I think we will be able to remove CmmAlign and CmmDataLabel from the CmmStatic data type, thus nuking a lot of code and failing pattern matches. This change will come as part of my next patch.
batterseapower authoredI observed that the [CmmStatics] within CmmData uses the list in a very stylised way. The first item in the list is almost invariably a CmmDataLabel. Many parts of the compiler pattern match on this list and fail if this is not true. This patch makes the invariant explicit by introducing a structured type CmmStatics that holds the label and the list of remaining [CmmStatic]. There is one wrinkle: the x86 backend sometimes wants to output an alignment directive just before the label. However, this can be easily fixed up by parameterising the native codegen over the type of CmmStatics (though the GenCmmTop parameterisation) and using a pair (Alignment, CmmStatics) there instead. As a result, I think we will be able to remove CmmAlign and CmmDataLabel from the CmmStatic data type, thus nuking a lot of code and failing pattern matches. This change will come as part of my next patch.
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
StgCmmHpc.hs 1.17 KiB
-----------------------------------------------------------------------------
--
-- Code generation for coverage
--
-- (c) Galois Connections, Inc. 2006
--
-----------------------------------------------------------------------------
module StgCmmHpc ( initHpc, mkTickBox ) where
import StgCmmMonad
import MkGraph
import CmmExpr
import CLabel
import Module
import CmmUtils
import StgCmmUtils
import HscTypes
import StaticFlags
mkTickBox :: Module -> Int -> CmmAGraph
mkTickBox mod n
= mkStore tick_box (CmmMachOp (MO_Add W64)
[ CmmLoad tick_box b64
, CmmLit (CmmInt 1 W64)
])
where
tick_box = cmmIndex W64
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
n
initHpc :: Module -> HpcInfo -> FCode ()
-- Emit top-level tables for HPC and return code to initialise
initHpc _ (NoHpcInfo {})
= return ()
initHpc this_mod (HpcInfo tickCount _hashNo)
= whenC opt_Hpc $
do { emitDataLits (mkHpcTicksLabel this_mod)
[ (CmmInt 0 W64)
| _ <- take tickCount [0::Int ..]
]
}