module GHC.CmmToAsm.Dwarf.Types
  ( -- * Dwarf information
    DwarfInfo(..)
  , pprDwarfInfo
  , pprAbbrevDecls
    -- * Dwarf address range table
  , DwarfARange(..)
  , pprDwarfARanges
    -- * Dwarf frame
  , DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..)
  , pprDwarfFrame
    -- * Utilities
  , 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         ( GlobalReg(..) )
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 Control.Monad.Trans.State.Strict as S
import Control.Monad (zipWithM, join)
import Data.Bits
import qualified Data.Map as Map
import Data.Word
import Data.Char

import GHC.Platform.Regs

-- | Individual dwarf records. Each one will be encoded as an entry in
-- the @.debug_info@ section.
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
                     , DwarfInfo -> PtrString
dwLineLabel :: PtrString }
  | DwarfSubprogram { dwChildren :: [DwarfInfo]
                    , dwName :: String
                    , DwarfInfo -> CLabel
dwLabel :: CLabel
                    , DwarfInfo -> Maybe CLabel
dwParent :: Maybe CLabel
                      -- ^ label of DIE belonging to the parent tick
                    }
  | DwarfBlock { dwChildren :: [DwarfInfo]
               , dwLabel :: CLabel
               , DwarfInfo -> Maybe CLabel
dwMarker :: Maybe CLabel
               }
  | DwarfSrcNote { DwarfInfo -> RealSrcSpan
dwSrcSpan :: RealSrcSpan
                 }

-- | Abbreviation codes used for encoding above records in the
-- @.debug_info@ section.
data DwarfAbbrev
  = DwAbbrNull          -- ^ Pseudo, used for marking the end of lists
  | 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
/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
$c/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
== :: DwarfAbbrev -> DwarfAbbrev -> Bool
$c== :: 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
enumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFrom :: DwarfAbbrev -> [DwarfAbbrev]
$cenumFrom :: DwarfAbbrev -> [DwarfAbbrev]
fromEnum :: DwarfAbbrev -> Int
$cfromEnum :: DwarfAbbrev -> Int
toEnum :: Int -> DwarfAbbrev
$ctoEnum :: Int -> DwarfAbbrev
pred :: DwarfAbbrev -> DwarfAbbrev
$cpred :: DwarfAbbrev -> DwarfAbbrev
succ :: DwarfAbbrev -> DwarfAbbrev
$csucc :: DwarfAbbrev -> DwarfAbbrev
External instance of the constraint type Enum Int
External instance of the constraint type Show Int
External instance of the constraint type Show Int
External instance of the constraint type Eq Int
External instance of the constraint type Ord Int
External instance of the constraint type Num Int
Enum)

-- | Generate assembly for the given abbreviation code
pprAbbrev :: DwarfAbbrev -> SDoc
pprAbbrev :: DwarfAbbrev -> SDoc
pprAbbrev = Word -> SDoc
pprLEBWord (Word -> SDoc) -> (DwarfAbbrev -> Word) -> DwarfAbbrev -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
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
Instance of class: Enum of the constraint type Enum DwarfAbbrev
fromEnum

-- | Abbreviation declaration. This explains the binary encoding we
-- use for representing 'DwarfInfo'. Be aware that this must be updated
-- along with 'pprDwarfInfo'.
pprAbbrevDecls :: Platform -> Bool -> SDoc
pprAbbrevDecls :: Platform -> Bool -> SDoc
pprAbbrevDecls Platform
platform Bool
haveDebugLine =
  let mkAbbrev :: DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
abbr Word
tag Word8
chld [(Word, Word)]
flds =
        let fld :: (Word, Word) -> SDoc
fld (Word
tag, Word
form) = Word -> SDoc
pprLEBWord Word
tag SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprLEBWord Word
form
        in DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
abbr SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprLEBWord Word
tag SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
chld SDoc -> SDoc -> SDoc
$$
           [SDoc] -> SDoc
vcat (((Word, Word) -> SDoc) -> [(Word, Word)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Word, Word) -> SDoc
fld [(Word, Word)]
flds) SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
0 SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
0
      -- These are shared between DwAbbrSubprogram and
      -- DwAbbrSubprogramWithParent
      subprogramAttrs :: [(Word, Word)]
subprogramAttrs =
           [ (Word
dW_AT_name, Word
dW_FORM_string)
           , (Word
dW_AT_MIPS_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 -> SDoc
dwarfAbbrevSection Platform
platform SDoc -> SDoc -> SDoc
$$
     PtrString -> SDoc
ptext PtrString
dwarfAbbrevLabel SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
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)  -- not represented in body
       , (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 [])) SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrSubprogram Word
dW_TAG_subprogram Word8
dW_CHILDREN_yes
       [(Word, Word)]
subprogramAttrs SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
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)]) SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode Word
dW_TAG_lexical_block Word8
dW_CHILDREN_yes
       [ (Word
dW_AT_name, Word
dW_FORM_string)
       ] SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
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)
       ] SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
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)
       ] SDoc -> SDoc -> SDoc
$$
     Word8 -> SDoc
pprByte Word8
0

-- | Generate assembly for DWARF data
pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> SDoc
pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> SDoc
pprDwarfInfo Platform
platform Bool
haveSrc DwarfInfo
d
  = case DwarfInfo
d of
      DwarfCompileUnit {}  -> SDoc
hasChildren
      DwarfSubprogram {}   -> SDoc
hasChildren
      DwarfBlock {}        -> SDoc
hasChildren
      DwarfSrcNote {}      -> SDoc
noChildren
  where
    hasChildren :: SDoc
hasChildren =
        Platform -> Bool -> DwarfInfo -> SDoc
pprDwarfInfoOpen Platform
platform Bool
haveSrc DwarfInfo
d SDoc -> SDoc -> SDoc
$$
        [SDoc] -> SDoc
vcat ((DwarfInfo -> SDoc) -> [DwarfInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Bool -> DwarfInfo -> SDoc
pprDwarfInfo Platform
platform Bool
haveSrc) (DwarfInfo -> [DwarfInfo]
dwChildren DwarfInfo
d)) SDoc -> SDoc -> SDoc
$$
        SDoc
pprDwarfInfoClose
    noChildren :: SDoc
noChildren = Platform -> Bool -> DwarfInfo -> SDoc
pprDwarfInfoOpen Platform
platform Bool
haveSrc DwarfInfo
d

-- | Prints assembler data corresponding to DWARF info records. Note
-- that the binary format of this is parameterized in @abbrevDecls@ and
-- has to be kept in synch.
pprDwarfInfoOpen :: Platform -> Bool -> DwarfInfo -> SDoc
pprDwarfInfoOpen :: Platform -> Bool -> DwarfInfo -> SDoc
pprDwarfInfoOpen Platform
platform Bool
haveSrc (DwarfCompileUnit [DwarfInfo]
_ String
name String
producer String
compDir CLabel
lowLabel
                                           CLabel
highLabel PtrString
lineLbl) =
  DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
DwAbbrCompileUnit
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
pprString String
name
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
pprString String
producer
  SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprData4 Word
dW_LANG_Haskell
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
pprString String
compDir
  SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
lowLabel)
  SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
highLabel)
  SDoc -> SDoc -> SDoc
$$ if Bool
haveSrc
     then Platform -> SDoc -> SDoc -> SDoc
sectionOffset Platform
platform (PtrString -> SDoc
ptext PtrString
lineLbl) (PtrString -> SDoc
ptext PtrString
dwarfLineLabel)
     else SDoc
empty
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfSubprogram [DwarfInfo]
_ String
name CLabel
label
                                    Maybe CLabel
parent) = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
  CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) SDoc -> SDoc -> SDoc
<> SDoc
colon
  SDoc -> SDoc -> SDoc
$$ DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
abbrev
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
pprString String
name
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
pprString (SDocContext -> SDoc -> String
renderWithStyle (DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
df (CodeStyle -> PprStyle
mkCodeStyle CodeStyle
CStyle)) (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
label))
  SDoc -> SDoc -> SDoc
$$ Bool -> SDoc
pprFlag (CLabel -> Bool
externallyVisibleCLabel CLabel
label)
  SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
label)
  SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (CLabel -> SDoc) -> CLabel -> SDoc
forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempEndLabel CLabel
label)
  SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
1
  SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
dW_OP_call_frame_cfa
  SDoc -> SDoc -> SDoc
$$ SDoc
parentValue
  where
    abbrev :: DwarfAbbrev
abbrev = case Maybe CLabel
parent of Maybe CLabel
Nothing -> DwarfAbbrev
DwAbbrSubprogram
                            Just CLabel
_  -> DwarfAbbrev
DwAbbrSubprogramWithParent
    parentValue :: SDoc
parentValue = SDoc -> (CLabel -> SDoc) -> Maybe CLabel -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
empty CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
pprParentDie Maybe CLabel
parent
    pprParentDie :: a -> SDoc
pprParentDie a
sym = Platform -> SDoc -> SDoc -> SDoc
sectionOffset Platform
platform (a -> SDoc
forall a. Outputable a => a -> SDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr a
sym) (PtrString -> SDoc
ptext PtrString
dwarfInfoLabel)
pprDwarfInfoOpen Platform
_ Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label Maybe CLabel
Nothing) = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
  CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) SDoc -> SDoc -> SDoc
<> SDoc
colon
  SDoc -> SDoc -> SDoc
$$ DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
pprString (SDocContext -> SDoc -> String
renderWithStyle (DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
df (CodeStyle -> PprStyle
mkCodeStyle CodeStyle
CStyle)) (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
label))
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label (Just CLabel
marker)) = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
  CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) SDoc -> SDoc -> SDoc
<> SDoc
colon
  SDoc -> SDoc -> SDoc
$$ DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
DwAbbrBlock
  SDoc -> SDoc -> SDoc
$$ String -> SDoc
pprString (SDocContext -> SDoc -> String
renderWithStyle (DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
df (CodeStyle -> PprStyle
mkCodeStyle CodeStyle
CStyle)) (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
label))
  SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
marker)
  SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (CLabel -> SDoc) -> CLabel -> SDoc
forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempEndLabel CLabel
marker)
pprDwarfInfoOpen Platform
_ Bool
_ (DwarfSrcNote RealSrcSpan
ss) =
  DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
DwAbbrGhcSrcNote
  SDoc -> SDoc -> SDoc
$$ SDoc -> SDoc
pprString' (FastString -> SDoc
ftext (FastString -> SDoc) -> FastString -> SDoc
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
ss)
  SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprData4 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss)
  SDoc -> SDoc -> SDoc
$$ Word16 -> SDoc
pprHalf (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word16
External instance of the constraint type Integral Int
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss)
  SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprData4 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss)
  SDoc -> SDoc -> SDoc
$$ Word16 -> SDoc
pprHalf (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word16
External instance of the constraint type Integral Int
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
ss)

-- | Close a DWARF info record with children
pprDwarfInfoClose :: SDoc
pprDwarfInfoClose :: SDoc
pprDwarfInfoClose = DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
DwAbbrNull

-- | A DWARF address range. This is used by the debugger to quickly locate
-- which compilation unit a given address belongs to. This type assumes
-- a non-segmented address-space.
data DwarfARange
  = DwarfARange
    { DwarfARange -> CLabel
dwArngStartLabel :: CLabel
    , DwarfARange -> CLabel
dwArngEndLabel   :: CLabel
    }

-- | Print assembler directives corresponding to a DWARF @.debug_aranges@
-- address table entry.
pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> SDoc
pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> SDoc
pprDwarfARanges Platform
platform [DwarfARange]
arngs Unique
unitU =
  let wordSize :: Int
wordSize = Platform -> Int
platformWordSizeInBytes Platform
platform
      paddingSize :: Int
paddingSize = Int
4 :: Int
      -- header is 12 bytes long.
      -- entry is 8 bytes (32-bit platform) or 16 bytes (64-bit platform).
      -- pad such that first entry begins at multiple of entry size.
      pad :: Int -> SDoc
pad Int
n = [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> SDoc -> [SDoc]
forall a. Int -> a -> [a]
replicate Int
n (SDoc -> [SDoc]) -> SDoc -> [SDoc]
forall a b. (a -> b) -> a -> b
$ Word8 -> SDoc
pprByte Word8
0
      -- Fix for #17428
      initialLength :: Int
initialLength = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
paddingSize Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ [DwarfARange] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
External instance of the constraint type Foldable []
length [DwarfARange]
arngs) Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
wordSize
  in SDoc -> SDoc
pprDwWord (Int -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Int
ppr Int
initialLength)
     SDoc -> SDoc -> SDoc
$$ Word16 -> SDoc
pprHalf Word16
2
     SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc -> SDoc
sectionOffset Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (CLabel -> SDoc) -> CLabel -> SDoc
forall a b. (a -> b) -> a -> b
$ Unique -> CLabel
forall a. Uniquable a => a -> CLabel
External instance of the constraint type Uniquable Unique
mkAsmTempLabel (Unique -> CLabel) -> Unique -> CLabel
forall a b. (a -> b) -> a -> b
$ Unique
unitU)
                               (PtrString -> SDoc
ptext PtrString
dwarfInfoLabel)
     SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
fromIntegral Int
wordSize)
     SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
0
     SDoc -> SDoc -> SDoc
$$ Int -> SDoc
pad Int
paddingSize
     -- body
     SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat ((DwarfARange -> SDoc) -> [DwarfARange] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> DwarfARange -> SDoc
pprDwarfARange Platform
platform) [DwarfARange]
arngs)
     -- terminus
     SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (Char -> SDoc
char Char
'0')
     SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (Char -> SDoc
char Char
'0')

pprDwarfARange :: Platform -> DwarfARange -> SDoc
pprDwarfARange :: Platform -> DwarfARange -> SDoc
pprDwarfARange Platform
platform DwarfARange
arng = Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (CLabel -> SDoc) -> CLabel -> SDoc
forall a b. (a -> b) -> a -> b
$ DwarfARange -> CLabel
dwArngStartLabel DwarfARange
arng) SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform SDoc
length
  where
    length :: SDoc
length = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (DwarfARange -> CLabel
dwArngEndLabel DwarfARange
arng)
             SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr (DwarfARange -> CLabel
dwArngStartLabel DwarfARange
arng)

-- | Information about unwind instructions for a procedure. This
-- corresponds to a "Common Information Entry" (CIE) in DWARF.
data DwarfFrame
  = DwarfFrame
    { DwarfFrame -> CLabel
dwCieLabel :: CLabel
    , DwarfFrame -> UnwindTable
dwCieInit  :: UnwindTable
    , DwarfFrame -> [DwarfFrameProc]
dwCieProcs :: [DwarfFrameProc]
    }

-- | Unwind instructions for an individual procedure. Corresponds to a
-- "Frame Description Entry" (FDE) in DWARF.
data DwarfFrameProc
  = DwarfFrameProc
    { DwarfFrameProc -> CLabel
dwFdeProc    :: CLabel
    , DwarfFrameProc -> Bool
dwFdeHasInfo :: Bool
    , DwarfFrameProc -> [DwarfFrameBlock]
dwFdeBlocks  :: [DwarfFrameBlock]
      -- ^ List of blocks. Order must match asm!
    }

-- | Unwind instructions for a block. Will become part of the
-- containing FDE.
data DwarfFrameBlock
  = DwarfFrameBlock
    { DwarfFrameBlock -> Bool
dwFdeBlkHasInfo :: Bool
    , DwarfFrameBlock -> [UnwindPoint]
dwFdeUnwind     :: [UnwindPoint]
      -- ^ these unwind points must occur in the same order as they occur
      -- in the block
    }

instance Outputable DwarfFrameBlock where
  ppr :: DwarfFrameBlock -> SDoc
ppr (DwarfFrameBlock Bool
hasInfo [UnwindPoint]
unwinds) = SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Bool
ppr Bool
hasInfo SDoc -> SDoc -> SDoc
<+> [UnwindPoint] -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable UnwindPoint
ppr [UnwindPoint]
unwinds

-- | Header for the @.debug_frame@ section. Here we emit the "Common
-- Information Entry" record that establishes general call frame
-- parameters and the default stack layout.
pprDwarfFrame :: Platform -> DwarfFrame -> SDoc
pprDwarfFrame :: Platform -> DwarfFrame -> SDoc
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 :: SDoc
length      = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
cieEndLabel SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr 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) -> SDoc
        pprInit :: (GlobalReg, Maybe UnwindExpr) -> SDoc
pprInit (GlobalReg
g, Maybe UnwindExpr
uw) = Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc
pprSetUnwind Platform
platform GlobalReg
g (Maybe UnwindExpr
forall a. Maybe a
Nothing, Maybe UnwindExpr
uw)

        -- Preserve C stack pointer: This necessary to override that default
        -- unwinding behavior of setting $sp = CFA.
        preserveSp :: SDoc
preserveSp = case Platform -> Arch
platformArch Platform
platform of
          Arch
ArchX86    -> Word8 -> SDoc
pprByte Word8
dW_CFA_same_value SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprLEBWord Word
4
          Arch
ArchX86_64 -> Word8 -> SDoc
pprByte Word8
dW_CFA_same_value SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprLEBWord Word
7
          Arch
_          -> SDoc
empty
    in [SDoc] -> SDoc
vcat [ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
cieLabel SDoc -> SDoc -> SDoc
<> SDoc
colon
            , SDoc -> SDoc
pprData4' SDoc
length -- Length of CIE
            , CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
cieStartLabel SDoc -> SDoc -> SDoc
<> SDoc
colon
            , SDoc -> SDoc
pprData4' (String -> SDoc
text String
"-1")
                               -- Common Information Entry marker (-1 = 0xf..f)
            , Word8 -> SDoc
pprByte Word8
3        -- CIE version (we require DWARF 3)
            , Word8 -> SDoc
pprByte Word8
0        -- Augmentation (none)
            , Word8 -> SDoc
pprByte Word8
1        -- Code offset multiplicator
            , Word8 -> SDoc
pprByte (Word8
128Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word8
-Int -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
fromIntegral Int
wordSize)
                               -- Data offset multiplicator
                               -- (stacks grow down => "-w" in signed LEB128)
            , Word8 -> SDoc
pprByte Word8
retReg   -- virtual register holding return address
            ] SDoc -> SDoc -> SDoc
$$
       -- Initial unwind table
       [SDoc] -> SDoc
vcat (((GlobalReg, Maybe UnwindExpr) -> SDoc)
-> [(GlobalReg, Maybe UnwindExpr)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (GlobalReg, Maybe UnwindExpr) -> SDoc
pprInit ([(GlobalReg, Maybe UnwindExpr)] -> [SDoc])
-> [(GlobalReg, Maybe UnwindExpr)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ UnwindTable -> [(GlobalReg, Maybe UnwindExpr)]
forall k a. Map k a -> [(k, a)]
Map.toList UnwindTable
cieInit) SDoc -> SDoc -> SDoc
$$
       [SDoc] -> SDoc
vcat [ -- RET = *CFA
              Word8 -> SDoc
pprByte (Word8
dW_CFA_offsetWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word8
+Word8
retReg)
            , Word8 -> SDoc
pprByte Word8
0

              -- Preserve C stack pointer
            , SDoc
preserveSp

              -- Sp' = CFA
              -- (we need to set this manually as our (STG) Sp register is
              -- often not the architecture's default stack register)
            , Word8 -> SDoc
pprByte Word8
dW_CFA_val_offset
            , Word -> SDoc
pprLEBWord (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Word8
fromIntegral Word8
spReg)
            , Word -> SDoc
pprLEBWord Word
0
            ] SDoc -> SDoc -> SDoc
$$
       Platform -> SDoc
wordAlign Platform
platform SDoc -> SDoc -> SDoc
$$
       CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
cieEndLabel SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
$$
       -- Procedure unwind tables
       [SDoc] -> SDoc
vcat ((DwarfFrameProc -> SDoc) -> [DwarfFrameProc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> SDoc
pprFrameProc Platform
platform CLabel
cieLabel UnwindTable
cieInit) [DwarfFrameProc]
procs)

-- | Writes a "Frame Description Entry" for a procedure. This consists
-- mainly of referencing the CIE and writing state machine
-- instructions to describe how the frame base (CFA) changes.
pprFrameProc :: Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> SDoc
pprFrameProc :: Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> SDoc
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
mkAsmTempEndLabel CLabel
procLbl
        ifInfo :: String -> SDoc
ifInfo String
str  = if Bool
hasInfo then String -> SDoc
text String
str else SDoc
empty
                      -- see [Note: Info Offset]
    in [SDoc] -> SDoc
vcat [ SDoc -> SDoc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"# Unwinding for" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
procLbl SDoc -> SDoc -> SDoc
<> SDoc
colon
            , SDoc -> SDoc
pprData4' (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
fdeEndLabel SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
fdeLabel)
            , CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
fdeLabel SDoc -> SDoc -> SDoc
<> SDoc
colon
            , SDoc -> SDoc
pprData4' (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
frameLbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<>
                         PtrString -> SDoc
ptext PtrString
dwarfFrameLabel)    -- Reference to CIE
            , Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
procLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
ifInfo String
"-1") -- Code pointer
            , Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
procEnd SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<>
                                 CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
procLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
ifInfo String
"+1") -- Block byte length
            ] SDoc -> SDoc -> SDoc
$$
       [SDoc] -> SDoc
vcat (State UnwindTable [SDoc] -> UnwindTable -> [SDoc]
forall s a. State s a -> s -> a
S.evalState ((DwarfFrameBlock -> StateT UnwindTable Identity SDoc)
-> [DwarfFrameBlock] -> State UnwindTable [SDoc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
External instance of the constraint type forall (m :: * -> *) s. Monad m => Monad (StateT s m)
External instance of the constraint type Monad Identity
External instance of the constraint type Traversable []
mapM (Platform -> DwarfFrameBlock -> StateT UnwindTable Identity SDoc
pprFrameBlock Platform
platform) [DwarfFrameBlock]
blocks) UnwindTable
initUw) SDoc -> SDoc -> SDoc
$$
       Platform -> SDoc
wordAlign Platform
platform SDoc -> SDoc -> SDoc
$$
       CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
fdeEndLabel SDoc -> SDoc -> SDoc
<> SDoc
colon

-- | Generates unwind information for a block. We only generate
-- instructions where unwind information actually changes. This small
-- optimisations saves a lot of space, as subsequent blocks often have
-- the same unwind information.
pprFrameBlock :: Platform -> DwarfFrameBlock -> S.State UnwindTable SDoc
pprFrameBlock :: Platform -> DwarfFrameBlock -> StateT UnwindTable Identity SDoc
pprFrameBlock Platform
platform (DwarfFrameBlock Bool
hasInfo [UnwindPoint]
uws0) =
    [SDoc] -> SDoc
vcat ([SDoc] -> SDoc)
-> State UnwindTable [SDoc] -> StateT UnwindTable Identity SDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (m :: * -> *) s. Functor m => Functor (StateT s m)
External instance of the constraint type Functor Identity
<$> (Bool -> UnwindPoint -> StateT UnwindTable Identity SDoc)
-> [Bool] -> [UnwindPoint] -> State UnwindTable [SDoc]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
External instance of the constraint type forall (m :: * -> *) s.
(Functor m, Monad m) =>
Applicative (StateT s m)
External instance of the constraint type Functor Identity
External instance of the constraint type Monad Identity
zipWithM Bool -> UnwindPoint -> StateT UnwindTable Identity SDoc
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 SDoc
    pprFrameDecl :: Bool -> UnwindPoint -> StateT UnwindTable Identity SDoc
pprFrameDecl Bool
firstDecl (UnwindPoint CLabel
lbl UnwindTable
uws) = (UnwindTable -> (SDoc, UnwindTable))
-> StateT UnwindTable Identity SDoc
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
External instance of the constraint type Monad Identity
S.state ((UnwindTable -> (SDoc, UnwindTable))
 -> StateT UnwindTable Identity SDoc)
-> (UnwindTable -> (SDoc, UnwindTable))
-> StateT UnwindTable Identity SDoc
forall a b. (a -> b) -> a -> b
$ \UnwindTable
oldUws ->
        let -- Did a register's unwind expression change?
            isChanged :: GlobalReg -> Maybe UnwindExpr
                      -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
            isChanged :: GlobalReg
-> Maybe UnwindExpr -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
isChanged GlobalReg
g Maybe UnwindExpr
new
                -- the value didn't change
              | 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
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq UnwindExpr
== Maybe (Maybe UnwindExpr)
old = Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
forall a. Maybe a
Nothing
                -- the value was and still is undefined
              | Maybe (Maybe UnwindExpr)
Nothing <- Maybe (Maybe UnwindExpr)
old
              , Maybe UnwindExpr
Nothing <- Maybe UnwindExpr
new  = Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
forall a. Maybe a
Nothing
                -- the value changed
              | 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
External instance of the constraint type Monad Maybe
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
External instance of the constraint type Ord GlobalReg
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
External instance of the constraint type forall k a. (Eq k, Eq a) => Eq (Map k a)
External instance of the constraint type Eq GlobalReg
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq UnwindExpr
== UnwindTable
uws
             then (SDoc
empty, UnwindTable
oldUws)
             else let -- see [Note: Info Offset]
                      needsOffset :: Bool
needsOffset = Bool
firstDecl Bool -> Bool -> Bool
&& Bool
hasInfo
                      lblDoc :: SDoc
lblDoc = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<>
                               if Bool
needsOffset then String -> SDoc
text String
"-1" else SDoc
empty
                      doc :: SDoc
doc = Word8 -> SDoc
pprByte Word8
dW_CFA_set_loc SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform SDoc
lblDoc SDoc -> SDoc -> SDoc
$$
                            [SDoc] -> SDoc
vcat (((GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> SDoc)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc)
-> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> SDoc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc)
 -> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> SDoc)
-> (GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc)
-> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))
-> SDoc
forall a b. (a -> b) -> a -> b
$ Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc
pprSetUnwind Platform
platform) [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
changed)
                  in (SDoc
doc, UnwindTable
uws)

-- Note [Info Offset]
--
-- GDB was pretty much written with C-like programs in mind, and as a
-- result they assume that once you have a return address, it is a
-- good idea to look at (PC-1) to unwind further - as that's where the
-- "call" instruction is supposed to be.
--
-- Now on one hand, code generated by GHC looks nothing like what GDB
-- expects, and in fact going up from a return pointer is guaranteed
-- to land us inside an info table! On the other hand, that actually
-- gives us some wiggle room, as we expect IP to never *actually* end
-- up inside the info table, so we can "cheat" by putting whatever GDB
-- expects to see there. This is probably pretty safe, as GDB cannot
-- assume (PC-1) to be a valid code pointer in the first place - and I
-- have seen no code trying to correct this.
--
-- Note that this will not prevent GDB from failing to look-up the
-- correct function name for the frame, as that uses the symbol table,
-- which we can not manipulate as easily.
--
-- There's a GDB patch to address this at [1]. At the moment of writing
-- it's not merged, so I recommend building GDB with the patch if you
-- care about unwinding. The hack above doesn't cover every case.
--
-- [1] https://sourceware.org/ml/gdb-patches/2018-02/msg00055.html

-- | Get DWARF register ID for a given GlobalReg
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

-- | Generate code for setting the unwind information for a register,
-- optimized using its known old value in the table. Note that "Sp" is
-- special: We see it as synonym for the CFA.
pprSetUnwind :: Platform
             -> GlobalReg
                -- ^ the register to produce an unwinding table entry for
             -> (Maybe UnwindExpr, Maybe UnwindExpr)
                -- ^ the old and new values of the register
             -> SDoc
pprSetUnwind :: Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Maybe UnwindExpr
Nothing)
  = Platform -> GlobalReg -> SDoc
pprUndefUnwind Platform
plat GlobalReg
g
pprSetUnwind Platform
_    GlobalReg
Sp (Just (UwReg GlobalReg
s Int
_), Just (UwReg GlobalReg
s' Int
o')) | GlobalReg
s GlobalReg -> GlobalReg -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq GlobalReg
== GlobalReg
s'
  = if Int
o' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0
    then Word8 -> SDoc
pprByte Word8
dW_CFA_def_cfa_offset SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
o')
    else Word8 -> SDoc
pprByte Word8
dW_CFA_def_cfa_offset_sf SDoc -> SDoc -> SDoc
$$ Int -> SDoc
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just (UwReg GlobalReg
s' Int
o'))
  = if Int
o' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0
    then Word8 -> SDoc
pprByte Word8
dW_CFA_def_cfa SDoc -> SDoc -> SDoc
$$
         Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat GlobalReg
s' SDoc -> SDoc -> SDoc
$$
         Word -> SDoc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral Int
o')
    else Word8 -> SDoc
pprByte Word8
dW_CFA_def_cfa_sf SDoc -> SDoc -> SDoc
$$
         Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat GlobalReg
s' SDoc -> SDoc -> SDoc
$$
         Int -> SDoc
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just UnwindExpr
uw)
  = Word8 -> SDoc
pprByte Word8
dW_CFA_def_cfa_expression SDoc -> SDoc -> SDoc
$$ Platform -> Bool -> UnwindExpr -> SDoc
pprUnwindExpr Platform
plat Bool
False UnwindExpr
uw
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just (UwDeref (UwReg GlobalReg
Sp Int
o)))
  | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
0 Bool -> Bool -> Bool
&& ((-Int
o) Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`mod` Platform -> Int
platformWordSizeInBytes Platform
plat) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0 -- expected case
  = Word8 -> SDoc
pprByte (Word8
dW_CFA_offset Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word8
+ Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat GlobalReg
g) SDoc -> SDoc -> SDoc
$$
    Word -> SDoc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Int
fromIntegral ((-Int
o) Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`div` Platform -> Int
platformWordSizeInBytes Platform
plat))
  | Bool
otherwise
  = Word8 -> SDoc
pprByte Word8
dW_CFA_offset_extended_sf SDoc -> SDoc -> SDoc
$$
    Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat GlobalReg
g SDoc -> SDoc -> SDoc
$$
    Int -> SDoc
pprLEBInt Int
o
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just (UwDeref UnwindExpr
uw))
  = Word8 -> SDoc
pprByte Word8
dW_CFA_expression SDoc -> SDoc -> SDoc
$$
    Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat GlobalReg
g SDoc -> SDoc -> SDoc
$$
    Platform -> Bool -> UnwindExpr -> SDoc
pprUnwindExpr Platform
plat Bool
True UnwindExpr
uw
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just (UwReg GlobalReg
g' Int
0))
  | GlobalReg
g GlobalReg -> GlobalReg -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq GlobalReg
== GlobalReg
g'
  = Word8 -> SDoc
pprByte Word8
dW_CFA_same_value SDoc -> SDoc -> SDoc
$$
    Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat GlobalReg
g
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just UnwindExpr
uw)
  = Word8 -> SDoc
pprByte Word8
dW_CFA_val_expression SDoc -> SDoc -> SDoc
$$
    Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat GlobalReg
g SDoc -> SDoc -> SDoc
$$
    Platform -> Bool -> UnwindExpr -> SDoc
pprUnwindExpr Platform
plat Bool
True UnwindExpr
uw

-- | Print the register number of the given 'GlobalReg' as an unsigned LEB128
-- encoded number.
pprLEBRegNo :: Platform -> GlobalReg -> SDoc
pprLEBRegNo :: Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat = Word -> SDoc
pprLEBWord (Word -> SDoc) -> (GlobalReg -> Word) -> GlobalReg -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Word8
fromIntegral (Word8 -> Word) -> (GlobalReg -> Word8) -> GlobalReg -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat

-- | Generates a DWARF expression for the given unwind expression. If
-- @spIsCFA@ is true, we see @Sp@ as the frame base CFA where it gets
-- mentioned.
pprUnwindExpr :: Platform -> Bool -> UnwindExpr -> SDoc
pprUnwindExpr :: Platform -> Bool -> UnwindExpr -> SDoc
pprUnwindExpr Platform
platform Bool
spIsCFA UnwindExpr
expr
  = let pprE :: UnwindExpr -> SDoc
pprE (UwConst Int
i)
          | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
32 = Word8 -> SDoc
pprByte (Word8
dW_OP_lit0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word8
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
fromIntegral Int
i)
          | Bool
otherwise        = Word8 -> SDoc
pprByte Word8
dW_OP_consts SDoc -> SDoc -> SDoc
$$ Int -> SDoc
pprLEBInt Int
i -- lazy...
        pprE (UwReg GlobalReg
Sp Int
i) | Bool
spIsCFA
                             = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Int
== Int
0
                               then Word8 -> SDoc
pprByte Word8
dW_OP_call_frame_cfa
                               else UnwindExpr -> SDoc
pprE (UnwindExpr -> UnwindExpr -> UnwindExpr
UwPlus (GlobalReg -> Int -> UnwindExpr
UwReg GlobalReg
Sp Int
0) (Int -> UnwindExpr
UwConst Int
i))
        pprE (UwReg GlobalReg
g Int
i)      = Word8 -> SDoc
pprByte (Word8
dW_OP_breg0Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
External instance of the constraint type Num Word8
+Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
platform GlobalReg
g) SDoc -> SDoc -> SDoc
$$
                               Int -> SDoc
pprLEBInt Int
i
        pprE (UwDeref UnwindExpr
u)      = UnwindExpr -> SDoc
pprE UnwindExpr
u SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
dW_OP_deref
        pprE (UwLabel CLabel
l)      = Word8 -> SDoc
pprByte Word8
dW_OP_addr SDoc -> SDoc -> SDoc
$$ Platform -> SDoc -> SDoc
pprWord Platform
platform (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable CLabel
ppr CLabel
l)
        pprE (UwPlus UnwindExpr
u1 UnwindExpr
u2)   = UnwindExpr -> SDoc
pprE UnwindExpr
u1 SDoc -> SDoc -> SDoc
$$ UnwindExpr -> SDoc
pprE UnwindExpr
u2 SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
dW_OP_plus
        pprE (UwMinus UnwindExpr
u1 UnwindExpr
u2)  = UnwindExpr -> SDoc
pprE UnwindExpr
u1 SDoc -> SDoc -> SDoc
$$ UnwindExpr -> SDoc
pprE UnwindExpr
u2 SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
dW_OP_minus
        pprE (UwTimes UnwindExpr
u1 UnwindExpr
u2)  = UnwindExpr -> SDoc
pprE UnwindExpr
u1 SDoc -> SDoc -> SDoc
$$ UnwindExpr -> SDoc
pprE UnwindExpr
u2 SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
dW_OP_mul
    in String -> SDoc
text String
"\t.uleb128 2f-1f" SDoc -> SDoc -> SDoc
$$ -- DW_FORM_block length
       -- computed as the difference of the following local labels 2: and 1:
       String -> SDoc
text String
"1:" SDoc -> SDoc -> SDoc
$$
       UnwindExpr -> SDoc
pprE UnwindExpr
expr SDoc -> SDoc -> SDoc
$$
       String -> SDoc
text String
"2:"

-- | Generate code for re-setting the unwind information for a
-- register to @undefined@
pprUndefUnwind :: Platform -> GlobalReg -> SDoc
pprUndefUnwind :: Platform -> GlobalReg -> SDoc
pprUndefUnwind Platform
plat GlobalReg
g  = Word8 -> SDoc
pprByte Word8
dW_CFA_undefined SDoc -> SDoc -> SDoc
$$
                         Platform -> GlobalReg -> SDoc
pprLEBRegNo Platform
plat GlobalReg
g


-- | Align assembly at (machine) word boundary
wordAlign :: Platform -> SDoc
wordAlign :: Platform -> SDoc
wordAlign Platform
plat =
  String -> SDoc
text String
"\t.align " SDoc -> SDoc -> SDoc
<> case Platform -> OS
platformOS Platform
plat of
    OS
OSDarwin -> case Platform -> PlatformWordSize
platformWordSize Platform
plat of
      PlatformWordSize
PW8 -> Char -> SDoc
char Char
'3'
      PlatformWordSize
PW4 -> Char -> SDoc
char Char
'2'
    OS
_other   -> Int -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Int
ppr (Platform -> Int
platformWordSizeInBytes Platform
plat)

-- | Assembly for a single byte of constant DWARF data
pprByte :: Word8 -> SDoc
pprByte :: Word8 -> SDoc
pprByte Word8
x = String -> SDoc
text String
"\t.byte " SDoc -> SDoc -> SDoc
<> Word -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Word
ppr (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Word8
fromIntegral Word8
x :: Word)

-- | Assembly for a two-byte constant integer
pprHalf :: Word16 -> SDoc
pprHalf :: Word16 -> SDoc
pprHalf Word16
x = String -> SDoc
text String
"\t.short" SDoc -> SDoc -> SDoc
<+> Word -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Word
ppr (Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word
External instance of the constraint type Integral Word16
fromIntegral Word16
x :: Word)

-- | Assembly for a constant DWARF flag
pprFlag :: Bool -> SDoc
pprFlag :: Bool -> SDoc
pprFlag Bool
f = Word8 -> SDoc
pprByte (if Bool
f then Word8
0xff else Word8
0x00)

-- | Assembly for 4 bytes of dynamic DWARF data
pprData4' :: SDoc -> SDoc
pprData4' :: SDoc -> SDoc
pprData4' SDoc
x = String -> SDoc
text String
"\t.long " SDoc -> SDoc -> SDoc
<> SDoc
x

-- | Assembly for 4 bytes of constant DWARF data
pprData4 :: Word -> SDoc
pprData4 :: Word -> SDoc
pprData4 = SDoc -> SDoc
pprData4' (SDoc -> SDoc) -> (Word -> SDoc) -> Word -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Word
ppr

-- | Assembly for a DWARF word of dynamic data. This means 32 bit, as
-- we are generating 32 bit DWARF.
pprDwWord :: SDoc -> SDoc
pprDwWord :: SDoc -> SDoc
pprDwWord = SDoc -> SDoc
pprData4'

-- | Assembly for a machine word of dynamic data. Depends on the
-- architecture we are currently generating code for.
pprWord :: Platform -> SDoc -> SDoc
pprWord :: Platform -> SDoc -> SDoc
pprWord Platform
plat SDoc
s =
  case Platform -> PlatformWordSize
platformWordSize Platform
plat of
    PlatformWordSize
PW4 -> String -> SDoc
text String
"\t.long " SDoc -> SDoc -> SDoc
<> SDoc
s
    PlatformWordSize
PW8 -> String -> SDoc
text String
"\t.quad " SDoc -> SDoc -> SDoc
<> SDoc
s

-- | Prints a number in "little endian base 128" format. The idea is
-- to optimize for small numbers by stopping once all further bytes
-- would be 0. The highest bit in every byte signals whether there
-- are further bytes to read.
pprLEBWord :: Word -> SDoc
pprLEBWord :: Word -> SDoc
pprLEBWord Word
x | Word
x Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word
< Word
128   = Word8 -> SDoc
pprByte (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Word
fromIntegral Word
x)
             | Bool
otherwise = Word8 -> SDoc
pprByte (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Word
fromIntegral (Word -> Word8) -> Word -> Word8
forall a b. (a -> b) -> a -> b
$ Word
128 Word -> Word -> Word
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Word
.|. (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Word
.&. Word
127)) SDoc -> SDoc -> SDoc
$$
                           Word -> SDoc
pprLEBWord (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Word
`shiftR` Int
7)

-- | Same as @pprLEBWord@, but for a signed number
pprLEBInt :: Int -> SDoc
pprLEBInt :: Int -> SDoc
pprLEBInt Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= -Int
64 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
< Int
64
                        = Word8 -> SDoc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Int
.&. Int
127))
            | Bool
otherwise = Word8 -> SDoc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
128 Int -> Int -> Int
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Int
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits Int
.&. Int
127)) SDoc -> SDoc -> SDoc
$$
                          Int -> SDoc
pprLEBInt (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
External instance of the constraint type Bits Int
`shiftR` Int
7)

-- | Generates a dynamic null-terminated string. If required the
-- caller needs to make sure that the string is escaped properly.
pprString' :: SDoc -> SDoc
pprString' :: SDoc -> SDoc
pprString' SDoc
str = String -> SDoc
text String
"\t.asciz \"" SDoc -> SDoc -> SDoc
<> SDoc
str SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'"'

-- | Generate a string constant. We take care to escape the string.
pprString :: String -> SDoc
pprString :: String -> SDoc
pprString String
str
  = SDoc -> SDoc
pprString' (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (Char -> SDoc) -> String -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Char -> SDoc
escapeChar (String -> [SDoc]) -> String -> [SDoc]
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
External instance of the constraint type Num Int
External instance of the constraint type Integral Word8
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
$ FastString -> ByteString
bytesFS (FastString -> ByteString) -> FastString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString String
str

-- | Escape a single non-unicode character
escapeChar :: Char -> SDoc
escapeChar :: Char -> SDoc
escapeChar Char
'\\' = String -> SDoc
text String
"\\\\"
escapeChar Char
'\"' = String -> SDoc
text String
"\\\""
escapeChar Char
'\n' = String -> SDoc
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
External instance of the constraint type Eq Char
/= Char
'?' -- prevents trigraph warnings
  = Char -> SDoc
char Char
c
  | Bool
otherwise
  = Char -> SDoc
char Char
'\\' SDoc -> SDoc -> SDoc
<> Char -> SDoc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`div` Int
64)) SDoc -> SDoc -> SDoc
<>
                 Char -> SDoc
char (Int -> Char
intToDigit ((Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`div` Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`mod` Int
8)) SDoc -> SDoc -> SDoc
<>
                 Char -> SDoc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`mod` Int
8))
  where ch :: Int
ch = Char -> Int
ord Char
c

-- | Generate an offset into another section. This is tricky because
-- this is handled differently depending on platform: Mac Os expects
-- us to calculate the offset using assembler arithmetic. Linux expects
-- us to just reference the target directly, and will figure out on
-- their own that we actually need an offset. Finally, Windows has
-- a special directive to refer to relative offsets. Fun.
sectionOffset :: Platform -> SDoc -> SDoc -> SDoc
sectionOffset :: Platform -> SDoc -> SDoc -> SDoc
sectionOffset Platform
plat SDoc
target SDoc
section =
  case Platform -> OS
platformOS Platform
plat of
    OS
OSDarwin  -> SDoc -> SDoc
pprDwWord (SDoc
target SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> SDoc
section)
    OS
OSMinGW32 -> String -> SDoc
text String
"\t.secrel32 " SDoc -> SDoc -> SDoc
<> SDoc
target
    OS
_other    -> SDoc -> SDoc
pprDwWord SDoc
target