diff options
Diffstat (limited to 'compiler/GHC/StgToCmm.hs')
| -rw-r--r-- | compiler/GHC/StgToCmm.hs | 27 |
1 files changed, 17 insertions, 10 deletions
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs index f89f465d12..d60b52536f 100644 --- a/compiler/GHC/StgToCmm.hs +++ b/compiler/GHC/StgToCmm.hs @@ -64,8 +64,9 @@ import GHC.SysTools.FileCleanup import GHC.Data.Stream import GHC.Data.OrdList +import GHC.Types.Unique.Map -import Control.Monad (when,void) +import Control.Monad (when,void, forM_) import GHC.Utils.Misc import System.IO.Unsafe import qualified Data.ByteString as BS @@ -87,7 +88,7 @@ codeGen :: Logger -> Stream IO CmmGroup (SDoc, ModuleLFInfos) -- Output as a stream, so codegen can -- be interleaved with output -codeGen logger dflags this_mod ip_map@(InfoTableProvMap _) data_tycons +codeGen logger dflags this_mod ip_map@(InfoTableProvMap (UniqMap denv) _) data_tycons cost_centre_info stg_binds hpc_info = do { -- cg: run the code generator, and yield the resulting CmmGroup -- Using an IORef to store the state is a bit crude, but otherwise @@ -132,10 +133,15 @@ codeGen logger dflags this_mod ip_map@(InfoTableProvMap _) data_tycons -- enumeration type Note that the closure pointers are -- tagged. when (isEnumerationTyCon tycon) $ cg (cgEnumerationTyCon tycon) - mapM_ (cg . cgDataCon) (tyConDataCons tycon) + -- Emit normal info_tables, for data constructors defined in this module. + mapM_ (cg . cgDataCon DefinitionSite) (tyConDataCons tycon) ; mapM_ do_tycon data_tycons + -- Emit special info tables for everything used in this module + -- This will only do something if `-fdistinct-info-tables` is turned on. + ; mapM_ (\(dc, ns) -> forM_ ns $ \(k, _ss) -> cg (cgDataCon (UsageSite this_mod k) dc)) (nonDetEltsUFM denv) + ; final_state <- liftIO (readIORef cgref) ; let cg_id_infos = cgs_binds . codegen_state $ final_state used_info = fromOL . codegen_used_info $ final_state @@ -210,8 +216,8 @@ cgTopBinding logger dflags (StgTopStringLit id str) = do cgTopRhs :: DynFlags -> RecFlag -> Id -> CgStgRhs -> (CgIdInfo, FCode ()) -- The Id is passed along for setting up a binding... -cgTopRhs dflags _rec bndr (StgRhsCon _cc con args) - = cgTopRhsCon dflags bndr con (assertNonVoidStgArgs args) +cgTopRhs dflags _rec bndr (StgRhsCon _cc con mn _ts args) + = cgTopRhsCon dflags bndr con mn (assertNonVoidStgArgs args) -- con args are always non-void, -- see Note [Post-unarisation invariants] in GHC.Stg.Unarise @@ -250,11 +256,12 @@ cgEnumerationTyCon tycon | con <- tyConDataCons tycon] --- | Generate the entry code, info tables, and (for niladic constructor) +cgDataCon :: ConInfoTableLocation -> DataCon -> FCode () +-- Generate the entry code, info tables, and (for niladic constructor) -- the static closure, for a constructor. -cgDataCon :: DataCon -> FCode () -cgDataCon data_con - = do { profile <- getProfile +cgDataCon mn data_con + = do { MASSERT( not (isUnboxedTupleDataCon data_con || isUnboxedSumDataCon data_con) ) + ; profile <- getProfile ; platform <- getPlatform ; let (tot_wds, -- #ptr_wds + #nonptr_wds @@ -264,7 +271,7 @@ cgDataCon data_con nonptr_wds = tot_wds - ptr_wds dyn_info_tbl = - mkDataConInfoTable profile data_con False ptr_wds nonptr_wds + mkDataConInfoTable profile data_con mn False ptr_wds nonptr_wds -- We're generating info tables, so we don't know and care about -- what the actual arguments are. Using () here as the place holder. |