{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.CmmToAsm.Dwarf.Types
(
DwarfInfo(..)
, pprDwarfInfo
, pprAbbrevDecls
, DwarfARange(..)
, pprDwarfARanges
, DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)
, pprDwarfFrame
, pprByte
, pprHalf
, pprData4'
, pprDwWord
, pprWord
, pprLEBWord
, pprLEBInt
, wordAlign
, sectionOffset
)
where
import GHC.Prelude
import GHC.Cmm.DebugBlock
import GHC.Cmm.CLabel
import GHC.Cmm.Expr
import GHC.Utils.Encoding
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Platform
import GHC.Types.Unique
import GHC.Platform.Reg
import GHC.Types.SrcLoc
import GHC.Utils.Misc
import GHC.CmmToAsm.Dwarf.Constants
import qualified Data.ByteString as BS
import qualified GHC.Utils.Monad.State.Strict as S
import Control.Monad (zipWithM, join)
import qualified Data.Map as Map
import Data.Word
import Data.Char
import GHC.Platform.Regs
data DwarfInfo
= DwarfCompileUnit { DwarfInfo -> [DwarfInfo]
dwChildren :: [DwarfInfo]
, DwarfInfo -> String
dwName :: String
, DwarfInfo -> String
dwProducer :: String
, DwarfInfo -> String
dwCompDir :: String
, DwarfInfo -> CLabel
dwLowLabel :: CLabel
, DwarfInfo -> CLabel
dwHighLabel :: CLabel }
| DwarfSubprogram { dwChildren :: [DwarfInfo]
, dwName :: String
, DwarfInfo -> CLabel
dwLabel :: CLabel
, DwarfInfo -> Maybe CLabel
dwParent :: Maybe CLabel
}
| DwarfBlock { dwChildren :: [DwarfInfo]
, dwLabel :: CLabel
, DwarfInfo -> Maybe CLabel
dwMarker :: Maybe CLabel
}
| DwarfSrcNote { DwarfInfo -> RealSrcSpan
dwSrcSpan :: RealSrcSpan
}
data DwarfAbbrev
= DwAbbrNull
| DwAbbrCompileUnit
| DwAbbrSubprogram
| DwAbbrSubprogramWithParent
| DwAbbrBlockWithoutCode
| DwAbbrBlock
| DwAbbrGhcSrcNote
deriving (DwarfAbbrev -> DwarfAbbrev -> Bool
(DwarfAbbrev -> DwarfAbbrev -> Bool)
-> (DwarfAbbrev -> DwarfAbbrev -> Bool) -> Eq DwarfAbbrev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DwarfAbbrev -> DwarfAbbrev -> Bool
== :: DwarfAbbrev -> DwarfAbbrev -> Bool
$c/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
Eq, Int -> DwarfAbbrev
DwarfAbbrev -> Int
DwarfAbbrev -> [DwarfAbbrev]
DwarfAbbrev -> DwarfAbbrev
DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
(DwarfAbbrev -> DwarfAbbrev)
-> (DwarfAbbrev -> DwarfAbbrev)
-> (Int -> DwarfAbbrev)
-> (DwarfAbbrev -> Int)
-> (DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> Enum DwarfAbbrev
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DwarfAbbrev -> DwarfAbbrev
succ :: DwarfAbbrev -> DwarfAbbrev
$cpred :: DwarfAbbrev -> DwarfAbbrev
pred :: DwarfAbbrev -> DwarfAbbrev
$ctoEnum :: Int -> DwarfAbbrev
toEnum :: Int -> DwarfAbbrev
$cfromEnum :: DwarfAbbrev -> Int
fromEnum :: DwarfAbbrev -> Int
$cenumFrom :: DwarfAbbrev -> [DwarfAbbrev]
enumFrom :: DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
Enum)
pprAbbrev :: IsDoc doc => DwarfAbbrev -> doc
pprAbbrev :: forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev = Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word -> doc) -> (DwarfAbbrev -> Word) -> DwarfAbbrev -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (DwarfAbbrev -> Int) -> DwarfAbbrev -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DwarfAbbrev -> Int
forall a. Enum a => a -> Int
fromEnum
pprAbbrevDecls :: IsDoc doc => Platform -> Bool -> doc
pprAbbrevDecls :: forall doc. IsDoc doc => Platform -> Bool -> doc
pprAbbrevDecls Platform
platform Bool
haveDebugLine =
let mkAbbrev :: DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
abbr Word
tag Word8
chld [(Word, Word)]
flds =
let fld :: (Word, Word) -> doc
fld (Word
tag, Word
form) = Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
tag doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
form
in DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
abbr doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
tag doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
chld doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (((Word, Word) -> doc) -> [(Word, Word)] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Word, Word) -> doc
forall {doc}. IsDoc doc => (Word, Word) -> doc
fld [(Word, Word)]
flds) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
subprogramAttrs :: [(Word, Word)]
subprogramAttrs =
[ (Word
dW_AT_name, Word
dW_FORM_string)
, (Word
dW_AT_linkage_name, Word
dW_FORM_string)
, (Word
dW_AT_external, Word
dW_FORM_flag)
, (Word
dW_AT_low_pc, Word
dW_FORM_addr)
, (Word
dW_AT_high_pc, Word
dW_FORM_addr)
, (Word
dW_AT_frame_base, Word
dW_FORM_block1)
]
in Platform -> doc
forall doc. IsDoc doc => Platform -> doc
dwarfAbbrevSection Platform
platform doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc
forall doc. IsLine doc => doc
dwarfAbbrevLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrCompileUnit Word
dW_TAG_compile_unit Word8
dW_CHILDREN_yes
([(Word
dW_AT_name, Word
dW_FORM_string)
, (Word
dW_AT_producer, Word
dW_FORM_string)
, (Word
dW_AT_language, Word
dW_FORM_data4)
, (Word
dW_AT_comp_dir, Word
dW_FORM_string)
, (Word
dW_AT_use_UTF8, Word
dW_FORM_flag_present)
, (Word
dW_AT_low_pc, Word
dW_FORM_addr)
, (Word
dW_AT_high_pc, Word
dW_FORM_addr)
] [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
++
(if Bool
haveDebugLine
then [ (Word
dW_AT_stmt_list, Word
dW_FORM_data4) ]
else [])) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrSubprogram Word
dW_TAG_subprogram Word8
dW_CHILDREN_yes
[(Word, Word)]
subprogramAttrs doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrSubprogramWithParent Word
dW_TAG_subprogram Word8
dW_CHILDREN_yes
([(Word, Word)]
subprogramAttrs [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
++ [(Word
dW_AT_ghc_tick_parent, Word
dW_FORM_ref_addr)]) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode Word
dW_TAG_lexical_block Word8
dW_CHILDREN_yes
[ (Word
dW_AT_name, Word
dW_FORM_string)
] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrBlock Word
dW_TAG_lexical_block Word8
dW_CHILDREN_yes
[ (Word
dW_AT_name, Word
dW_FORM_string)
, (Word
dW_AT_low_pc, Word
dW_FORM_addr)
, (Word
dW_AT_high_pc, Word
dW_FORM_addr)
] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrGhcSrcNote Word
dW_TAG_ghc_src_note Word8
dW_CHILDREN_no
[ (Word
dW_AT_ghc_span_file, Word
dW_FORM_string)
, (Word
dW_AT_ghc_span_start_line, Word
dW_FORM_data4)
, (Word
dW_AT_ghc_span_start_col, Word
dW_FORM_data2)
, (Word
dW_AT_ghc_span_end_line, Word
dW_FORM_data4)
, (Word
dW_AT_ghc_span_end_col, Word
dW_FORM_data2)
] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> SDoc #-}
{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> HDoc #-}
pprDwarfInfo :: IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfo :: forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfo Platform
platform Bool
haveSrc DwarfInfo
d
= case DwarfInfo
d of
DwarfCompileUnit {dwChildren :: DwarfInfo -> [DwarfInfo]
dwChildren = [DwarfInfo]
kids} -> [DwarfInfo] -> doc
hasChildren [DwarfInfo]
kids
DwarfSubprogram {dwChildren :: DwarfInfo -> [DwarfInfo]
dwChildren = [DwarfInfo]
kids} -> [DwarfInfo] -> doc
hasChildren [DwarfInfo]
kids
DwarfBlock {dwChildren :: DwarfInfo -> [DwarfInfo]
dwChildren = [DwarfInfo]
kids} -> [DwarfInfo] -> doc
hasChildren [DwarfInfo]
kids
DwarfSrcNote {} -> doc
noChildren
where
hasChildren :: [DwarfInfo] -> doc
hasChildren [DwarfInfo]
kids =
Platform -> Bool -> DwarfInfo -> doc
forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfoOpen Platform
platform Bool
haveSrc DwarfInfo
d doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((DwarfInfo -> doc) -> [DwarfInfo] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Bool -> DwarfInfo -> doc
forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfo Platform
platform Bool
haveSrc) [DwarfInfo]
kids) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
doc
forall doc. IsDoc doc => doc
pprDwarfInfoClose
noChildren :: doc
noChildren = Platform -> Bool -> DwarfInfo -> doc
forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfoOpen Platform
platform Bool
haveSrc DwarfInfo
d
{-# SPECIALIZE pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> SDoc #-}
{-# SPECIALIZE pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> HDoc #-}
pprLabelString :: IsDoc doc => Platform -> CLabel -> doc
pprLabelString :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label =
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprString'
(Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
label
pprDwarfInfoOpen :: IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfoOpen :: forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfoOpen Platform
platform Bool
haveSrc (DwarfCompileUnit [DwarfInfo]
_ String
name String
producer String
compDir CLabel
lowLabel
CLabel
highLabel) =
DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrCompileUnit
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
name
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
producer
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprData4 Word
dW_LANG_Haskell
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
compDir
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lowLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1")
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
highLabel)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ if Bool
haveSrc
then Platform -> Line doc -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform Line doc
forall doc. IsLine doc => doc
dwarfLineLabel Line doc
forall doc. IsLine doc => doc
dwarfLineLabel
else doc
forall doc. IsOutput doc => doc
empty
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfSubprogram [DwarfInfo]
_ String
name CLabel
label Maybe CLabel
parent) =
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
abbrev
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
name
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Bool -> doc
forall doc. IsDoc doc => Bool -> doc
pprFlag (CLabel -> Bool
externallyVisibleCLabel CLabel
label)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
label Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1")
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> Line doc) -> CLabel -> Line doc
forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
label)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
1
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_call_frame_cfa
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ doc
parentValue
where
abbrev :: DwarfAbbrev
abbrev = case Maybe CLabel
parent of Maybe CLabel
Nothing -> DwarfAbbrev
DwAbbrSubprogram
Just CLabel
_ -> DwarfAbbrev
DwAbbrSubprogramWithParent
parentValue :: doc
parentValue = doc -> (CLabel -> doc) -> Maybe CLabel -> doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe doc
forall doc. IsOutput doc => doc
empty CLabel -> doc
pprParentDie Maybe CLabel
parent
pprParentDie :: CLabel -> doc
pprParentDie CLabel
sym = Platform -> Line doc -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
sym) Line doc
forall doc. IsLine doc => doc
dwarfInfoLabel
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label Maybe CLabel
Nothing) =
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label (Just CLabel
marker)) =
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrBlock
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
marker)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> Line doc) -> CLabel -> Line doc
forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempEndLabel CLabel
marker)
pprDwarfInfoOpen Platform
_ Bool
_ (DwarfSrcNote RealSrcSpan
ss) =
DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrGhcSrcNote
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprString' (FastString -> Line doc
forall doc. IsLine doc => FastString -> doc
ftext (FastString -> Line doc) -> FastString -> Line doc
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
ss)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprData4 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word16 -> doc
forall doc. IsDoc doc => Word16 -> doc
pprHalf (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprData4 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word16 -> doc
forall doc. IsDoc doc => Word16 -> doc
pprHalf (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
ss)
pprDwarfInfoClose :: IsDoc doc => doc
pprDwarfInfoClose :: forall doc. IsDoc doc => doc
pprDwarfInfoClose = DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrNull
data DwarfARange
= DwarfARange
{ DwarfARange -> CLabel
dwArngStartLabel :: CLabel
, DwarfARange -> CLabel
dwArngEndLabel :: CLabel
}
pprDwarfARanges :: IsDoc doc => Platform -> [DwarfARange] -> Unique -> doc
pprDwarfARanges :: forall doc. IsDoc doc => Platform -> [DwarfARange] -> Unique -> doc
pprDwarfARanges Platform
platform [DwarfARange]
arngs Unique
unitU =
let wordSize :: Int
wordSize = Platform -> Int
platformWordSizeInBytes Platform
platform
paddingSize :: Int
paddingSize = Int
4 :: Int
pad :: Int -> b
pad Int
n = [b] -> b
forall doc. IsDoc doc => [doc] -> doc
vcat ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ Int -> b -> [b]
forall a. Int -> a -> [a]
replicate Int
n (b -> [b]) -> b -> [b]
forall a b. (a -> b) -> a -> b
$ Word8 -> b
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
initialLength :: Int
initialLength = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
paddingSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [DwarfARange] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DwarfARange]
arngs) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wordSize
in Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprDwWord (Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
initialLength)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word16 -> doc
forall doc. IsDoc doc => Word16 -> doc
pprHalf Word16
2
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> Line doc) -> CLabel -> Line doc
forall a b. (a -> b) -> a -> b
$ Unique -> CLabel
forall a. Uniquable a => a -> CLabel
mkAsmTempLabel (Unique -> CLabel) -> Unique -> CLabel
forall a b. (a -> b) -> a -> b
$ Unique
unitU) Line doc
forall doc. IsLine doc => doc
dwarfInfoLabel
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wordSize)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> doc
forall {b}. IsDoc b => Int -> b
pad Int
paddingSize
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((DwarfARange -> doc) -> [DwarfARange] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> DwarfARange -> doc
forall doc. IsDoc doc => Platform -> DwarfARange -> doc
pprDwarfARange Platform
platform) [DwarfARange]
arngs)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'0')
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'0')
{-# SPECIALIZE pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> SDoc #-}
{-# SPECIALIZE pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> HDoc #-}
pprDwarfARange :: IsDoc doc => Platform -> DwarfARange -> doc
pprDwarfARange :: forall doc. IsDoc doc => Platform -> DwarfARange -> doc
pprDwarfARange Platform
platform DwarfARange
arng =
Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (DwarfARange -> CLabel
dwArngStartLabel DwarfARange
arng) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1")
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform Line doc
length
where
length :: Line doc
length = Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (DwarfARange -> CLabel
dwArngEndLabel DwarfARange
arng)
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (DwarfARange -> CLabel
dwArngStartLabel DwarfARange
arng)
data DwarfFrame
= DwarfFrame
{ DwarfFrame -> CLabel
dwCieLabel :: CLabel
, DwarfFrame -> UnwindTable
dwCieInit :: UnwindTable
, DwarfFrame -> [DwarfFrameProc]
dwCieProcs :: [DwarfFrameProc]
}
data DwarfFrameProc
= DwarfFrameProc
{ DwarfFrameProc -> CLabel
dwFdeProc :: CLabel
, DwarfFrameProc -> Bool
dwFdeHasInfo :: Bool
, DwarfFrameProc -> [DwarfFrameBlock]
dwFdeBlocks :: [DwarfFrameBlock]
}
data DwarfFrameBlock
= DwarfFrameBlock
{ DwarfFrameBlock -> Bool
dwFdeBlkHasInfo :: Bool
, DwarfFrameBlock -> [UnwindPoint]
dwFdeUnwind :: [UnwindPoint]
}
instance OutputableP Platform DwarfFrameBlock where
pdoc :: Platform -> DwarfFrameBlock -> SDoc
pdoc Platform
env (DwarfFrameBlock Bool
hasInfo [UnwindPoint]
unwinds) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
hasInfo SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [UnwindPoint] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
env [UnwindPoint]
unwinds
pprDwarfFrame :: forall doc. IsDoc doc => Platform -> DwarfFrame -> doc
pprDwarfFrame :: forall doc. IsDoc doc => Platform -> DwarfFrame -> doc
pprDwarfFrame Platform
platform DwarfFrame{dwCieLabel :: DwarfFrame -> CLabel
dwCieLabel=CLabel
cieLabel,dwCieInit :: DwarfFrame -> UnwindTable
dwCieInit=UnwindTable
cieInit,dwCieProcs :: DwarfFrame -> [DwarfFrameProc]
dwCieProcs=[DwarfFrameProc]
procs}
= let cieStartLabel :: CLabel
cieStartLabel= CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
cieLabel (String -> FastString
fsLit String
"_start")
cieEndLabel :: CLabel
cieEndLabel = CLabel -> CLabel
mkAsmTempEndLabel CLabel
cieLabel
length :: Line doc
length = Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieStartLabel
spReg :: Word8
spReg = Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
platform GlobalReg
Sp
retReg :: Word8
retReg = Platform -> Word8
dwarfReturnRegNo Platform
platform
wordSize :: Int
wordSize = Platform -> Int
platformWordSizeInBytes Platform
platform
pprInit :: (GlobalReg, Maybe UnwindExpr) -> doc
pprInit :: (GlobalReg, Maybe UnwindExpr) -> doc
pprInit (GlobalReg
g, Maybe UnwindExpr
uw) = Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
forall doc.
IsDoc doc =>
Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
pprSetUnwind Platform
platform GlobalReg
g (Maybe UnwindExpr
forall a. Maybe a
Nothing, Maybe UnwindExpr
uw)
preserveSp :: doc
preserveSp = case Platform -> Arch
platformArch Platform
platform of
Arch
ArchX86 -> Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
4
Arch
ArchX86_64 -> Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
7
Arch
_ -> doc
forall doc. IsOutput doc => doc
empty
in [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
, Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' Line doc
length
, Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieStartLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
, Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1")
, Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
3
, Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
, Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
1
, Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
128Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wordSize)
, Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
retReg
] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (((GlobalReg, Maybe UnwindExpr) -> doc)
-> [(GlobalReg, Maybe UnwindExpr)] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (GlobalReg, Maybe UnwindExpr) -> doc
pprInit ([(GlobalReg, Maybe UnwindExpr)] -> [doc])
-> [(GlobalReg, Maybe UnwindExpr)] -> [doc]
forall a b. (a -> b) -> a -> b
$ UnwindTable -> [(GlobalReg, Maybe UnwindExpr)]
forall k a. Map k a -> [(k, a)]
Map.toList UnwindTable
cieInit) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [
Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_CFA_offsetWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Word8
retReg)
, Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
, doc
preserveSp
, Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_val_offset
, Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
spReg)
, Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
0
] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> doc
forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
platform doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((DwarfFrameProc -> doc) -> [DwarfFrameProc] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> doc
forall doc.
IsDoc doc =>
Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> doc
pprFrameProc Platform
platform CLabel
cieLabel UnwindTable
cieInit) [DwarfFrameProc]
procs)
{-# SPECIALIZE pprDwarfFrame :: Platform -> DwarfFrame -> SDoc #-}
{-# SPECIALIZE pprDwarfFrame :: Platform -> DwarfFrame -> HDoc #-}
pprFrameProc :: IsDoc doc => Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> doc
pprFrameProc :: forall doc.
IsDoc doc =>
Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> doc
pprFrameProc Platform
platform CLabel
frameLbl UnwindTable
initUw (DwarfFrameProc CLabel
procLbl Bool
hasInfo [DwarfFrameBlock]
blocks)
= let fdeLabel :: CLabel
fdeLabel = CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
procLbl (String -> FastString
fsLit String
"_fde")
fdeEndLabel :: CLabel
fdeEndLabel = CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
procLbl (String -> FastString
fsLit String
"_fde_end")
procEnd :: CLabel
procEnd = CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
procLbl
ifInfo :: String -> Line doc
ifInfo String
str = if Bool
hasInfo then String -> Line doc
forall doc. IsLine doc => String -> doc
text String
str else Line doc
forall doc. IsOutput doc => doc
empty
in [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [ doc -> doc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"# Unwinding for" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon
, Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeLabel)
, Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
, Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
frameLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
dwarfFrameLabel)
, Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
ifInfo String
"-1")
, Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procEnd Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<>
Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
ifInfo String
"+1")
] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (State UnwindTable [doc] -> UnwindTable -> [doc]
forall s a. State s a -> s -> a
S.evalState ((DwarfFrameBlock -> State UnwindTable doc)
-> [DwarfFrameBlock] -> State UnwindTable [doc]
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 (Platform -> DwarfFrameBlock -> State UnwindTable doc
forall doc.
IsDoc doc =>
Platform -> DwarfFrameBlock -> State UnwindTable doc
pprFrameBlock Platform
platform) [DwarfFrameBlock]
blocks) UnwindTable
initUw) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> doc
forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
platform doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
pprFrameBlock :: forall doc. IsDoc doc => Platform -> DwarfFrameBlock -> S.State UnwindTable doc
pprFrameBlock :: forall doc.
IsDoc doc =>
Platform -> DwarfFrameBlock -> State UnwindTable doc
pprFrameBlock Platform
platform (DwarfFrameBlock Bool
hasInfo [UnwindPoint]
uws0) =
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ([doc] -> doc) -> State UnwindTable [doc] -> State UnwindTable doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> UnwindPoint -> State UnwindTable doc)
-> [Bool] -> [UnwindPoint] -> State UnwindTable [doc]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Bool -> UnwindPoint -> State UnwindTable doc
pprFrameDecl (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [UnwindPoint]
uws0
where
pprFrameDecl :: Bool -> UnwindPoint -> S.State UnwindTable doc
pprFrameDecl :: Bool -> UnwindPoint -> State UnwindTable doc
pprFrameDecl Bool
firstDecl (UnwindPoint CLabel
lbl UnwindTable
uws) = (UnwindTable -> (doc, UnwindTable)) -> State UnwindTable doc
forall s a. (s -> (a, s)) -> State s a
S.state ((UnwindTable -> (doc, UnwindTable)) -> State UnwindTable doc)
-> (UnwindTable -> (doc, UnwindTable)) -> State UnwindTable doc
forall a b. (a -> b) -> a -> b
$ \UnwindTable
oldUws ->
let
isChanged :: GlobalReg -> Maybe UnwindExpr
-> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
isChanged :: GlobalReg
-> Maybe UnwindExpr -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
isChanged GlobalReg
g Maybe UnwindExpr
new
| Maybe UnwindExpr -> Maybe (Maybe UnwindExpr)
forall a. a -> Maybe a
Just Maybe UnwindExpr
new Maybe (Maybe UnwindExpr) -> Maybe (Maybe UnwindExpr) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Maybe UnwindExpr)
old = Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
forall a. Maybe a
Nothing
| Maybe (Maybe UnwindExpr)
Nothing <- Maybe (Maybe UnwindExpr)
old
, Maybe UnwindExpr
Nothing <- Maybe UnwindExpr
new = Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
forall a. Maybe a
Nothing
| Bool
otherwise = (Maybe UnwindExpr, Maybe UnwindExpr)
-> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
forall a. a -> Maybe a
Just (Maybe (Maybe UnwindExpr) -> Maybe UnwindExpr
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe UnwindExpr)
old, Maybe UnwindExpr
new)
where
old :: Maybe (Maybe UnwindExpr)
old = GlobalReg -> UnwindTable -> Maybe (Maybe UnwindExpr)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GlobalReg
g UnwindTable
oldUws
changed :: [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
changed = Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))])
-> Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
forall a b. (a -> b) -> a -> b
$ (GlobalReg
-> Maybe UnwindExpr -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr))
-> UnwindTable
-> Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey GlobalReg
-> Maybe UnwindExpr -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
isChanged UnwindTable
uws
in if UnwindTable
oldUws UnwindTable -> UnwindTable -> Bool
forall a. Eq a => a -> a -> Bool
== UnwindTable
uws
then (doc
forall doc. IsOutput doc => doc
empty, UnwindTable
oldUws)
else let
needsOffset :: Bool
needsOffset = Bool
firstDecl Bool -> Bool -> Bool
&& Bool
hasInfo
lblDoc :: Line doc
lblDoc = Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<>
if Bool
needsOffset then String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1" else Line doc
forall doc. IsOutput doc => doc
empty
doc :: doc
doc = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_set_loc doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform Line doc
lblDoc doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (((GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> doc)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map ((GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc)
-> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> doc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc)
-> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> doc)
-> (GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc)
-> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))
-> doc
forall a b. (a -> b) -> a -> b
$ Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
forall doc.
IsDoc doc =>
Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
pprSetUnwind Platform
platform) [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
changed)
in (doc
doc, UnwindTable
uws)
dwarfGlobalRegNo :: Platform -> GlobalReg -> Word8
dwarfGlobalRegNo :: Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
p GlobalReg
UnwindReturnReg = Platform -> Word8
dwarfReturnRegNo Platform
p
dwarfGlobalRegNo Platform
p GlobalReg
reg = Word8 -> (RealReg -> Word8) -> Maybe RealReg -> Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word8
0 (Platform -> Reg -> Word8
dwarfRegNo Platform
p (Reg -> Word8) -> (RealReg -> Reg) -> RealReg -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealReg -> Reg
RegReal) (Maybe RealReg -> Word8) -> Maybe RealReg -> Word8
forall a b. (a -> b) -> a -> b
$ Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
p GlobalReg
reg
pprSetUnwind :: IsDoc doc => Platform
-> GlobalReg
-> (Maybe UnwindExpr, Maybe UnwindExpr)
-> doc
pprSetUnwind :: forall doc.
IsDoc doc =>
Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
pprSetUnwind Platform
plat GlobalReg
g (Maybe UnwindExpr
_, Maybe UnwindExpr
Nothing)
= Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprUndefUnwind Platform
plat GlobalReg
g
pprSetUnwind Platform
_ GlobalReg
Sp (Just (UwReg GlobalRegUse
s Int
_), Just (UwReg GlobalRegUse
s' Int
o')) | GlobalRegUse
s GlobalRegUse -> GlobalRegUse -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalRegUse
s'
= if Int
o' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
then Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_offset doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o')
else Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_offset_sf doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> doc
forall {b}. IsDoc b => Int -> b
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just (UwReg (GlobalRegUse GlobalReg
s' CmmType
_) Int
o'))
= if Int
o' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
then Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
s' doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o')
else Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_sf doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
s' doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> doc
forall {b}. IsDoc b => Int -> b
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just UnwindExpr
uw)
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_expression doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Bool -> UnwindExpr -> doc
forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
plat Bool
False UnwindExpr
uw
pprSetUnwind Platform
plat GlobalReg
g (Maybe UnwindExpr
_, Just (UwDeref (UwReg (GlobalRegUse GlobalReg
Sp CmmType
_) Int
o)))
| Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& ((-Int
o) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Platform -> Int
platformWordSizeInBytes Platform
plat) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_CFA_offset Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat GlobalReg
g) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((-Int
o) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Platform -> Int
platformWordSizeInBytes Platform
plat))
| Bool
otherwise
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_offset_extended_sf doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> doc
forall {b}. IsDoc b => Int -> b
pprLEBInt Int
o
pprSetUnwind Platform
plat GlobalReg
g (Maybe UnwindExpr
_, Just (UwDeref UnwindExpr
uw))
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_expression doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> Bool -> UnwindExpr -> doc
forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
plat Bool
True UnwindExpr
uw
pprSetUnwind Platform
plat GlobalReg
g (Maybe UnwindExpr
_, Just (UwReg (GlobalRegUse GlobalReg
g' CmmType
_) Int
0))
| GlobalReg
g GlobalReg -> GlobalReg -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalReg
g'
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g
pprSetUnwind Platform
plat GlobalReg
g (Maybe UnwindExpr
_, Just UnwindExpr
uw)
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_val_expression doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> Bool -> UnwindExpr -> doc
forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
plat Bool
True UnwindExpr
uw
pprLEBRegNo :: IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo :: forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat = Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word -> doc) -> (GlobalReg -> Word) -> GlobalReg -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word) -> (GlobalReg -> Word8) -> GlobalReg -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat
pprUnwindExpr :: IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr :: forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
platform Bool
spIsCFA UnwindExpr
expr
= let pprE :: UnwindExpr -> doc
pprE (UwConst Int
i)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_OP_lit0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
| Bool
otherwise = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_consts doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> doc
forall {b}. IsDoc b => Int -> b
pprLEBInt Int
i
pprE (UwReg r :: GlobalRegUse
r@(GlobalRegUse GlobalReg
Sp CmmType
_) Int
i)
| Bool
spIsCFA
= if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_call_frame_cfa
else UnwindExpr -> doc
pprE (UnwindExpr -> UnwindExpr -> UnwindExpr
UwPlus (GlobalRegUse -> Int -> UnwindExpr
UwReg GlobalRegUse
r Int
0) (Int -> UnwindExpr
UwConst Int
i))
pprE (UwReg (GlobalRegUse GlobalReg
g CmmType
_) Int
i)
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_OP_breg0Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
platform GlobalReg
g) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> doc
forall {b}. IsDoc b => Int -> b
pprLEBInt Int
i
pprE (UwDeref UnwindExpr
u) = UnwindExpr -> doc
pprE UnwindExpr
u doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_deref
pprE (UwLabel CLabel
l) = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_addr doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
l)
pprE (UwPlus UnwindExpr
u1 UnwindExpr
u2) = UnwindExpr -> doc
pprE UnwindExpr
u1 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ UnwindExpr -> doc
pprE UnwindExpr
u2 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_plus
pprE (UwMinus UnwindExpr
u1 UnwindExpr
u2) = UnwindExpr -> doc
pprE UnwindExpr
u1 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ UnwindExpr -> doc
pprE UnwindExpr
u2 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_minus
pprE (UwTimes UnwindExpr
u1 UnwindExpr
u2) = UnwindExpr -> doc
pprE UnwindExpr
u1 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ UnwindExpr -> doc
pprE UnwindExpr
u2 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_mul
in Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.uleb128 2f-1f") doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"1:") doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
UnwindExpr -> doc
pprE UnwindExpr
expr doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"2:")
pprUndefUnwind :: IsDoc doc => Platform -> GlobalReg -> doc
pprUndefUnwind :: forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprUndefUnwind Platform
plat GlobalReg
g = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_undefined doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g
wordAlign :: IsDoc doc => Platform -> doc
wordAlign :: forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
plat =
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.align " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> case Platform -> OS
platformOS Platform
plat of
OS
OSDarwin -> case Platform -> PlatformWordSize
platformWordSize Platform
plat of
PlatformWordSize
PW8 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'3'
PlatformWordSize
PW4 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'2'
OS
_other -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int (Platform -> Int
platformWordSizeInBytes Platform
plat)
{-# SPECIALIZE wordAlign :: Platform -> SDoc #-}
{-# SPECIALIZE wordAlign :: Platform -> HDoc #-}
pprByte :: IsDoc doc => Word8 -> doc
pprByte :: forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
x = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.byte " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Integer -> Line doc
forall doc. IsLine doc => Integer -> doc
integer (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
{-# SPECIALIZE pprByte :: Word8 -> SDoc #-}
{-# SPECIALIZE pprByte :: Word8 -> HDoc #-}
pprHalf :: IsDoc doc => Word16 -> doc
pprHalf :: forall doc. IsDoc doc => Word16 -> doc
pprHalf Word16
x = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.short" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Integer -> Line doc
forall doc. IsLine doc => Integer -> doc
integer (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
{-# SPECIALIZE pprHalf :: Word16 -> SDoc #-}
{-# SPECIALIZE pprHalf :: Word16 -> HDoc #-}
pprFlag :: IsDoc doc => Bool -> doc
pprFlag :: forall doc. IsDoc doc => Bool -> doc
pprFlag Bool
f = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (if Bool
f then Word8
0xff else Word8
0x00)
pprData4' :: IsDoc doc => Line doc -> doc
pprData4' :: forall doc. IsDoc doc => Line doc -> doc
pprData4' Line doc
x = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
x)
{-# SPECIALIZE pprData4' :: SDoc -> SDoc #-}
{-# SPECIALIZE pprData4' :: HLine -> HDoc #-}
pprData4 :: IsDoc doc => Word -> doc
pprData4 :: forall doc. IsDoc doc => Word -> doc
pprData4 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (Line doc -> doc) -> (Word -> Line doc) -> Word -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Line doc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> Line doc) -> (Word -> Integer) -> Word -> Line doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
pprDwWord :: IsDoc doc => Line doc -> doc
pprDwWord :: forall doc. IsDoc doc => Line doc -> doc
pprDwWord = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4'
{-# SPECIALIZE pprDwWord :: SDoc -> SDoc #-}
{-# SPECIALIZE pprDwWord :: HLine -> HDoc #-}
pprWord :: IsDoc doc => Platform -> Line doc -> doc
pprWord :: forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
plat Line doc
s =
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ case Platform -> PlatformWordSize
platformWordSize Platform
plat of
PlatformWordSize
PW4 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
s
PlatformWordSize
PW8 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.quad " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
s
{-# SPECIALIZE pprWord :: Platform -> SDoc -> SDoc #-}
{-# SPECIALIZE pprWord :: Platform -> HLine -> HDoc #-}
pprLEBWord :: IsDoc doc => Word -> doc
pprLEBWord :: forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
x | Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
128 = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x)
| Bool
otherwise = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> Word -> Word8
forall a b. (a -> b) -> a -> b
$ Word
128 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
127)) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
{-# SPECIALIZE pprLEBWord :: Word -> SDoc #-}
{-# SPECIALIZE pprLEBWord :: Word -> HDoc #-}
pprLEBInt :: IsDoc doc => Int -> doc
pprLEBInt :: forall {b}. IsDoc b => Int -> b
pprLEBInt Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
64 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
64
= Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
127))
| Bool
otherwise = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
128 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
127)) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Int -> doc
forall {b}. IsDoc b => Int -> b
pprLEBInt (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
{-# SPECIALIZE pprLEBInt :: Int -> SDoc #-}
{-# SPECIALIZE pprLEBInt :: Int -> HDoc #-}
pprString' :: IsDoc doc => Line doc -> doc
pprString' :: forall doc. IsDoc doc => Line doc -> doc
pprString' Line doc
str = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.asciz \"" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
str Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'"')
pprString :: IsDoc doc => String -> doc
pprString :: forall doc. IsDoc doc => String -> doc
pprString String
str
= Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprString' (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat ([Line doc] -> Line doc) -> [Line doc] -> Line doc
forall a b. (a -> b) -> a -> b
$ (Char -> Line doc) -> String -> [Line doc]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Line doc
forall doc. IsLine doc => Char -> doc
escapeChar (String -> [Line doc]) -> String -> [Line doc]
forall a b. (a -> b) -> a -> b
$
if String
str String -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` String -> Int
utf8EncodedLength String
str
then String
str
else (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
utf8EncodeByteString String
str
escapeChar :: IsLine doc => Char -> doc
escapeChar :: forall doc. IsLine doc => Char -> doc
escapeChar Char
'\\' = String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\\\"
escapeChar Char
'\"' = String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\\""
escapeChar Char
'\n' = String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\n"
escapeChar Char
c
| Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?'
= Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
c
| Bool
otherwise
= Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'\\' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
64)) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<>
Char -> doc
forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit ((Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<>
Char -> doc
forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8))
where ch :: Int
ch = Char -> Int
ord Char
c
sectionOffset :: IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset :: forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
plat Line doc
target Line doc
section =
case Platform -> OS
platformOS Platform
plat of
OS
OSDarwin -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprDwWord (Line doc
target Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
section)
OS
OSMinGW32 -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.secrel32 " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
target)
OS
_other -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprDwWord Line doc
target
{-# SPECIALIZE sectionOffset :: Platform -> SDoc -> SDoc -> SDoc #-}
{-# SPECIALIZE sectionOffset :: Platform -> HLine -> HLine -> HDoc #-}