{-# LANGUAGE CPP #-}
module GHC.Cmm.Info (
mkEmptyContInfoTable,
cmmToRawCmm,
srtEscape,
PtrOpts (..),
closureInfoPtr,
entryCode,
getConstrTag,
cmmGetClosureType,
infoTable,
infoTableConstrTag,
infoTableSrtBitmap,
infoTableClosureType,
infoTablePtrs,
infoTableNonPtrs,
funInfoTable,
funInfoArity,
stdInfoTableSizeW,
fixedInfoTableSizeW,
profInfoTableSizeW,
maxStdInfoTableSizeW,
maxRetInfoTableSizeW,
stdInfoTableSizeB,
conInfoTableSizeB,
stdSrtBitmapOffset,
stdClosureTypeOffset,
stdPtrsOffset, stdNonPtrsOffset,
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Runtime.Heap.Layout
import GHC.Data.Bitmap
import GHC.Data.Stream (Stream)
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)
import GHC.Utils.Panic
import GHC.Types.Unique.Supply
import GHC.Utils.Logger
import GHC.Utils.Monad
import GHC.Utils.Misc
import GHC.Utils.Outputable
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 = forall a. Maybe a
Nothing
, cit_clo :: Maybe (Id, CostCentreStack)
cit_clo = forall a. Maybe a
Nothing }
cmmToRawCmm :: Logger -> DynFlags -> Stream IO CmmGroupSRTs a
-> IO (Stream IO RawCmmGroup a)
cmmToRawCmm :: forall a.
Logger
-> DynFlags
-> Stream IO CmmGroupSRTs a
-> IO (Stream IO RawCmmGroup a)
cmmToRawCmm Logger
logger DynFlags
dflags Stream IO CmmGroupSRTs a
cmms
= do {
; let do_one :: [CmmDeclSRTs] -> IO [RawCmmDecl]
do_one :: CmmGroupSRTs -> IO RawCmmGroup
do_one CmmGroupSRTs
cmm = do
UniqSupply
uniqs <- Char -> IO UniqSupply
mkSplitUniqSupply Char
'i'
forall (m :: * -> *) a.
MonadIO m =>
Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
withTimingSilent Logger
logger DynFlags
dflags (String -> SDoc
text String
"Cmm -> Raw Cmm")
(\RawCmmGroup
x -> forall a b. [a] -> b -> b
seqList RawCmmGroup
x ())
(forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. UniqSupply -> UniqSM a -> a
initUs_ UniqSupply
uniqs forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (DynFlags -> CmmDeclSRTs -> UniqSM RawCmmGroup
mkInfoTable DynFlags
dflags) CmmGroupSRTs
cmm)
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a b x.
Monad m =>
(a -> m b) -> Stream m a x -> Stream m b x
Stream.mapM CmmGroupSRTs -> IO RawCmmGroup
do_one Stream IO CmmGroupSRTs a
cmms)
}
mkInfoTable :: DynFlags -> CmmDeclSRTs -> UniqSM [RawCmmDecl]
mkInfoTable :: DynFlags -> CmmDeclSRTs -> UniqSM RawCmmGroup
mkInfoTable DynFlags
_ (CmmData Section
sec RawCmmStatics
dat) = forall (m :: * -> *) a. Monad m => a -> m a
return [forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec RawCmmStatics
dat]
mkInfoTable DynFlags
dflags proc :: CmmDeclSRTs
proc@(CmmProc CmmTopInfo
infos CLabel
entry_lbl [GlobalReg]
live CmmGraph
blocks)
| Bool -> Bool
not (Platform -> Bool
platformTablesNextToCode (DynFlags -> Platform
targetPlatform DynFlags
dflags))
= case forall a (n :: Extensibility -> Extensibility -> *).
GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable CmmDeclSRTs
proc of
Maybe CmmInfoTable
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return [forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc forall (map :: * -> *) a. IsMap map => map a
mapEmpty CLabel
entry_lbl [GlobalReg]
live CmmGraph
blocks]
Just info :: CmmInfoTable
info@CmmInfoTable { cit_lbl :: CmmInfoTable -> CLabel
cit_lbl = CLabel
info_lbl } -> do
(RawCmmGroup
top_decls, ([CmmLit]
std_info, [CmmLit]
extra_bits)) <-
DynFlags
-> CmmInfoTable
-> Maybe WordOff
-> UniqSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents DynFlags
dflags CmmInfoTable
info forall a. Maybe a
Nothing
let
rel_std_info :: [CmmLit]
rel_std_info = 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]
rel_extra_bits = forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo Platform
platform CLabel
info_lbl) [CmmLit]
extra_bits
forall (m :: * -> *) a. Monad m => a -> m a
return (RawCmmGroup
top_decls forall a. [a] -> [a] -> [a]
++
[forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc forall (map :: * -> *) a. IsMap map => map a
mapEmpty CLabel
entry_lbl [GlobalReg]
live CmmGraph
blocks,
forall (raw :: Bool) info stmt.
CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
mkRODataLits CLabel
info_lbl
(CLabel -> CmmLit
CmmLabel CLabel
entry_lbl forall a. a -> [a] -> [a]
: [CmmLit]
rel_std_info forall a. [a] -> [a] -> [a]
++ [CmmLit]
rel_extra_bits)])
| Bool
otherwise
= do
([RawCmmGroup]
top_declss, [(Label, RawCmmStatics)]
raw_infos) <-
forall a b. [(a, b)] -> ([a], [b])
unzip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Label, CmmInfoTable)
-> UniqSM (RawCmmGroup, (Label, RawCmmStatics))
do_one_info (forall (map :: * -> *) a. IsMap map => map a -> [(KeyOf map, a)]
mapToList (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
infos))
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [RawCmmGroup]
top_declss forall a. [a] -> [a] -> [a]
++
[forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc (forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList [(Label, RawCmmStatics)]
raw_infos) CLabel
entry_lbl [GlobalReg]
live CmmGraph
blocks])
where
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
do_one_info :: (Label, CmmInfoTable)
-> UniqSM (RawCmmGroup, (Label, RawCmmStatics))
do_one_info (Label
lbl,CmmInfoTable
itbl) = do
(RawCmmGroup
top_decls, ([CmmLit]
std_info, [CmmLit]
extra_bits)) <-
DynFlags
-> CmmInfoTable
-> Maybe WordOff
-> UniqSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents DynFlags
dflags CmmInfoTable
itbl forall a. Maybe a
Nothing
let
info_lbl :: CLabel
info_lbl = CmmInfoTable -> CLabel
cit_lbl CmmInfoTable
itbl
rel_std_info :: [CmmLit]
rel_std_info = 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]
rel_extra_bits = forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> CmmLit -> CmmLit
makeRelativeRefTo Platform
platform CLabel
info_lbl) [CmmLit]
extra_bits
forall (m :: * -> *) a. Monad m => a -> m a
return (RawCmmGroup
top_decls, (Label
lbl, forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
CmmStaticsRaw CLabel
info_lbl forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CmmLit -> CmmStatic
CmmStaticLit forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse [CmmLit]
rel_extra_bits forall a. [a] -> [a] -> [a]
++ [CmmLit]
rel_std_info))
type InfoTableContents = ( [CmmLit]
, [CmmLit] )
mkInfoTableContents :: DynFlags
-> CmmInfoTable
-> Maybe Int
-> UniqSM ([RawCmmDecl],
InfoTableContents)
mkInfoTableContents :: DynFlags
-> CmmInfoTable
-> Maybe WordOff
-> UniqSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents DynFlags
dflags
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
= DynFlags
-> CmmInfoTable
-> Maybe WordOff
-> UniqSM (RawCmmGroup, InfoTableContents)
mkInfoTableContents DynFlags
dflags CmmInfoTable
info{cit_rep :: SMRep
cit_rep = SMRep
rep} (forall a. a -> Maybe a
Just WordOff
rts_tag)
| StackRep [Bool]
frame <- SMRep
smrep
= do { ((CmmLit, CmmLit)
prof_lits, RawCmmGroup
prof_data) <- Platform -> ProfilingInfo -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
mkProfLits Platform
platform ProfilingInfo
prof
; let ([CmmLit]
srt_label, CmmLit
srt_bitmap) = Platform -> CLabel -> Maybe CLabel -> ([CmmLit], CmmLit)
mkSRTLit Platform
platform CLabel
info_lbl Maybe CLabel
srt
; (CmmLit
liveness_lit, RawCmmGroup
liveness_data) <- DynFlags -> [Bool] -> UniqSM (CmmLit, RawCmmGroup)
mkLivenessBits DynFlags
dflags [Bool]
frame
; let
std_info :: [CmmLit]
std_info = DynFlags
-> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
mkStdInfoTable DynFlags
dflags (CmmLit, CmmLit)
prof_lits WordOff
rts_tag CmmLit
srt_bitmap CmmLit
liveness_lit
rts_tag :: WordOff
rts_tag | Just WordOff
tag <- Maybe WordOff
mb_rts_tag = WordOff
tag
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null RawCmmGroup
liveness_data = WordOff
rET_SMALL
| Bool
otherwise = WordOff
rET_BIG
; forall (m :: * -> *) a. Monad m => a -> m a
return (RawCmmGroup
prof_data forall a. [a] -> [a] -> [a]
++ RawCmmGroup
liveness_data, ([CmmLit]
std_info, [CmmLit]
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
; ((CmmLit, CmmLit)
prof_lits, RawCmmGroup
prof_data) <- Platform -> ProfilingInfo -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
mkProfLits Platform
platform ProfilingInfo
prof
; let ([CmmLit]
srt_label, CmmLit
srt_bitmap) = Platform -> CLabel -> Maybe CLabel -> ([CmmLit], CmmLit)
mkSRTLit Platform
platform CLabel
info_lbl Maybe CLabel
srt
; (Maybe CmmLit
mb_srt_field, Maybe CmmLit
mb_layout, [CmmLit]
extra_bits, RawCmmGroup
ct_data)
<- ClosureTypeInfo
-> [CmmLit]
-> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
mk_pieces ClosureTypeInfo
closure_type [CmmLit]
srt_label
; let std_info :: [CmmLit]
std_info = DynFlags
-> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
mkStdInfoTable DynFlags
dflags (CmmLit, CmmLit)
prof_lits
(Maybe WordOff
mb_rts_tag forall a. Maybe a -> a -> a
`orElse` SMRep -> WordOff
rtsClosureType SMRep
smrep)
(Maybe CmmLit
mb_srt_field forall a. Maybe a -> a -> a
`orElse` CmmLit
srt_bitmap)
(Maybe CmmLit
mb_layout forall a. Maybe a -> a -> a
`orElse` CmmLit
layout)
; forall (m :: * -> *) a. Monad m => a -> m a
return (RawCmmGroup
prof_data forall a. [a] -> [a] -> [a]
++ RawCmmGroup
ct_data, ([CmmLit]
std_info, [CmmLit]
extra_bits)) }
where
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
mk_pieces :: ClosureTypeInfo -> [CmmLit]
-> UniqSM ( Maybe CmmLit
, Maybe CmmLit
, [CmmLit]
, [RawCmmDecl])
mk_pieces :: ClosureTypeInfo
-> [CmmLit]
-> UniqSM (Maybe CmmLit, Maybe CmmLit, [CmmLit], RawCmmGroup)
mk_pieces (Constr WordOff
con_tag ConstrDescription
con_descr) [CmmLit]
_no_srt
= do { (CmmLit
descr_lit, GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
decl) <- forall info stmt.
ConstrDescription
-> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit ConstrDescription
con_descr
; forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (Integer -> Width -> CmmLit
CmmInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
con_tag)
(Platform -> Width
halfWordWidth Platform
platform))
, forall a. Maybe a
Nothing, [CmmLit
descr_lit], [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
decl]) }
mk_pieces ClosureTypeInfo
Thunk [CmmLit]
srt_label
= forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, [CmmLit]
srt_label, [])
mk_pieces (ThunkSelector WordOff
offset) [CmmLit]
_no_srt
= forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Integer -> Width -> CmmLit
CmmInt Integer
0 (Platform -> Width
halfWordWidth Platform
platform)),
forall a. a -> Maybe a
Just (Platform -> Integer -> CmmLit
mkWordCLit Platform
platform (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 forall a. a -> [a] -> [a]
: [CmmLit]
srt_label
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, [CmmLit]
extra_bits, []) }
mk_pieces (Fun WordOff
arity (ArgGen [Bool]
arg_bits)) [CmmLit]
srt_label
= do { (CmmLit
liveness_lit, RawCmmGroup
liveness_data) <- DynFlags -> [Bool] -> UniqSM (CmmLit, RawCmmGroup)
mkLivenessBits DynFlags
dflags [Bool]
arg_bits
; let fun_type :: WordOff
fun_type | forall (t :: * -> *) a. Foldable t => t a -> Bool
null RawCmmGroup
liveness_data = WordOff
aRG_GEN
| Bool
otherwise = WordOff
aRG_GEN_BIG
extra_bits :: [CmmLit]
extra_bits = [ Platform -> WordOff -> WordOff -> CmmLit
packIntsCLit Platform
platform WordOff
fun_type WordOff
arity ]
forall a. [a] -> [a] -> [a]
++ (if Platform -> Bool
inlineSRT Platform
platform then [] else [ CmmLit
srt_lit ])
forall a. [a] -> [a] -> [a]
++ [ CmmLit
liveness_lit, CmmLit
slow_entry ]
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, [CmmLit]
extra_bits, RawCmmGroup
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) -> ASSERT( null _rest ) lit
mk_pieces ClosureTypeInfo
other [CmmLit]
_ = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mk_pieces" (forall a. Outputable a => a -> SDoc
ppr ClosureTypeInfo
other)
mkInfoTableContents DynFlags
_ CmmInfoTable
_ Maybe WordOff
_ = forall a. 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
a))
(Platform -> Integer -> StgHalfWord
toStgHalfWord Platform
platform (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 Platform
platform = Platform -> Arch
platformArch Platform
platform forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64
Bool -> Bool -> Bool
&& Platform -> Bool
platformTablesNextToCode Platform
platform
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 :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
mkLivenessBits :: DynFlags -> [Bool] -> UniqSM (CmmLit, RawCmmGroup)
mkLivenessBits DynFlags
dflags [Bool]
liveness
| WordOff
n_bits forall a. Ord a => a -> a -> Bool
> Platform -> WordOff
mAX_SMALL_BITMAP_SIZE Platform
platform
= do { Unique
uniq <- forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM
; let bitmap_lbl :: CLabel
bitmap_lbl = Unique -> CLabel
mkBitmapLabel Unique
uniq
; forall (m :: * -> *) a. Monad m => a -> m a
return (CLabel -> CmmLit
CmmLabel CLabel
bitmap_lbl,
[forall (raw :: Bool) info stmt.
CLabel -> [CmmLit] -> GenCmmDecl (GenCmmStatics raw) info stmt
mkRODataLits CLabel
bitmap_lbl [CmmLit]
lits]) }
| Bool
otherwise
= forall (m :: * -> *) a. Monad m => a -> m a
return (Platform -> StgWord -> CmmLit
mkStgWordCLit Platform
platform StgWord
bitmap_word, [])
where
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
n_bits :: WordOff
n_bits = 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
_ -> forall a. String -> a
panic String
"mkLiveness"
bitmap_word :: StgWord
bitmap_word = Platform -> Integer -> StgWord
toStgWord Platform
platform (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
n_bits)
forall a. Bits a => a -> a -> a
.|. (StgWord
small_bitmap 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
n_bits)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Platform -> StgWord -> CmmLit
mkStgWordCLit Platform
platform) Bitmap
bitmap
mkStdInfoTable
:: DynFlags
-> (CmmLit,CmmLit)
-> Int
-> CmmLit
-> CmmLit
-> [CmmLit]
mkStdInfoTable :: DynFlags
-> (CmmLit, CmmLit) -> WordOff -> CmmLit -> CmmLit -> [CmmLit]
mkStdInfoTable DynFlags
dflags (CmmLit
type_descr, CmmLit
closure_descr) WordOff
cl_type CmmLit
srt CmmLit
layout_lit
=
[CmmLit]
prof_info
forall a. [a] -> [a] -> [a]
++ [CmmLit
layout_lit, CmmLit
tag, CmmLit
srt]
where
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
prof_info :: [CmmLit]
prof_info
| DynFlags -> Bool
sccProfilingEnabled DynFlags
dflags = [CmmLit
type_descr, CmmLit
closure_descr]
| Bool
otherwise = []
tag :: CmmLit
tag = Integer -> Width -> CmmLit
CmmInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
cl_type) (Platform -> Width
halfWordWidth Platform
platform)
mkProfLits :: Platform -> ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl])
mkProfLits :: Platform -> ProfilingInfo -> UniqSM ((CmmLit, CmmLit), RawCmmGroup)
mkProfLits Platform
platform ProfilingInfo
NoProfilingInfo = 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 { (CmmLit
td_lit, GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
td_decl) <- forall info stmt.
ConstrDescription
-> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit ConstrDescription
td
; (CmmLit
cd_lit, GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
cd_decl) <- forall info stmt.
ConstrDescription
-> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit ConstrDescription
cd
; forall (m :: * -> *) a. Monad m => a -> m a
return ((CmmLit
td_lit,CmmLit
cd_lit), [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
td_decl,GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
cd_decl]) }
newStringLit :: ByteString -> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit :: forall info stmt.
ConstrDescription
-> UniqSM (CmmLit, GenCmmDecl RawCmmStatics info stmt)
newStringLit ConstrDescription
bytes
= do { Unique
uniq <- forall (m :: * -> *). MonadUnique m => m Unique
getUniqueM
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall (raw :: Bool) info stmt.
CLabel
-> ConstrDescription
-> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
mkByteStringCLit (Unique -> CLabel
mkStringLitLabel Unique
uniq) ConstrDescription
bytes) }
srtEscape :: Platform -> StgHalfWord
srtEscape :: Platform -> StgHalfWord
srtEscape Platform
platform = Platform -> Integer -> StgHalfWord
toStgHalfWord Platform
platform (-Integer
1)
data PtrOpts = PtrOpts
{ PtrOpts -> Profile
po_profile :: !Profile
, PtrOpts -> Bool
po_align_check :: !Bool
}
wordAligned :: PtrOpts -> CmmExpr -> CmmExpr
wordAligned :: PtrOpts -> CmmExpr -> CmmExpr
wordAligned PtrOpts
opts CmmExpr
e
| PtrOpts -> Bool
po_align_check PtrOpts
opts
= 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
where platform :: Platform
platform = Profile -> Platform
profilePlatform (PtrOpts -> Profile
po_profile PtrOpts
opts)
closureInfoPtr :: PtrOpts -> CmmExpr -> CmmExpr
closureInfoPtr :: PtrOpts -> CmmExpr -> CmmExpr
closureInfoPtr opts :: PtrOpts
opts@(PtrOpts Profile
profile Bool
_) CmmExpr
e =
Platform -> CmmExpr -> CmmExpr
cmmLoadBWord (Profile -> Platform
profilePlatform Profile
profile) (PtrOpts -> CmmExpr -> CmmExpr
wordAligned PtrOpts
opts 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 :: PtrOpts -> CmmExpr -> CmmExpr
getConstrTag :: PtrOpts -> CmmExpr -> CmmExpr
getConstrTag PtrOpts
opts 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 (PtrOpts -> CmmExpr -> CmmExpr
closureInfoPtr PtrOpts
opts CmmExpr
closure_ptr)
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
profile :: Profile
profile = PtrOpts -> Profile
po_profile PtrOpts
opts
cmmGetClosureType :: PtrOpts -> CmmExpr -> CmmExpr
cmmGetClosureType :: PtrOpts -> CmmExpr -> CmmExpr
cmmGetClosureType PtrOpts
opts 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 (PtrOpts -> CmmExpr -> CmmExpr
closureInfoPtr PtrOpts
opts CmmExpr
closure_ptr)
platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
profile :: Profile
profile = PtrOpts -> Profile
po_profile PtrOpts
opts
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 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 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 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
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
forall a. Num a => a -> a -> a
+ WordOff
fixedInfoTableSizeW
forall a. Num a => a -> a -> a
+ WordOff
profInfoTableSizeW
maxRetInfoTableSizeW :: WordOff
maxRetInfoTableSizeW :: WordOff
maxRetInfoTableSizeW =
WordOff
maxStdInfoTableSizeW
forall a. Num a => a -> a -> a
+ WordOff
1
stdInfoTableSizeB :: Profile -> ByteOff
stdInfoTableSizeB :: Profile -> WordOff
stdInfoTableSizeB Profile
profile = Profile -> WordOff
stdInfoTableSizeW Profile
profile 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 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 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 forall a. Num a => a -> a -> a
- WordOff
2 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 forall a. Num a => a -> a -> a
- WordOff
2 forall a. Num a => a -> a -> a
* Profile -> WordOff
profileWordSizeInBytes Profile
profile
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 forall a. Num a => a -> a -> a
+ Profile -> WordOff
profileWordSizeInBytes Profile
profile