diff options
Diffstat (limited to 'compiler/GHC/Cmm/Info.hs')
| -rw-r--r-- | compiler/GHC/Cmm/Info.hs | 178 |
1 files changed, 91 insertions, 87 deletions
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs index 1d26c7d5ee..c650a66581 100644 --- a/compiler/GHC/Cmm/Info.hs +++ b/compiler/GHC/Cmm/Info.hs @@ -5,6 +5,7 @@ module GHC.Cmm.Info ( srtEscape, -- info table accessors + PtrOpts (..), closureInfoPtr, entryCode, getConstrTag, @@ -45,6 +46,7 @@ import qualified GHC.Data.Stream as Stream import GHC.Cmm.Dataflow.Collections import GHC.Platform +import GHC.Platform.Profile import GHC.Data.Maybe import GHC.Driver.Session import GHC.Utils.Error (withTimingSilent) @@ -367,7 +369,7 @@ mkLivenessBits dflags liveness [b] -> b _ -> panic "mkLiveness" bitmap_word = toStgWord platform (fromIntegral n_bits) - .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT dflags) + .|. (small_bitmap `shiftL` pc_BITMAP_BITS_SHIFT (platformConstants platform)) lits = mkWordCLit platform (fromIntegral n_bits) : map (mkStgWordCLit platform) bitmap @@ -441,20 +443,25 @@ srtEscape platform = toStgHalfWord platform (-1) -- ------------------------------------------------------------------------- +data PtrOpts = PtrOpts + { po_profile :: !Profile -- ^ Platform profile + , po_align_check :: !Bool -- ^ Insert alignment check (cf @-falignment-sanitisation@) + } + -- | Wrap a 'CmmExpr' in an alignment check when @-falignment-sanitisation@ is -- enabled. -wordAligned :: DynFlags -> CmmExpr -> CmmExpr -wordAligned dflags e - | gopt Opt_AlignmentSanitisation dflags +wordAligned :: PtrOpts -> CmmExpr -> CmmExpr +wordAligned opts e + | po_align_check opts = CmmMachOp (MO_AlignmentCheck (platformWordSizeInBytes platform) (wordWidth platform)) [e] | otherwise = e - where platform = targetPlatform dflags + where platform = profilePlatform (po_profile opts) -closureInfoPtr :: DynFlags -> CmmExpr -> CmmExpr --- Takes a closure pointer and returns the info table pointer -closureInfoPtr dflags e = - CmmLoad (wordAligned dflags e) (bWord (targetPlatform dflags)) +-- | Takes a closure pointer and returns the info table pointer +closureInfoPtr :: PtrOpts -> CmmExpr -> CmmExpr +closureInfoPtr opts e = + CmmLoad (wordAligned opts e) (bWord (profilePlatform (po_profile opts))) -- | Takes an info pointer (the first word of a closure) and returns its entry -- code @@ -464,92 +471,93 @@ entryCode platform e = then e else CmmLoad e (bWord platform) -getConstrTag :: DynFlags -> CmmExpr -> CmmExpr --- Takes a closure pointer, and return the *zero-indexed* +-- | Takes a closure pointer, and return the *zero-indexed* -- constructor tag obtained from the info table -- This lives in the SRT field of the info table -- (constructors don't need SRTs). -getConstrTag dflags closure_ptr - = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableConstrTag dflags info_table] +getConstrTag :: PtrOpts -> CmmExpr -> CmmExpr +getConstrTag opts closure_ptr + = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableConstrTag profile info_table] where - info_table = infoTable dflags (closureInfoPtr dflags closure_ptr) - platform = targetPlatform dflags + info_table = infoTable profile (closureInfoPtr opts closure_ptr) + platform = profilePlatform profile + profile = po_profile opts -cmmGetClosureType :: DynFlags -> CmmExpr -> CmmExpr --- Takes a closure pointer, and return the closure type +-- | Takes a closure pointer, and return the closure type -- obtained from the info table -cmmGetClosureType dflags closure_ptr - = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableClosureType dflags info_table] +cmmGetClosureType :: PtrOpts -> CmmExpr -> CmmExpr +cmmGetClosureType opts closure_ptr + = CmmMachOp (MO_UU_Conv (halfWordWidth platform) (wordWidth platform)) [infoTableClosureType profile info_table] where - info_table = infoTable dflags (closureInfoPtr dflags closure_ptr) - platform = targetPlatform dflags + info_table = infoTable profile (closureInfoPtr opts closure_ptr) + platform = profilePlatform profile + profile = po_profile opts -infoTable :: DynFlags -> CmmExpr -> CmmExpr --- Takes an info pointer (the first word of a closure) +-- | Takes an info pointer (the first word of a closure) -- and returns a pointer to the first word of the standard-form -- info table, excluding the entry-code word (if present) -infoTable dflags info_ptr - | platformTablesNextToCode platform = cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags) +infoTable :: Profile -> CmmExpr -> CmmExpr +infoTable profile info_ptr + | platformTablesNextToCode platform = cmmOffsetB platform info_ptr (- stdInfoTableSizeB profile) | otherwise = cmmOffsetW platform info_ptr 1 -- Past the entry code pointer - where platform = targetPlatform dflags + where platform = profilePlatform profile -infoTableConstrTag :: DynFlags -> CmmExpr -> CmmExpr --- Takes an info table pointer (from infoTable) and returns the constr tag +-- | Takes an info table pointer (from infoTable) and returns the constr tag -- field of the info table (same as the srt_bitmap field) +infoTableConstrTag :: Profile -> CmmExpr -> CmmExpr infoTableConstrTag = infoTableSrtBitmap -infoTableSrtBitmap :: DynFlags -> CmmExpr -> CmmExpr --- Takes an info table pointer (from infoTable) and returns the srt_bitmap +-- | Takes an info table pointer (from infoTable) and returns the srt_bitmap -- field of the info table -infoTableSrtBitmap dflags info_tbl - = CmmLoad (cmmOffsetB platform info_tbl (stdSrtBitmapOffset dflags)) (bHalfWord platform) - where platform = targetPlatform dflags +infoTableSrtBitmap :: Profile -> CmmExpr -> CmmExpr +infoTableSrtBitmap profile info_tbl + = CmmLoad (cmmOffsetB platform info_tbl (stdSrtBitmapOffset profile)) (bHalfWord platform) + where platform = profilePlatform profile -infoTableClosureType :: DynFlags -> CmmExpr -> CmmExpr --- Takes an info table pointer (from infoTable) and returns the closure type +-- | Takes an info table pointer (from infoTable) and returns the closure type -- field of the info table. -infoTableClosureType dflags info_tbl - = CmmLoad (cmmOffsetB platform info_tbl (stdClosureTypeOffset dflags)) (bHalfWord platform) - where platform = targetPlatform dflags - -infoTablePtrs :: DynFlags -> CmmExpr -> CmmExpr -infoTablePtrs dflags info_tbl - = CmmLoad (cmmOffsetB platform info_tbl (stdPtrsOffset dflags)) (bHalfWord platform) - where platform = targetPlatform dflags - -infoTableNonPtrs :: DynFlags -> CmmExpr -> CmmExpr -infoTableNonPtrs dflags info_tbl - = CmmLoad (cmmOffsetB platform info_tbl (stdNonPtrsOffset dflags)) (bHalfWord platform) - where platform = targetPlatform dflags - -funInfoTable :: DynFlags -> CmmExpr -> CmmExpr --- Takes the info pointer of a function, --- and returns a pointer to the first word of the StgFunInfoExtra struct --- in the info table. -funInfoTable dflags info_ptr +infoTableClosureType :: Profile -> CmmExpr -> CmmExpr +infoTableClosureType profile info_tbl + = CmmLoad (cmmOffsetB platform info_tbl (stdClosureTypeOffset profile)) (bHalfWord platform) + where platform = profilePlatform profile + +infoTablePtrs :: Profile -> CmmExpr -> CmmExpr +infoTablePtrs profile info_tbl + = CmmLoad (cmmOffsetB platform info_tbl (stdPtrsOffset profile)) (bHalfWord platform) + where platform = profilePlatform profile + +infoTableNonPtrs :: Profile -> CmmExpr -> CmmExpr +infoTableNonPtrs profile info_tbl + = CmmLoad (cmmOffsetB platform info_tbl (stdNonPtrsOffset profile)) (bHalfWord platform) + where platform = profilePlatform profile + +-- | Takes the info pointer of a function, and returns a pointer to the first +-- word of the StgFunInfoExtra struct in the info table. +funInfoTable :: Profile -> CmmExpr -> CmmExpr +funInfoTable profile info_ptr | platformTablesNextToCode platform - = cmmOffsetB platform info_ptr (- stdInfoTableSizeB dflags - sIZEOF_StgFunInfoExtraRev dflags) + = cmmOffsetB platform info_ptr (- stdInfoTableSizeB profile - pc_SIZEOF_StgFunInfoExtraRev (platformConstants platform)) | otherwise - = cmmOffsetW platform info_ptr (1 + stdInfoTableSizeW dflags) + = cmmOffsetW platform info_ptr (1 + stdInfoTableSizeW profile) -- Past the entry code pointer where - platform = targetPlatform dflags + platform = profilePlatform profile --- Takes the info pointer of a function, returns the function's arity -funInfoArity :: DynFlags -> CmmExpr -> CmmExpr -funInfoArity dflags iptr +-- | Takes the info pointer of a function, returns the function's arity +funInfoArity :: Profile -> CmmExpr -> CmmExpr +funInfoArity profile iptr = cmmToWord platform (cmmLoadIndex platform rep fun_info (offset `div` rep_bytes)) where - platform = targetPlatform dflags - fun_info = funInfoTable dflags iptr + platform = profilePlatform profile + fun_info = funInfoTable profile iptr rep = cmmBits (widthFromBytes rep_bytes) tablesNextToCode = platformTablesNextToCode platform (rep_bytes, offset) | tablesNextToCode = ( pc_REP_StgFunInfoExtraRev_arity pc - , oFFSET_StgFunInfoExtraRev_arity dflags ) + , pc_OFFSET_StgFunInfoExtraRev_arity pc ) | otherwise = ( pc_REP_StgFunInfoExtraFwd_arity pc - , oFFSET_StgFunInfoExtraFwd_arity dflags ) + , pc_OFFSET_StgFunInfoExtraFwd_arity pc ) pc = platformConstants platform @@ -559,13 +567,13 @@ funInfoArity dflags iptr -- ----------------------------------------------------------------------------- -stdInfoTableSizeW :: DynFlags -> WordOff +stdInfoTableSizeW :: Profile -> WordOff -- The size of a standard info table varies with profiling/ticky etc, -- so we can't get it from Constants -- It must vary in sync with mkStdInfoTable -stdInfoTableSizeW dflags +stdInfoTableSizeW profile = fixedInfoTableSizeW - + if sccProfilingEnabled dflags + + if profileIsProfiling profile then profInfoTableSizeW else 0 @@ -586,28 +594,24 @@ maxRetInfoTableSizeW = maxStdInfoTableSizeW + 1 {- srt label -} -stdInfoTableSizeB :: DynFlags -> ByteOff -stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * platformWordSizeInBytes platform - where platform = targetPlatform dflags +stdInfoTableSizeB :: Profile -> ByteOff +stdInfoTableSizeB profile = stdInfoTableSizeW profile * profileWordSizeInBytes profile -stdSrtBitmapOffset :: DynFlags -> ByteOff --- Byte offset of the SRT bitmap half-word which is --- in the *higher-addressed* part of the type_lit -stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - halfWordSize platform - where platform = targetPlatform dflags +-- | Byte offset of the SRT bitmap half-word which is in the *higher-addressed* +-- part of the type_lit +stdSrtBitmapOffset :: Profile -> ByteOff +stdSrtBitmapOffset profile = stdInfoTableSizeB profile - halfWordSize (profilePlatform profile) -stdClosureTypeOffset :: DynFlags -> ByteOff --- Byte offset of the closure type half-word -stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - platformWordSizeInBytes platform - where platform = targetPlatform dflags +-- | Byte offset of the closure type half-word +stdClosureTypeOffset :: Profile -> ByteOff +stdClosureTypeOffset profile = stdInfoTableSizeB profile - profileWordSizeInBytes profile -stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff -stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * platformWordSizeInBytes platform - where platform = targetPlatform dflags +stdPtrsOffset :: Profile -> ByteOff +stdPtrsOffset profile = stdInfoTableSizeB profile - 2 * profileWordSizeInBytes profile -stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * platformWordSizeInBytes platform + halfWordSize platform - where platform = targetPlatform dflags +stdNonPtrsOffset :: Profile -> ByteOff +stdNonPtrsOffset profile = stdInfoTableSizeB profile - 2 * profileWordSizeInBytes profile + + halfWordSize (profilePlatform profile) -conInfoTableSizeB :: DynFlags -> Int -conInfoTableSizeB dflags = stdInfoTableSizeB dflags + platformWordSizeInBytes platform - where platform = targetPlatform dflags +conInfoTableSizeB :: Profile -> Int +conInfoTableSizeB profile = stdInfoTableSizeB profile + profileWordSizeInBytes profile |