module GHC.Cmm.Info (
mkEmptyContInfoTable,
cmmToRawCmm,
srtEscape,
closureInfoPtr,
entryCode,
getConstrTag,
cmmGetClosureType,
infoTable,
infoTableConstrTag,
infoTableSrtBitmap,
infoTableClosureType,
infoTablePtrs,
infoTableNonPtrs,
funInfoTable,
funInfoArity,
stdInfoTableSizeW,
fixedInfoTableSizeW,
profInfoTableSizeW,
maxStdInfoTableSizeW,
maxRetInfoTableSizeW,
stdInfoTableSizeB,
conInfoTableSizeB,
stdSrtBitmapOffset,
stdClosureTypeOffset,
stdPtrsOffset, stdNonPtrsOffset,
) where
import GHC.Prelude
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.StgToCmm.CgUtils (CgStream)
import GHC.Runtime.Heap.Layout
import GHC.Data.Bitmap
import qualified GHC.Data.Stream as Stream
import GHC.Cmm.Dataflow.Label
import GHC.Platform
import GHC.Platform.Profile
import GHC.Data.Maybe
import GHC.Utils.Error (withTimingSilent)
import GHC.Utils.Panic
import GHC.Utils.Logger
import GHC.Utils.Monad
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Types.Unique.DSM
import Data.ByteString (ByteString)
mkEmptyContInfoTable :: CLabel -> CmmInfoTable
mkEmptyContInfoTable :: CLabel -> CmmInfoTable
mkEmptyContInfoTable CLabel
info_lbl
= CmmInfoTable { cit_lbl :: CLabel
cit_lbl = CLabel
info_lbl
, cit_rep :: SMRep
cit_rep = [Bool] -> SMRep
mkStackRep []
, cit_prof :: ProfilingInfo
cit_prof = ProfilingInfo
NoProfilingInfo
, cit_srt :: Maybe CLabel
cit_srt = Maybe CLabel
forall a. Maybe a
Nothing
, cit_clo :: Maybe (Id, CostCentreStack)
cit_clo = Maybe (Id, CostCentreStack)
forall a. Maybe a
Nothing }
cmmToRawCmm :: Logger -> Profile -> CgStream CmmGroupSRTs a
-> IO (CgStream RawCmmGroup a)
cmmToRawCmm :: forall a.
Logger
-> Profile
-> CgStream CmmGroupSRTs a
-> IO (CgStream RawCmmGroup a)
cmmToRawCmm Logger
logger Profile
profile CgStream CmmGroupSRTs a
cmms
= do { let do_one :: [CmmDeclSRTs] -> UniqDSMT IO [RawCmmDecl]
do_one :: CmmGroupSRTs -> UniqDSMT IO RawCmmGroup
do_one CmmGroupSRTs
cmm = Char -> UniqDSMT IO RawCmmGroup -> UniqDSMT IO RawCmmGroup
forall (m :: * -> *) a.
Monad m =>
Char -> UniqDSMT m a -> UniqDSMT m a
setTagUDSMT Char
'i' (UniqDSMT IO RawCmmGroup -> UniqDSMT IO RawCmmGroup)
-> UniqDSMT IO RawCmmGroup -> UniqDSMT IO RawCmmGroup
forall a b. (a -> b) -> a -> b
$ do
Logger
-> SDoc
-> (RawCmmGroup -> ())
-> UniqDSMT IO RawCmmGroup
-> UniqDSMT IO RawCmmGroup
forall (m :: * -> *) a.
MonadIO m =>
Logger -> SDoc -> (a -> ()) -> m a -> m a
withTimingSilent Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cmm -> Raw Cmm") (\RawCmmGroup
x -> RawCmmGroup -> () -> ()
forall a b. [a] -> b -> b
seqList RawCmmGroup
x ()) (UniqDSMT IO RawCmmGroup -> UniqDSMT IO RawCmmGroup)
-> UniqDSMT IO RawCmmGroup -> UniqDSMT IO RawCmmGroup
forall a b. (a -> b) -> a -> b
$ do
UniqDSM RawCmmGroup -> UniqDSMT IO RawCmmGroup
forall a. UniqDSM a -> UniqDSMT IO a
forall (m :: * -> *) a. MonadUniqDSM m => UniqDSM a -> m a
liftUniqDSM (UniqDSM RawCmmGroup -> UniqDSMT IO RawCmmGroup)
-> UniqDSM RawCmmGroup -> UniqDSMT IO RawCmmGroup
forall a b. (a -> b) -> a -> b
$
(CmmDeclSRTs -> UniqDSM RawCmmGroup)
-> CmmGroupSRTs -> UniqDSM RawCmmGroup
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM (Profile -> CmmDeclSRTs -> UniqDSM RawCmmGroup
mkInfoTable Profile
profile) CmmGroupSRTs
cmm
; CgStream RawCmmGroup a -> IO (CgStream RawCmmGroup a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CmmGroupSRTs -> UniqDSMT IO RawCmmGroup)
-> CgStream CmmGroupSRTs a -> CgStream RawCmmGroup a
forall (m :: * -> *) a b x.
Monad m =>
(a -> m b) -> Stream m a x -> Stream m b x
Stream.mapM CmmGroupSRTs -> UniqDSMT IO RawCmmGroup
do_one CgStream CmmGroupSRTs a
cmms)
}
mkInfoTable :: Profile -> CmmDeclSRTs -> UniqDSM [RawCmmDecl]
mkInfoTable :: Profile -> CmmDeclSRTs -> UniqDSM RawCmmGroup
mkInfoTable Profile
_ (CmmData Section
sec RawCmmStatics
dat) = RawCmmGroup -> UniqDSM RawCmmGroup
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Section
-> RawCmmStatics
-> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec RawCmmStatics
dat]
mkInfoTable Profile
profile proc :: CmmDeclSRTs
proc@(CmmProc CmmTopInfo
infos CLabel
entry_lbl [GlobalRegUse]
live CmmGraph
blocks)
| Bool -> Bool
not (Platform -> Bool
platformTablesNextToCode Platform
platform)
= case CmmDeclSRTs -> Maybe CmmInfoTable
forall a (s :: * -> *) (n :: Extensibility -> Extensibility -> *).
GenCmmDecl a CmmTopInfo (GenGenCmmGraph s n) -> Maybe CmmInfoTable
topInfoTable CmmDeclSRTs
proc of
Maybe CmmInfoTable
Nothing ->
RawCmmGroup -> UniqDSM RawCmmGroup
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return [LabelMap RawCmmStatics
-> CLabel
-> [GlobalRegUse]
-> CmmGraph
-> GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
forall d h g.
h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
forall v. LabelMap v
mapEmpty CLabel
entry_lbl [GlobalRegUse]
live CmmGraph
blocks]
Just info :: CmmInfoTable
info@CmmInfoTable { cit_lbl :: CmmInfoTable -> CLabel
cit_lbl = CLabel
info_lbl } -> do
(top_decls, (std_info, extra_bits)) <-
Profile
-> CmmInfoTable
-> Maybe WordOff
-> UniqDSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents Profile
profile CmmInfoTable
info Maybe WordOff
forall a. Maybe a
Nothing
let
rel_std_info = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo Platform
platform CLabel
info_lbl) [CmmLit]
std_info
rel_extra_bits = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo Platform
platform CLabel
info_lbl) [CmmLit]
extra_bits
return (top_decls ++
[CmmProc mapEmpty entry_lbl live blocks,
mkRODataLits info_lbl
(CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
| Bool
otherwise
= do
(top_declss, raw_infos) <-
[(RawCmmGroup, (Label, RawCmmStatics))]
-> ([RawCmmGroup], [(Label, RawCmmStatics)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(RawCmmGroup, (Label, RawCmmStatics))]
-> ([RawCmmGroup], [(Label, RawCmmStatics)]))
-> UniqDSM [(RawCmmGroup, (Label, RawCmmStatics))]
-> UniqDSM ([RawCmmGroup], [(Label, RawCmmStatics)])
forall a b. (a -> b) -> UniqDSM a -> UniqDSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ((Label, CmmInfoTable)
-> UniqDSM (RawCmmGroup, (Label, RawCmmStatics)))
-> [(Label, CmmInfoTable)]
-> UniqDSM [(RawCmmGroup, (Label, RawCmmStatics))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Label, CmmInfoTable)
-> UniqDSM (RawCmmGroup, (Label, RawCmmStatics))
do_one_info (LabelMap CmmInfoTable -> [(Label, CmmInfoTable)]
forall b. LabelMap b -> [(Label, b)]
mapToList (CmmTopInfo -> LabelMap CmmInfoTable
forall (f :: * -> *). GenCmmTopInfo f -> f CmmInfoTable
info_tbls CmmTopInfo
infos))
return (concat top_declss ++
[CmmProc (mapFromList raw_infos) entry_lbl live blocks])
where
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
do_one_info :: (Label, CmmInfoTable)
-> UniqDSM (RawCmmGroup, (Label, RawCmmStatics))
do_one_info (Label
lbl,CmmInfoTable
itbl) = do
(top_decls, (std_info, extra_bits)) <-
Profile
-> CmmInfoTable
-> Maybe WordOff
-> UniqDSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents Profile
profile CmmInfoTable
itbl Maybe WordOff
forall a. Maybe a
Nothing
let
info_lbl = CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
itbl
rel_std_info = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo Platform
platform CLabel
info_lbl) [CmmLit]
std_info
rel_extra_bits = (CmmLit -> CmmLit) -> [CmmLit] -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo Platform
platform CLabel
info_lbl) [CmmLit]
extra_bits
return (top_decls, (lbl, CmmStaticsRaw info_lbl $ map CmmStaticLit $
reverse rel_extra_bits ++ rel_std_info))
type InfoTableContents = ( [CmmLit]
, [CmmLit] )
mkInfoTableContents :: Profile
-> CmmInfoTable
-> Maybe Int
-> UniqDSM ([RawCmmDecl],
InfoTableContents)
mkInfoTableContents :: Profile
-> CmmInfoTable
-> Maybe WordOff
-> UniqDSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents Profile
profile
info :: CmmInfoTable
info@(CmmInfoTable { cit_lbl :: CmmInfoTable -> CLabel
cit_lbl = CLabel
info_lbl
, cit_rep :: CmmInfoTable -> SMRep
cit_rep = SMRep
smrep
, cit_prof :: CmmInfoTable -> ProfilingInfo
cit_prof = ProfilingInfo
prof
, cit_srt :: CmmInfoTable -> Maybe CLabel
cit_srt = Maybe CLabel
srt })
Maybe WordOff
mb_rts_tag
| RTSRep WordOff
rts_tag SMRep
rep <- SMRep
smrep
= Profile
-> CmmInfoTable
-> Maybe WordOff
-> UniqDSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents Profile
profile CmmInfoTable
info{cit_rep = rep} (WordOff -> Maybe WordOff
forall a. a -> Maybe a
Just WordOff
rts_tag)
| StackRep [Bool]
frame <- SMRep
smrep
= do { (prof_lits, prof_data) <- Platform
-> ProfilingInfo -> UniqDSM ((CmmLit, CmmLit), RawCmmGroup)
mkProfLits Platform
platform ProfilingInfo
prof
; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
; (liveness_lit, liveness_data) <- mkLivenessBits platform frame
; let
std_info = Profile
-> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
mkStdInfoTable Profile
profile (CmmLit, CmmLit)
prof_lits WordOff
rts_tag CmmLit
srt_bitmap CmmLit
liveness_lit
rts_tag | Just WordOff
tag <- Maybe WordOff
mb_rts_tag = WordOff
tag
| RawCmmGroup -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RawCmmGroup
liveness_data = WordOff
rET_SMALL
| Bool
otherwise = WordOff
rET_BIG
; return (prof_data ++ liveness_data, (std_info, srt_label)) }
| HeapRep Bool
_ WordOff
ptrs WordOff
nonptrs ClosureTypeInfo
closure_type <- SMRep
smrep
= do { let layout :: CmmLit
layout = Platform -> WordOff -> WordOff -> CmmLit
packIntsCLit Platform
platform WordOff
ptrs WordOff
nonptrs
; (prof_lits, prof_data) <- Platform
-> ProfilingInfo -> UniqDSM ((CmmLit, CmmLit), RawCmmGroup)
mkProfLits Platform
platform ProfilingInfo
prof
; let (srt_label, srt_bitmap) = mkSRTLit platform info_lbl srt
; (mb_srt_field, mb_layout, extra_bits, ct_data)
<- mk_pieces closure_type srt_label
; let std_info = Profile
-> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
mkStdInfoTable Profile
profile (CmmLit, CmmLit)
prof_lits
(Maybe WordOff
mb_rts_tag Maybe WordOff -> WordOff -> WordOff
forall a. Maybe a -> a -> a
`orElse` SMRep -> WordOff
rtsClosureType SMRep
smrep)
(Maybe CmmLit
mb_srt_field Maybe CmmLit -> CmmLit -> CmmLit
forall a. Maybe a -> a -> a
`orElse` CmmLit
srt_bitmap)
(Maybe CmmLit
mb_layout Maybe CmmLit -> CmmLit -> CmmLit
forall a. Maybe a -> a -> a
`orElse` CmmLit
layout)
; return (prof_data ++ ct_data, (std_info, extra_bits)) }
where
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
mk_pieces :: ClosureTypeInfo -> [CmmLit]
-> UniqDSM ( Maybe CmmLit
, Maybe CmmLit
, [CmmLit]
, [RawCmmDecl])
mk_pieces :: ClosureTypeInfo
-> [CmmLit]
-> UniqDSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
mk_pieces (Constr WordOff
con_tag ConstrDescription
con_descr) [CmmLit]
_no_srt
= do { (descr_lit, decl) <- ConstrDescription
-> UniqDSM
(CmmLit,
GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph)
forall info stmt.
ConstrDescription
-> UniqDSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit ConstrDescription
con_descr
; return ( Just (CmmInt (fromIntegral con_tag)
(halfWordWidth platform))
, Nothing, [descr_lit], [decl]) }
mk_pieces ClosureTypeInfo
Thunk [CmmLit]
srt_label
= (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
-> UniqDSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CmmLit
forall a. Maybe a
Nothing, Maybe CmmLit
forall a. Maybe a
Nothing, [CmmLit]
srt_label, [])
mk_pieces (ThunkSelector WordOff
offset) [CmmLit]
_no_srt
= (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
-> UniqDSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmLit -> Maybe CmmLit
forall a. a -> Maybe a
Just (Integer -> Width -> CmmLit
CmmInt Integer
0 (Platform -> Width
halfWordWidth Platform
platform)),
CmmLit -> Maybe CmmLit
forall a. a -> Maybe a
Just (Platform -> Integer -> CmmLit
mkWordCLit Platform
platform (WordOff -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
offset)), [], [])
mk_pieces (Fun WordOff
arity (ArgSpec WordOff
fun_type)) [CmmLit]
srt_label
= do { let extra_bits :: [CmmLit]
extra_bits = Platform -> WordOff -> WordOff -> CmmLit
packIntsCLit Platform
platform WordOff
fun_type WordOff
arity CmmLit -> [CmmLit] -> [CmmLit]
forall a. a -> [a] -> [a]
: [CmmLit]
srt_label
; (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
-> UniqDSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CmmLit
forall a. Maybe a
Nothing, Maybe CmmLit
forall a. Maybe a
Nothing, [CmmLit]
extra_bits, []) }
mk_pieces (Fun WordOff
arity (ArgGen [Bool]
arg_bits)) [CmmLit]
srt_label
= do { (liveness_lit, liveness_data) <- Platform -> [Bool] -> UniqDSM (CmmLit, RawCmmGroup)
mkLivenessBits Platform
platform [Bool]
arg_bits
; let fun_type | RawCmmGroup -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RawCmmGroup
liveness_data = WordOff
aRG_GEN
| Bool
otherwise = WordOff
aRG_GEN_BIG
extra_bits = [ Platform -> WordOff -> WordOff -> CmmLit
packIntsCLit Platform
platform WordOff
fun_type WordOff
arity ]
[CmmLit] -> [CmmLit] -> [CmmLit]
forall a. [a] -> [a] -> [a]
++ (if Platform -> Bool
inlineSRT Platform
platform then [] else [ CmmLit
srt_lit ])
[CmmLit] -> [CmmLit] -> [CmmLit]
forall a. [a] -> [a] -> [a]
++ [ CmmLit
liveness_lit, CmmLit
slow_entry ]
; return (Nothing, Nothing, extra_bits, liveness_data) }
where
slow_entry :: CmmLit
slow_entry = CLabel -> CmmLit
CmmLabel (Platform -> CLabel -> CLabel
toSlowEntryLbl Platform
platform CLabel
info_lbl)
srt_lit :: CmmLit
srt_lit = case [CmmLit]
srt_label of
[] -> Platform -> WordOff -> CmmLit
mkIntCLit Platform
platform WordOff
0
(CmmLit
lit:[CmmLit]
_rest) -> Bool -> CmmLit -> CmmLit
forall a. HasCallStack => Bool -> a -> a
assert ([CmmLit] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CmmLit]
_rest) CmmLit
lit
mk_pieces ClosureTypeInfo
other [CmmLit]
_ = String
-> SDoc
-> UniqDSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mk_pieces" (ClosureTypeInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ClosureTypeInfo
other)
mkInfoTableContents Profile
_ CmmInfoTable
_ Maybe WordOff
_ = String -> UniqDSM (RawCmmGroup, InfoTableContents)
forall a. HasCallStack => String -> a
panic String
"mkInfoTableContents"
packIntsCLit :: Platform -> Int -> Int -> CmmLit
packIntsCLit :: Platform -> WordOff -> WordOff -> CmmLit
packIntsCLit Platform
platform WordOff
a WordOff
b = Platform -> StgHalfWord -> StgHalfWord -> CmmLit
packHalfWordsCLit Platform
platform
(Platform -> Integer -> StgHalfWord
toStgHalfWord Platform
platform (WordOff -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
a))
(Platform -> Integer -> StgHalfWord
toStgHalfWord Platform
platform (WordOff -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
b))
mkSRTLit :: Platform
-> CLabel
-> Maybe CLabel
-> ([CmmLit],
CmmLit)
mkSRTLit :: Platform -> CLabel -> Maybe CLabel -> ([CmmLit], CmmLit)
mkSRTLit Platform
platform CLabel
info_lbl (Just CLabel
lbl)
| Platform -> Bool
inlineSRT Platform
platform
= ([], CLabel -> CLabel -> WordOff -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
info_lbl WordOff
0 (Platform -> Width
halfWordWidth Platform
platform))
mkSRTLit Platform
platform CLabel
_ Maybe CLabel
Nothing = ([], Integer -> Width -> CmmLit
CmmInt Integer
0 (Platform -> Width
halfWordWidth Platform
platform))
mkSRTLit Platform
platform CLabel
_ (Just CLabel
lbl) = ([CLabel -> CmmLit
CmmLabel CLabel
lbl], Integer -> Width -> CmmLit
CmmInt Integer
1 (Platform -> Width
halfWordWidth Platform
platform))
inlineSRT :: Platform -> Bool
inlineSRT :: Platform -> Bool
inlineSRT = PlatformConstants -> Bool
pc_USE_INLINE_SRT_FIELD (PlatformConstants -> Bool)
-> (Platform -> PlatformConstants) -> Platform -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> PlatformConstants
platformConstants
makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo :: Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo Platform
platform CLabel
info_lbl CmmLit
lit
= if Platform -> Bool
platformTablesNextToCode Platform
platform
then case CmmLit
lit of
CmmLabel CLabel
lbl -> CLabel -> CLabel -> WordOff -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
info_lbl WordOff
0 (Platform -> Width
wordWidth Platform
platform)
CmmLabelOff CLabel
lbl WordOff
off -> CLabel -> CLabel -> WordOff -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
info_lbl WordOff
off (Platform -> Width
wordWidth Platform
platform)
CmmLit
_ -> CmmLit
lit
else CmmLit
lit
mkLivenessBits :: Platform -> Liveness -> UniqDSM (CmmLit, [RawCmmDecl])
mkLivenessBits :: Platform -> [Bool] -> UniqDSM (CmmLit, RawCmmGroup)
mkLivenessBits Platform
platform [Bool]
liveness
| WordOff
n_bits WordOff -> WordOff -> Bool
forall a. Ord a => a -> a -> Bool
> Platform -> WordOff
mAX_SMALL_BITMAP_SIZE Platform
platform
= do { uniq <- UniqDSM Unique
getUniqueDSM
; let bitmap_lbl = Unique -> CLabel
mkBitmapLabel Unique
uniq
; return (CmmLabel bitmap_lbl,
[mkRODataLits bitmap_lbl lits]) }
| Bool
otherwise
= (CmmLit, RawCmmGroup) -> UniqDSM (CmmLit, RawCmmGroup)
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Platform -> StgWord -> CmmLit
mkStgWordCLit Platform
platform StgWord
bitmap_word, [])
where
n_bits :: WordOff
n_bits = [Bool] -> WordOff
forall a. [a] -> WordOff
forall (t :: * -> *) a. Foldable t => t a -> WordOff
length [Bool]
liveness
bitmap :: Bitmap
bitmap :: Bitmap
bitmap = Platform -> [Bool] -> Bitmap
mkBitmap Platform
platform [Bool]
liveness
small_bitmap :: StgWord
small_bitmap = case Bitmap
bitmap of
[] -> Platform -> Integer -> StgWord
toStgWord Platform
platform Integer
0
[StgWord
b] -> StgWord
b
Bitmap
_ -> String -> StgWord
forall a. HasCallStack => String -> a
panic String
"mkLiveness"
bitmap_word :: StgWord
bitmap_word = Platform -> Integer -> StgWord
toStgWord Platform
platform (WordOff -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
n_bits)
StgWord -> StgWord -> StgWord
forall a. Bits a => a -> a -> a
.|. (StgWord
small_bitmap StgWord -> WordOff -> StgWord
forall a. Bits a => a -> WordOff -> a
`shiftL` PlatformConstants -> WordOff
pc_BITMAP_BITS_SHIFT (Platform -> PlatformConstants
platformConstants Platform
platform))
lits :: [CmmLit]
lits = Platform -> Integer -> CmmLit
mkWordCLit Platform
platform (WordOff -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
n_bits)
CmmLit -> [CmmLit] -> [CmmLit]
forall a. a -> [a] -> [a]
: (StgWord -> CmmLit) -> Bitmap -> [CmmLit]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> StgWord -> CmmLit
mkStgWordCLit Platform
platform) Bitmap
bitmap
mkStdInfoTable
:: Profile
-> (CmmLit,CmmLit)
-> Int
-> CmmLit
-> CmmLit
-> [CmmLit]
mkStdInfoTable :: Profile
-> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
mkStdInfoTable Profile
profile (CmmLit
type_descr, CmmLit
closure_descr) WordOff
cl_type CmmLit
srt CmmLit
layout_lit
=
[CmmLit]
prof_info
[CmmLit] -> [CmmLit] -> [CmmLit]
forall a. [a] -> [a] -> [a]
++ [CmmLit
layout_lit, CmmLit
tag, CmmLit
srt]
where
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
prof_info :: [CmmLit]
prof_info
| Profile -> Bool
profileIsProfiling Profile
profile = [CmmLit
type_descr, CmmLit
closure_descr]
| Bool
otherwise = []
tag :: CmmLit
tag = Integer -> Width -> CmmLit
CmmInt (WordOff -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
cl_type) (Platform -> Width
halfWordWidth Platform
platform)
mkProfLits :: Platform -> ProfilingInfo -> UniqDSM ((CmmLit,CmmLit), [RawCmmDecl])
mkProfLits :: Platform
-> ProfilingInfo -> UniqDSM ((CmmLit, CmmLit), RawCmmGroup)
mkProfLits Platform
platform ProfilingInfo
NoProfilingInfo = ((CmmLit, CmmLit), RawCmmGroup)
-> UniqDSM ((CmmLit, CmmLit), RawCmmGroup)
forall a. a -> UniqDSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Platform -> CmmLit
zeroCLit Platform
platform, Platform -> CmmLit
zeroCLit Platform
platform), [])
mkProfLits Platform
_ (ProfilingInfo ConstrDescription
td ConstrDescription
cd)
= do { (td_lit, td_decl) <- ConstrDescription
-> UniqDSM
(CmmLit,
GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph)
forall info stmt.
ConstrDescription
-> UniqDSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit ConstrDescription
td
; (cd_lit, cd_decl) <- newStringLit cd
; return ((td_lit,cd_lit), [td_decl,cd_decl]) }
newStringLit :: ByteString -> UniqDSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit :: forall info stmt.
ConstrDescription
-> UniqDSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit ConstrDescription
bytes
= do { uniq <- UniqDSM Unique
getUniqueDSM
; return (mkByteStringCLit (mkStringLitLabel uniq) bytes) }
srtEscape :: Platform -> StgHalfWord
srtEscape :: Platform -> StgHalfWord
srtEscape Platform
platform = Platform -> Integer -> StgHalfWord
toStgHalfWord Platform
platform (-Integer
1)
wordAligned :: Platform -> DoAlignSanitisation -> CmmExpr -> CmmExpr
wordAligned :: Platform -> Bool -> CmmExpr -> CmmExpr
wordAligned Platform
platform Bool
align_check CmmExpr
e
| Bool
align_check
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (WordOff -> Width -> MachOp
MO_AlignmentCheck (Platform -> WordOff
platformWordSizeInBytes Platform
platform) (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
e]
| Bool
otherwise
= CmmExpr
e
closureInfoPtr :: Platform -> DoAlignSanitisation -> CmmExpr -> CmmExpr
closureInfoPtr :: Platform -> Bool -> CmmExpr -> CmmExpr
closureInfoPtr Platform
platform Bool
align_check CmmExpr
e =
MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_RelaxedRead (Platform -> Width
wordWidth Platform
platform)) [Platform -> Bool -> CmmExpr -> CmmExpr
wordAligned Platform
platform Bool
align_check CmmExpr
e]
entryCode :: Platform -> CmmExpr -> CmmExpr
entryCode :: Platform -> CmmExpr -> CmmExpr
entryCode Platform
platform CmmExpr
e =
if Platform -> Bool
platformTablesNextToCode Platform
platform
then CmmExpr
e
else Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform CmmExpr
e
getConstrTag :: Profile -> DoAlignSanitisation -> CmmExpr -> CmmExpr
getConstrTag :: Profile -> Bool -> CmmExpr -> CmmExpr
getConstrTag Profile
profile Bool
align_check CmmExpr
closure_ptr
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
halfWordWidth Platform
platform) (Platform -> Width
wordWidth Platform
platform)) [Profile -> CmmExpr -> CmmExpr
infoTableConstrTag Profile
profile CmmExpr
info_table]
where
info_table :: CmmExpr
info_table = Profile -> CmmExpr -> CmmExpr
infoTable Profile
profile (Platform -> Bool -> CmmExpr -> CmmExpr
closureInfoPtr Platform
platform Bool
align_check CmmExpr
closure_ptr)
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
cmmGetClosureType :: Profile -> DoAlignSanitisation -> CmmExpr -> CmmExpr
cmmGetClosureType :: Profile -> Bool -> CmmExpr -> CmmExpr
cmmGetClosureType Profile
profile Bool
align_check CmmExpr
closure_ptr
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv (Platform -> Width
halfWordWidth Platform
platform) (Platform -> Width
wordWidth Platform
platform)) [Profile -> CmmExpr -> CmmExpr
infoTableClosureType Profile
profile CmmExpr
info_table]
where
info_table :: CmmExpr
info_table = Profile -> CmmExpr -> CmmExpr
infoTable Profile
profile (Platform -> Bool -> CmmExpr -> CmmExpr
closureInfoPtr Platform
platform Bool
align_check CmmExpr
closure_ptr)
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
infoTable :: Profile -> CmmExpr -> CmmExpr
infoTable :: Profile -> CmmExpr -> CmmExpr
infoTable Profile
profile CmmExpr
info_ptr
| Platform -> Bool
platformTablesNextToCode Platform
platform = Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
info_ptr (- Profile -> WordOff
stdInfoTableSizeB Profile
profile)
| Bool
otherwise = Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetW Platform
platform CmmExpr
info_ptr WordOff
1
where platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
infoTableConstrTag :: Profile -> CmmExpr -> CmmExpr
infoTableConstrTag :: Profile -> CmmExpr -> CmmExpr
infoTableConstrTag = Profile -> CmmExpr -> CmmExpr
infoTableSrtBitmap
infoTableSrtBitmap :: Profile -> CmmExpr -> CmmExpr
infoTableSrtBitmap :: Profile -> CmmExpr -> CmmExpr
infoTableSrtBitmap Profile
profile CmmExpr
info_tbl
= CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
info_tbl (Profile -> WordOff
stdSrtBitmapOffset Profile
profile)) (Platform -> CmmType
bHalfWord Platform
platform) AlignmentSpec
NaturallyAligned
where platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
infoTableClosureType :: Profile -> CmmExpr -> CmmExpr
infoTableClosureType :: Profile -> CmmExpr -> CmmExpr
infoTableClosureType Profile
profile CmmExpr
info_tbl
= CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
info_tbl (Profile -> WordOff
stdClosureTypeOffset Profile
profile)) (Platform -> CmmType
bHalfWord Platform
platform) AlignmentSpec
NaturallyAligned
where platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
infoTablePtrs :: Profile -> CmmExpr -> CmmExpr
infoTablePtrs :: Profile -> CmmExpr -> CmmExpr
infoTablePtrs Profile
profile CmmExpr
info_tbl
= CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
info_tbl (Profile -> WordOff
stdPtrsOffset Profile
profile)) (Platform -> CmmType
bHalfWord Platform
platform) AlignmentSpec
NaturallyAligned
where platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
infoTableNonPtrs :: Profile -> CmmExpr -> CmmExpr
infoTableNonPtrs :: Profile -> CmmExpr -> CmmExpr
infoTableNonPtrs Profile
profile CmmExpr
info_tbl
= CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad (Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
info_tbl (Profile -> WordOff
stdNonPtrsOffset Profile
profile)) (Platform -> CmmType
bHalfWord Platform
platform) AlignmentSpec
NaturallyAligned
where platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
funInfoTable :: Profile -> CmmExpr -> CmmExpr
funInfoTable :: Profile -> CmmExpr -> CmmExpr
funInfoTable Profile
profile CmmExpr
info_ptr
| Platform -> Bool
platformTablesNextToCode Platform
platform
= Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetB Platform
platform CmmExpr
info_ptr (- Profile -> WordOff
stdInfoTableSizeB Profile
profile WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
- PlatformConstants -> WordOff
pc_SIZEOF_StgFunInfoExtraRev (Platform -> PlatformConstants
platformConstants Platform
platform))
| Bool
otherwise
= Platform -> CmmExpr -> WordOff -> CmmExpr
cmmOffsetW Platform
platform CmmExpr
info_ptr (WordOff
1 WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ Profile -> WordOff
stdInfoTableSizeW Profile
profile)
where
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
funInfoArity :: Profile -> CmmExpr -> CmmExpr
funInfoArity :: Profile -> CmmExpr -> CmmExpr
funInfoArity Profile
profile CmmExpr
iptr
= Platform -> CmmExpr -> CmmExpr
cmmToWord Platform
platform (Platform -> CmmType -> CmmExpr -> WordOff -> CmmExpr
cmmLoadIndex Platform
platform CmmType
rep CmmExpr
fun_info (WordOff
offset WordOff -> WordOff -> WordOff
forall a. Integral a => a -> a -> a
`div` WordOff
rep_bytes))
where
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
fun_info :: CmmExpr
fun_info = Profile -> CmmExpr -> CmmExpr
funInfoTable Profile
profile CmmExpr
iptr
rep :: CmmType
rep = Width -> CmmType
cmmBits (WordOff -> Width
widthFromBytes WordOff
rep_bytes)
tablesNextToCode :: Bool
tablesNextToCode = Platform -> Bool
platformTablesNextToCode Platform
platform
(WordOff
rep_bytes, WordOff
offset)
| Bool
tablesNextToCode = ( PlatformConstants -> WordOff
pc_REP_StgFunInfoExtraRev_arity PlatformConstants
pc
, PlatformConstants -> WordOff
pc_OFFSET_StgFunInfoExtraRev_arity PlatformConstants
pc )
| Bool
otherwise = ( PlatformConstants -> WordOff
pc_REP_StgFunInfoExtraFwd_arity PlatformConstants
pc
, PlatformConstants -> WordOff
pc_OFFSET_StgFunInfoExtraFwd_arity PlatformConstants
pc )
pc :: PlatformConstants
pc = Platform -> PlatformConstants
platformConstants Platform
platform
stdInfoTableSizeW :: Profile -> WordOff
stdInfoTableSizeW :: Profile -> WordOff
stdInfoTableSizeW Profile
profile
= WordOff
fixedInfoTableSizeW
WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ if Profile -> Bool
profileIsProfiling Profile
profile
then WordOff
profInfoTableSizeW
else WordOff
0
fixedInfoTableSizeW :: WordOff
fixedInfoTableSizeW :: WordOff
fixedInfoTableSizeW = WordOff
2
profInfoTableSizeW :: WordOff
profInfoTableSizeW :: WordOff
profInfoTableSizeW = WordOff
2
maxStdInfoTableSizeW :: WordOff
maxStdInfoTableSizeW :: WordOff
maxStdInfoTableSizeW =
WordOff
1
WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ WordOff
fixedInfoTableSizeW
WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ WordOff
profInfoTableSizeW
maxRetInfoTableSizeW :: WordOff
maxRetInfoTableSizeW :: WordOff
maxRetInfoTableSizeW =
WordOff
maxStdInfoTableSizeW
WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ WordOff
1
stdInfoTableSizeB :: Profile -> ByteOff
stdInfoTableSizeB :: Profile -> WordOff
stdInfoTableSizeB Profile
profile = Profile -> WordOff
stdInfoTableSizeW Profile
profile WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
* Profile -> WordOff
profileWordSizeInBytes Profile
profile
stdSrtBitmapOffset :: Profile -> ByteOff
stdSrtBitmapOffset :: Profile -> WordOff
stdSrtBitmapOffset Profile
profile = Profile -> WordOff
stdInfoTableSizeB Profile
profile WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
- Platform -> WordOff
halfWordSize (Profile -> Platform
profilePlatform Profile
profile)
stdClosureTypeOffset :: Profile -> ByteOff
stdClosureTypeOffset :: Profile -> WordOff
stdClosureTypeOffset Profile
profile = Profile -> WordOff
stdInfoTableSizeB Profile
profile WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
- Profile -> WordOff
profileWordSizeInBytes Profile
profile
stdPtrsOffset :: Profile -> ByteOff
stdPtrsOffset :: Profile -> WordOff
stdPtrsOffset Profile
profile = Profile -> WordOff
stdInfoTableSizeB Profile
profile WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
- WordOff
2 WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
* Profile -> WordOff
profileWordSizeInBytes Profile
profile
stdNonPtrsOffset :: Profile -> ByteOff
stdNonPtrsOffset :: Profile -> WordOff
stdNonPtrsOffset Profile
profile = Profile -> WordOff
stdInfoTableSizeB Profile
profile WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
- WordOff
2 WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
* Profile -> WordOff
profileWordSizeInBytes Profile
profile
WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ Platform -> WordOff
halfWordSize (Profile -> Platform
profilePlatform Profile
profile)
conInfoTableSizeB :: Profile -> Int
conInfoTableSizeB :: Profile -> WordOff
conInfoTableSizeB Profile
profile = Profile -> WordOff
stdInfoTableSizeB Profile
profile WordOff -> WordOff -> WordOff
forall a. Num a => a -> a -> a
+ Profile -> WordOff
profileWordSizeInBytes Profile
profile