module GHC.CmmToLlvm.Data (
genLlvmData, genData
) where
import GHC.Prelude
import GHC.Llvm
import GHC.Llvm.Types (widenFp)
import GHC.CmmToLlvm.Base
import GHC.CmmToLlvm.Config
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.InitFini
import GHC.Cmm
import GHC.Platform
import GHC.Data.FastString
import GHC.Utils.Panic
import qualified Data.ByteString as BS
structStr :: LMString
structStr :: LMString
structStr = String -> LMString
fsLit String
"_struct"
linkage :: CLabel -> LlvmLinkageType
linkage :: CLabel -> LlvmLinkageType
linkage CLabel
lbl = if CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
then LlvmLinkageType
ExternallyVisible else LlvmLinkageType
Internal
genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
genLlvmData (Section
_, CmmStaticsRaw CLabel
alias [CmmStaticLit (CmmLabel CLabel
lbl), CmmStaticLit CmmLit
ind, CmmStatic
_, CmmStatic
_])
| CLabel
lbl CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== CLabel
mkIndStaticInfoLabel
, let labelInd :: CmmLit -> Maybe CLabel
labelInd (CmmLabelOff CLabel
l Int
_) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
labelInd (CmmLabel CLabel
l) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
labelInd CmmLit
_ = Maybe CLabel
forall a. Maybe a
Nothing
, Just CLabel
ind' <- CmmLit -> Maybe CLabel
labelInd CmmLit
ind
, CLabel
alias CLabel -> CLabel -> Bool
`mayRedirectTo` CLabel
ind' = do
label <- CLabel -> LlvmM LMString
strCLabel_llvm CLabel
alias
label' <- strCLabel_llvm ind'
let link = CLabel -> LlvmLinkageType
linkage CLabel
alias
link' = CLabel -> LlvmLinkageType
linkage CLabel
ind'
tyAlias = LlvmAlias -> LlvmType
LMAlias (LMString
label LMString -> LMString -> LMString
`appendFS` LMString
structStr, [LlvmType] -> LlvmType
LMStructU [])
aliasDef = LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
label LlvmType
tyAlias LlvmLinkageType
link LMSection
forall a. Maybe a
Nothing LMAlign
forall a. Maybe a
Nothing LMConst
Alias
indType = String -> a
forall a. HasCallStack => String -> a
panic String
"will be filled by 'aliasify', later"
orig = LlvmVar -> LlvmStatic
LMStaticPointer (LlvmVar -> LlvmStatic) -> LlvmVar -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
label' LlvmType
forall {a}. a
indType LlvmLinkageType
link' LMSection
forall a. Maybe a
Nothing LMAlign
forall a. Maybe a
Nothing LMConst
Alias
pure ([LMGlobal aliasDef $ Just orig], [tyAlias])
genLlvmData (Section
sect, RawCmmStatics
statics)
| Just (InitOrFini
initOrFini, [CLabel]
clbls) <- RawCmmDecl -> Maybe (InitOrFini, [CLabel])
isInitOrFiniArray (Section -> RawCmmStatics -> RawCmmDecl
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sect RawCmmStatics
statics)
= let var :: LMString
var = case InitOrFini
initOrFini of
InitOrFini
IsInitArray -> String -> LMString
fsLit String
"llvm.global_ctors"
InitOrFini
IsFiniArray -> String -> LMString
fsLit String
"llvm.global_dtors"
in LMString -> [CLabel] -> LlvmM LlvmData
genGlobalLabelArray LMString
var [CLabel]
clbls
genLlvmData (Section
sec, CmmStaticsRaw CLabel
lbl [CmmStatic]
xs) = do
label <- CLabel -> LlvmM LMString
strCLabel_llvm CLabel
lbl
static <- mapM genData xs
lmsec <- llvmSection sec
platform <- getPlatform
let types = (LlvmStatic -> LlvmType) -> [LlvmStatic] -> [LlvmType]
forall a b. (a -> b) -> [a] -> [b]
map LlvmStatic -> LlvmType
getStatType [LlvmStatic]
static
strucTy = [LlvmType] -> LlvmType
LMStruct [LlvmType]
types
tyAlias = LlvmAlias -> LlvmType
LMAlias (LMString
label LMString -> LMString -> LMString
`appendFS` LMString
structStr, LlvmType
strucTy)
struct = LlvmStatic -> Maybe LlvmStatic
forall a. a -> Maybe a
Just (LlvmStatic -> Maybe LlvmStatic) -> LlvmStatic -> Maybe LlvmStatic
forall a b. (a -> b) -> a -> b
$ [LlvmStatic] -> LlvmType -> LlvmStatic
LMStaticStruc [LlvmStatic]
static LlvmType
tyAlias
link = CLabel -> LlvmLinkageType
linkage CLabel
lbl
align = case Section
sec of
Section SectionType
CString CLabel
_ -> if (Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchS390X)
then Int -> LMAlign
forall a. a -> Maybe a
Just Int
2 else Int -> LMAlign
forall a. a -> Maybe a
Just Int
1
Section SectionType
Data CLabel
_ -> Int -> LMAlign
forall a. a -> Maybe a
Just (Int -> LMAlign) -> Int -> LMAlign
forall a b. (a -> b) -> a -> b
$ Platform -> Int
platformWordSizeInBytes Platform
platform
Section
_ -> LMAlign
forall a. Maybe a
Nothing
const = if Section -> SectionProtection
sectionProtection Section
sec SectionProtection -> SectionProtection -> Bool
forall a. Eq a => a -> a -> Bool
== SectionProtection
ReadOnlySection
then LMConst
Constant else LMConst
Global
varDef = LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
label LlvmType
tyAlias LlvmLinkageType
link LMSection
lmsec LMAlign
align LMConst
const
globDef = LlvmVar -> Maybe LlvmStatic -> LMGlobal
LMGlobal LlvmVar
varDef Maybe LlvmStatic
struct
return ([globDef], [tyAlias])
genGlobalLabelArray :: FastString -> [CLabel] -> LlvmM LlvmData
genGlobalLabelArray :: LMString -> [CLabel] -> LlvmM LlvmData
genGlobalLabelArray LMString
var_nm [CLabel]
clbls = do
lbls <- (CLabel -> LlvmM LMString) -> [CLabel] -> LlvmM [LMString]
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 CLabel -> LlvmM LMString
strCLabel_llvm [CLabel]
clbls
decls <- mapM mkFunDecl lbls
let entries = (LMString -> LlvmStatic) -> [LMString] -> [LlvmStatic]
forall a b. (a -> b) -> [a] -> [b]
map LMString -> LlvmStatic
toArrayEntry [LMString]
lbls
static = [LlvmStatic] -> LlvmType -> LlvmStatic
LMStaticArray [LlvmStatic]
entries LlvmType
arr_ty
arr = LlvmVar -> Maybe LlvmStatic -> LMGlobal
LMGlobal LlvmVar
arr_var (LlvmStatic -> Maybe LlvmStatic
forall a. a -> Maybe a
Just LlvmStatic
static)
return ([arr], decls)
where
mkFunDecl :: LMString -> LlvmM LlvmType
mkFunDecl :: LMString -> LlvmM LlvmType
mkFunDecl LMString
fn_lbl = do
let fn_ty :: LlvmType
fn_ty = LMString -> LlvmType
mkFunTy LMString
fn_lbl
LMString -> LlvmType -> LlvmM ()
forall key. Uniquable key => key -> LlvmType -> LlvmM ()
funInsert LMString
fn_lbl LlvmType
fn_ty
LlvmType -> LlvmM LlvmType
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmType
fn_ty)
toArrayEntry :: LMString -> LlvmStatic
toArrayEntry :: LMString -> LlvmStatic
toArrayEntry LMString
fn_lbl =
let fn_var :: LlvmVar
fn_var = LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
fn_lbl (LlvmType -> LlvmType
LMPointer (LlvmType -> LlvmType) -> LlvmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ LMString -> LlvmType
mkFunTy LMString
fn_lbl) LlvmLinkageType
Internal LMSection
forall a. Maybe a
Nothing LMAlign
forall a. Maybe a
Nothing LMConst
Global
fn :: LlvmStatic
fn = LlvmVar -> LlvmStatic
LMStaticPointer LlvmVar
fn_var
null :: LlvmStatic
null = LlvmLit -> LlvmStatic
LMStaticLit (LlvmType -> LlvmLit
LMNullLit LlvmType
i8Ptr)
prio :: LlvmStatic
prio = LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit Integer
0xffff LlvmType
i32
in [LlvmStatic] -> LlvmType -> LlvmStatic
LMStaticStrucU [LlvmStatic
prio, LlvmStatic
fn, LlvmStatic
null] LlvmType
entry_ty
arr_var :: LlvmVar
arr_var = LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
var_nm LlvmType
arr_ty LlvmLinkageType
Internal LMSection
forall a. Maybe a
Nothing LMAlign
forall a. Maybe a
Nothing LMConst
Global
mkFunTy :: LMString -> LlvmType
mkFunTy LMString
lbl = LlvmFunctionDecl -> LlvmType
LMFunction (LlvmFunctionDecl -> LlvmType) -> LlvmFunctionDecl -> LlvmType
forall a b. (a -> b) -> a -> b
$ LMString
-> LlvmLinkageType
-> LlvmCallConvention
-> LlvmType
-> LlvmParameterListType
-> [LlvmParameter]
-> LMAlign
-> LlvmFunctionDecl
LlvmFunctionDecl LMString
lbl LlvmLinkageType
ExternallyVisible LlvmCallConvention
CC_Ccc LlvmType
LMVoid LlvmParameterListType
FixedArgs [] LMAlign
forall a. Maybe a
Nothing
entry_ty :: LlvmType
entry_ty = [LlvmType] -> LlvmType
LMStructU [LlvmType
i32, LlvmType -> LlvmType
LMPointer (LlvmType -> LlvmType) -> LlvmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ LMString -> LlvmType
mkFunTy (LMString -> LlvmType) -> LMString -> LlvmType
forall a b. (a -> b) -> a -> b
$ String -> LMString
fsLit String
"placeholder", LlvmType -> LlvmType
LMPointer LlvmType
i8]
arr_ty :: LlvmType
arr_ty = Int -> LlvmType -> LlvmType
LMArray ([CLabel] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CLabel]
clbls) LlvmType
entry_ty
llvmSectionType :: Platform -> SectionType -> FastString
llvmSectionType :: Platform -> SectionType -> LMString
llvmSectionType Platform
p SectionType
t = case SectionType
t of
SectionType
Text -> String -> LMString
fsLit String
".text"
SectionType
ReadOnlyData -> case Platform -> OS
platformOS Platform
p of
OS
OSMinGW32 -> String -> LMString
fsLit String
".rdata"
OS
_ -> String -> LMString
fsLit String
".rodata"
SectionType
RelocatableReadOnlyData -> case Platform -> OS
platformOS Platform
p of
OS
OSMinGW32 -> String -> LMString
fsLit String
".rdata$rel.ro"
OS
_ -> String -> LMString
fsLit String
".data.rel.ro"
SectionType
Data -> String -> LMString
fsLit String
".data"
SectionType
UninitialisedData -> String -> LMString
fsLit String
".bss"
SectionType
CString -> case Platform -> OS
platformOS Platform
p of
OS
OSMinGW32 -> String -> LMString
fsLit String
".rdata$str"
OS
_ -> String -> LMString
fsLit String
".rodata.str"
SectionType
InitArray -> String -> LMString
forall a. HasCallStack => String -> a
panic String
"llvmSectionType: InitArray"
SectionType
FiniArray -> String -> LMString
forall a. HasCallStack => String -> a
panic String
"llvmSectionType: FiniArray"
OtherSection String
_ -> String -> LMString
forall a. HasCallStack => String -> a
panic String
"llvmSectionType: unknown section type"
llvmSection :: Section -> LlvmM LMSection
llvmSection :: Section -> LlvmM LMSection
llvmSection (Section SectionType
t CLabel
suffix) = do
opts <- LlvmM LlvmCgConfig
getConfig
let splitSect = LlvmCgConfig -> Bool
llvmCgSplitSection LlvmCgConfig
opts
platform = LlvmCgConfig -> Platform
llvmCgPlatform LlvmCgConfig
opts
if not splitSect
then return Nothing
else do
lmsuffix <- strCLabel_llvm suffix
let result String
sep = LMString -> LMSection
forall a. a -> Maybe a
Just ([LMString] -> LMString
concatFS [Platform -> SectionType -> LMString
llvmSectionType Platform
platform SectionType
t
, String -> LMString
fsLit String
sep, LMString
lmsuffix])
case platformOS platform of
OS
OSMinGW32 -> LMSection -> LlvmM LMSection
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LMSection
result String
"$")
OS
_ -> LMSection -> LlvmM LMSection
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LMSection
result String
".")
genData :: CmmStatic -> LlvmM LlvmStatic
genData :: CmmStatic -> LlvmM LlvmStatic
genData (CmmFileEmbed {}) = String -> LlvmM LlvmStatic
forall a. HasCallStack => String -> a
panic String
"Unexpected CmmFileEmbed literal"
genData (CmmString ByteString
str) = do
let v :: [LlvmStatic]
v = (Word8 -> LlvmStatic) -> [Word8] -> [LlvmStatic]
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
x -> LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) LlvmType
i8)
(ByteString -> [Word8]
BS.unpack ByteString
str)
ve :: [LlvmStatic]
ve = [LlvmStatic]
v [LlvmStatic] -> [LlvmStatic] -> [LlvmStatic]
forall a. [a] -> [a] -> [a]
++ [LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit Integer
0 LlvmType
i8]
LlvmStatic -> LlvmM LlvmStatic
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ [LlvmStatic] -> LlvmType -> LlvmStatic
LMStaticArray [LlvmStatic]
ve (Int -> LlvmType -> LlvmType
LMArray ([LlvmStatic] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LlvmStatic]
ve) LlvmType
i8)
genData (CmmUninitialised Int
bytes)
= LlvmStatic -> LlvmM LlvmStatic
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmType -> LlvmStatic
LMUninitType (Int -> LlvmType -> LlvmType
LMArray Int
bytes LlvmType
i8)
genData (CmmStaticLit CmmLit
lit)
= CmmLit -> LlvmM LlvmStatic
genStaticLit CmmLit
lit
genStaticLit :: CmmLit -> LlvmM LlvmStatic
genStaticLit :: CmmLit -> LlvmM LlvmStatic
genStaticLit (CmmInt Integer
i Width
w)
= LlvmStatic -> LlvmM LlvmStatic
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmLit -> LlvmStatic
LMStaticLit (Integer -> LlvmType -> LlvmLit
LMIntLit Integer
i (Int -> LlvmType
LMInt (Int -> LlvmType) -> Int -> LlvmType
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBits Width
w))
genStaticLit (CmmFloat Rational
r Width
W32)
= LlvmStatic -> LlvmM LlvmStatic
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmLit -> LlvmStatic
LMStaticLit (Double -> LlvmType -> LlvmLit
LMFloatLit (Float -> Double
widenFp (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r :: Float)) (Width -> LlvmType
widthToLlvmFloat Width
W32))
genStaticLit (CmmFloat Rational
r Width
W64)
= LlvmStatic -> LlvmM LlvmStatic
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmLit -> LlvmStatic
LMStaticLit (Double -> LlvmType -> LlvmLit
LMFloatLit (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r :: Double) (Width -> LlvmType
widthToLlvmFloat Width
W64))
genStaticLit (CmmFloat Rational
_r Width
_w)
= String -> LlvmM LlvmStatic
forall a. HasCallStack => String -> a
panic String
"genStaticLit (CmmLit:CmmFloat), unsupported float lit"
genStaticLit (CmmVec [CmmLit]
ls)
= do sls <- (CmmLit -> LlvmM LlvmLit) -> [CmmLit] -> LlvmM [LlvmLit]
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 CmmLit -> LlvmM LlvmLit
toLlvmLit [CmmLit]
ls
return $ LMStaticLit (LMVectorLit sls)
where
toLlvmLit :: CmmLit -> LlvmM LlvmLit
toLlvmLit :: CmmLit -> LlvmM LlvmLit
toLlvmLit CmmLit
lit = do
slit <- CmmLit -> LlvmM LlvmStatic
genStaticLit CmmLit
lit
case slit of
LMStaticLit LlvmLit
llvmLit -> LlvmLit -> LlvmM LlvmLit
forall a. a -> LlvmM a
forall (m :: * -> *) a. Monad m => a -> m a
return LlvmLit
llvmLit
LlvmStatic
_ -> String -> LlvmM LlvmLit
forall a. HasCallStack => String -> a
panic String
"genStaticLit"
genStaticLit cmm :: CmmLit
cmm@(CmmLabel CLabel
l) = do
var <- LMString -> LlvmM LlvmVar
getGlobalPtr (LMString -> LlvmM LlvmVar) -> LlvmM LMString -> LlvmM LlvmVar
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CLabel -> LlvmM LMString
strCLabel_llvm CLabel
l
platform <- getPlatform
let ptr = LlvmVar -> LlvmStatic
LMStaticPointer LlvmVar
var
lmty = CmmType -> LlvmType
cmmToLlvmType (CmmType -> LlvmType) -> CmmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
cmm
return $ LMPtoI ptr lmty
genStaticLit (CmmLabelOff CLabel
label Int
off) = do
platform <- LlvmM Platform
getPlatform
var <- genStaticLit (CmmLabel label)
let offset = LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
off) (Platform -> LlvmType
llvmWord Platform
platform)
return $ LMAdd var offset
genStaticLit (CmmLabelDiffOff CLabel
l1 CLabel
l2 Int
off Width
w) = do
platform <- LlvmM Platform
getPlatform
var1 <- genStaticLit (CmmLabel l1)
var2 <- genStaticLit (CmmLabel l2)
let var
| Width
w Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Platform -> Width
wordWidth Platform
platform = LlvmStatic -> LlvmStatic -> LlvmStatic
LMSub LlvmStatic
var1 LlvmStatic
var2
| Bool
otherwise = LlvmStatic -> LlvmType -> LlvmStatic
LMTrunc (LlvmStatic -> LlvmStatic -> LlvmStatic
LMSub LlvmStatic
var1 LlvmStatic
var2) (Width -> LlvmType
widthToLlvmInt Width
w)
offset = LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
off) (Int -> LlvmType
LMInt (Int -> LlvmType) -> Int -> LlvmType
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBits Width
w)
return $ LMAdd var offset
genStaticLit (CmmBlock BlockId
b) = CmmLit -> LlvmM LlvmStatic
genStaticLit (CmmLit -> LlvmM LlvmStatic) -> CmmLit -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ BlockId -> CLabel
infoTblLbl BlockId
b
genStaticLit (CmmLit
CmmHighStackMark)
= String -> LlvmM LlvmStatic
forall a. HasCallStack => String -> a
panic String
"genStaticLit: CmmHighStackMark unsupported!"