{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

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 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

-- | 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 }
  | 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
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]
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
Enum)

-- | Generate assembly for the given abbreviation code
pprAbbrev :: IsDoc doc => DwarfAbbrev -> doc
pprAbbrev :: forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev = forall doc. IsDoc doc => Word -> doc
pprLEBWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

-- | Abbreviation declaration. This explains the binary encoding we
-- use for representing 'DwarfInfo'. Be aware that this must be updated
-- along with 'pprDwarfInfo'.
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) = forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
tag forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
form
        in forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
abbr forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
tag forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
chld forall doc. IsDoc doc => doc -> doc -> doc
$$
           forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall {doc}. IsDoc doc => (Word, Word) -> doc
fld [(Word, Word)]
flds) forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0 forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
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_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 forall doc. IsDoc doc => Platform -> doc
dwarfAbbrevSection Platform
platform forall doc. IsDoc doc => doc -> doc -> doc
$$
     forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => doc
dwarfAbbrevLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon) forall doc. IsDoc doc => doc -> doc -> 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)  -- not represented in body
       , (Word
dW_AT_low_pc,   Word
dW_FORM_addr)
       , (Word
dW_AT_high_pc,  Word
dW_FORM_addr)
       ] forall a. [a] -> [a] -> [a]
++
       (if Bool
haveDebugLine
        then [ (Word
dW_AT_stmt_list, Word
dW_FORM_data4) ]
        else [])) forall doc. IsDoc doc => doc -> doc -> 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 forall doc. IsDoc doc => doc -> doc -> 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 forall a. [a] -> [a] -> [a]
++ [(Word
dW_AT_ghc_tick_parent, Word
dW_FORM_ref_addr)]) forall doc. IsDoc doc => doc -> doc -> 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)
       ] forall doc. IsDoc doc => doc -> doc -> 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)
       ] forall doc. IsDoc doc => doc -> doc -> 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)
       ] forall doc. IsDoc doc => doc -> doc -> doc
$$
     forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> SDoc #-}
{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Generate assembly for DWARF data
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 {}  -> doc
hasChildren
      DwarfSubprogram {}   -> doc
hasChildren
      DwarfBlock {}        -> doc
hasChildren
      DwarfSrcNote {}      -> doc
noChildren
  where
    hasChildren :: doc
hasChildren =
        forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfoOpen Platform
platform Bool
haveSrc DwarfInfo
d forall doc. IsDoc doc => doc -> doc -> doc
$$
        forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfo Platform
platform Bool
haveSrc) (DwarfInfo -> [DwarfInfo]
dwChildren DwarfInfo
d)) forall doc. IsDoc doc => doc -> doc -> doc
$$
        forall doc. IsDoc doc => doc
pprDwarfInfoClose
    noChildren :: doc
noChildren = 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 #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Print a CLabel name in a ".stringz \"LABEL\""
pprLabelString :: IsDoc doc => Platform -> CLabel -> doc
pprLabelString :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label =
   forall doc. IsDoc doc => Line doc -> doc
pprString'                  -- we don't need to escape the string as labels don't contain exotic characters
    forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
label -- pretty-print as C label (foreign labels may be printed differently in Asm)

-- | 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 :: 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) =
  forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrCompileUnit
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => String -> doc
pprString String
name
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => String -> doc
pprString String
producer
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprData4 Word
dW_LANG_Haskell
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => String -> doc
pprString String
compDir
     -- Offset due to Note [Info Offset]
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lowLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"-1")
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
highLabel)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ if Bool
haveSrc
     then forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform forall doc. IsLine doc => doc
dwarfLineLabel forall doc. IsLine doc => doc
dwarfLineLabel
     else forall doc. IsOutput doc => doc
empty
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfSubprogram [DwarfInfo]
_ String
name CLabel
label Maybe CLabel
parent) =
  forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
abbrev
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => String -> doc
pprString String
name
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Bool -> doc
pprFlag (CLabel -> Bool
externallyVisibleCLabel CLabel
label)
     -- Offset due to Note [Info Offset]
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
label forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"-1")
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
label)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
1
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_call_frame_cfa
  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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall doc. IsOutput doc => doc
empty CLabel -> doc
pprParentDie Maybe CLabel
parent
    pprParentDie :: CLabel -> doc
pprParentDie CLabel
sym = forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
sym) forall doc. IsLine doc => doc
dwarfInfoLabel
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label Maybe CLabel
Nothing) =
  forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label (Just CLabel
marker)) =
  forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrBlock
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
marker)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempEndLabel CLabel
marker)
pprDwarfInfoOpen Platform
_ Bool
_ (DwarfSrcNote RealSrcSpan
ss) =
  forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrGhcSrcNote
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Line doc -> doc
pprString' (forall doc. IsLine doc => FastString -> doc
ftext forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
ss)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprData4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word16 -> doc
pprHalf (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprData4 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss)
  forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word16 -> doc
pprHalf (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
ss)

-- | Close a DWARF info record with children
pprDwarfInfoClose :: IsDoc doc => doc
pprDwarfInfoClose :: forall doc. IsDoc doc => doc
pprDwarfInfoClose = forall doc. IsDoc doc => DwarfAbbrev -> doc
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 :: 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
      -- 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 -> doc
pad Int
n = forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
n forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
      -- Fix for #17428
      initialLength :: Int
initialLength = Int
8 forall a. Num a => a -> a -> a
+ Int
paddingSize forall a. Num a => a -> a -> a
+ (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [DwarfARange]
arngs) forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
* Int
wordSize
  in forall doc. IsDoc doc => Line doc -> doc
pprDwWord (forall doc. IsLine doc => Int -> doc
int Int
initialLength)
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word16 -> doc
pprHalf Word16
2
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform forall a b. (a -> b) -> a -> b
$ forall a. Uniquable a => a -> CLabel
mkAsmTempLabel forall a b. (a -> b) -> a -> b
$ Unique
unitU) forall doc. IsLine doc => doc
dwarfInfoLabel
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wordSize)
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall {doc}. IsDoc doc => Int -> doc
pad Int
paddingSize
     -- body
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall doc. IsDoc doc => Platform -> DwarfARange -> doc
pprDwarfARange Platform
platform) [DwarfARange]
arngs)
     -- terminus
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Char -> doc
char Char
'0')
     forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Char -> doc
char Char
'0')
{-# SPECIALIZE pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> SDoc #-}
{-# SPECIALIZE pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

pprDwarfARange :: IsDoc doc => Platform -> DwarfARange -> doc
pprDwarfARange :: forall doc. IsDoc doc => Platform -> DwarfARange -> doc
pprDwarfARange Platform
platform DwarfARange
arng =
    -- Offset due to Note [Info Offset].
    forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (DwarfARange -> CLabel
dwArngStartLabel DwarfARange
arng) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"-1")
    forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform Line doc
length
  where
    length :: Line doc
length = forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (DwarfARange -> CLabel
dwArngEndLabel DwarfARange
arng)
             forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (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 OutputableP Platform DwarfFrameBlock where
  pdoc :: Platform -> DwarfFrameBlock -> SDoc
pdoc Platform
env (DwarfFrameBlock Bool
hasInfo [UnwindPoint]
unwinds) = forall doc. IsLine doc => doc -> doc
braces forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr Bool
hasInfo forall doc. IsLine doc => doc -> doc -> doc
<+> forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
env [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 :: 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      = forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieEndLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> 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) = forall doc.
IsDoc doc =>
Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
pprSetUnwind Platform
platform GlobalReg
g (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 :: doc
preserveSp = case Platform -> Arch
platformArch Platform
platform of
          Arch
ArchX86    -> forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
4
          Arch
ArchX86_64 -> forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
7
          Arch
_          -> forall doc. IsOutput doc => doc
empty
    in forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
            , forall doc. IsDoc doc => Line doc -> doc
pprData4' Line doc
length -- Length of CIE
            , forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieStartLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
            , forall doc. IsDoc doc => Line doc -> doc
pprData4' (forall doc. IsLine doc => String -> doc
text String
"-1")
                               -- Common Information Entry marker (-1 = 0xf..f)
            , forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
3        -- CIE version (we require DWARF 3)
            , forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0        -- Augmentation (none)
            , forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
1        -- Code offset multiplicator
            , forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
128forall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wordSize)
                               -- Data offset multiplicator
                               -- (stacks grow down => "-w" in signed LEB128)
            , forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
retReg   -- virtual register holding return address
            ] forall doc. IsDoc doc => doc -> doc -> doc
$$
       -- Initial unwind table
       forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (GlobalReg, Maybe UnwindExpr) -> doc
pprInit forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList UnwindTable
cieInit) forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsDoc doc => [doc] -> doc
vcat [ -- RET = *CFA
              forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_CFA_offsetforall a. Num a => a -> a -> a
+Word8
retReg)
            , forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0

              -- Preserve C stack pointer
            , doc
preserveSp

              -- Sp' = CFA
              -- (we need to set this manually as our (STG) Sp register is
              -- often not the architecture's default stack register)
            , forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_val_offset
            , forall doc. IsDoc doc => Word -> doc
pprLEBWord (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
spReg)
            , forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
0
            ] forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
platform forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieEndLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon) forall doc. IsDoc doc => doc -> doc -> doc
$$
       -- Procedure unwind tables
       forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (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 #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | 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 :: 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 forall doc. IsLine doc => String -> doc
text String
str else forall doc. IsOutput doc => doc
empty
                      -- see Note [Info Offset]
    in forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsOutput doc => doc -> doc
whenPprDebug forall a b. (a -> b) -> a -> b
$ forall doc. IsDoc doc => Line doc -> doc
line forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"# Unwinding for" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
            , forall doc. IsDoc doc => Line doc -> doc
pprData4' (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeEndLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeLabel)
            , forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon)
            , forall doc. IsDoc doc => Line doc -> doc
pprData4' (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
frameLbl forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dwarfFrameLabel)    -- Reference to CIE
            , forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
ifInfo String
"-1") -- Code pointer
            , forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procEnd forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<>
                                 forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
ifInfo String
"+1") -- Block byte length
            ] forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsDoc doc => [doc] -> doc
vcat (forall s a. State s a -> s -> a
S.evalState (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall doc.
IsDoc doc =>
Platform -> DwarfFrameBlock -> State UnwindTable doc
pprFrameBlock Platform
platform) [DwarfFrameBlock]
blocks) UnwindTable
initUw) forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
platform forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeEndLabel forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
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 :: 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) =
    forall doc. IsDoc doc => [doc] -> doc
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Bool -> UnwindPoint -> State UnwindTable doc
pprFrameDecl (Bool
True forall a. a -> [a] -> [a]
: 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) = forall s a. (s -> (a, s)) -> State s a
S.state 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
              | forall a. a -> Maybe a
Just Maybe UnwindExpr
new forall a. Eq a => a -> a -> Bool
== Maybe (Maybe UnwindExpr)
old = 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  = forall a. Maybe a
Nothing
                -- the value changed
              | Bool
otherwise       = forall a. a -> Maybe a
Just (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe UnwindExpr)
old, Maybe UnwindExpr
new)
              where
                old :: Maybe (Maybe UnwindExpr)
old = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GlobalReg
g UnwindTable
oldUws

            changed :: [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
changed = forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== UnwindTable
uws
             then (forall doc. IsOutput doc => doc
empty, UnwindTable
oldUws)
             else let -- see Note [Info Offset]
                      needsOffset :: Bool
needsOffset = Bool
firstDecl Bool -> Bool -> Bool
&& Bool
hasInfo
                      lblDoc :: Line doc
lblDoc = forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl forall doc. IsLine doc => doc -> doc -> doc
<>
                               if Bool
needsOffset then forall doc. IsLine doc => String -> doc
text String
"-1" else forall doc. IsOutput doc => doc
empty
                      doc :: doc
doc = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_set_loc forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform Line doc
lblDoc forall doc. IsDoc doc => doc -> doc -> doc
$$
                            forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ 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)

-- 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.
--
-- We apply this offset in several places:
--
--  * unwind information in .debug_frames
--  * the subprogram and lexical_block DIEs in .debug_info
--  * the ranges in .debug_aranges
--
-- In the latter two cases we apply the offset unconditionally.
--
-- 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word8
0 (Platform -> Reg -> Word8
dwarfRegNo Platform
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealReg -> Reg
RegReal) 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 :: IsDoc doc => Platform
             -> GlobalReg
                -- ^ the register to produce an unwinding table entry for
             -> (Maybe UnwindExpr, Maybe UnwindExpr)
                -- ^ the old and new values of the register
             -> doc
pprSetUnwind :: forall doc.
IsDoc doc =>
Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Maybe UnwindExpr
Nothing)
  = forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprUndefUnwind Platform
plat GlobalReg
g
pprSetUnwind Platform
_    GlobalReg
Sp (Just (UwReg GlobalReg
s Int
_), Just (UwReg GlobalReg
s' Int
o')) | GlobalReg
s forall a. Eq a => a -> a -> Bool
== GlobalReg
s'
  = if Int
o' forall a. Ord a => a -> a -> Bool
>= Int
0
    then forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_offset forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word -> doc
pprLEBWord (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o')
    else forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_offset_sf forall doc. IsDoc doc => doc -> doc -> doc
$$ forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just (UwReg GlobalReg
s' Int
o'))
  = if Int
o' forall a. Ord a => a -> a -> Bool
>= Int
0
    then forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa forall doc. IsDoc doc => doc -> doc -> doc
$$
         forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
s' forall doc. IsDoc doc => doc -> doc -> doc
$$
         forall doc. IsDoc doc => Word -> doc
pprLEBWord (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o')
    else forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_sf forall doc. IsDoc doc => doc -> doc -> doc
$$
         forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
s' forall doc. IsDoc doc => doc -> doc -> doc
$$
         forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just UnwindExpr
uw)
  = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_expression forall doc. IsDoc doc => doc -> doc -> 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 GlobalReg
Sp Int
o)))
  | Int
o forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& ((-Int
o) forall a. Integral a => a -> a -> a
`mod` Platform -> Int
platformWordSizeInBytes Platform
plat) forall a. Eq a => a -> a -> Bool
== Int
0 -- expected case
  = forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_CFA_offset forall a. Num a => a -> a -> a
+ Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat GlobalReg
g) forall doc. IsDoc doc => doc -> doc -> doc
$$
    forall doc. IsDoc doc => Word -> doc
pprLEBWord (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((-Int
o) forall a. Integral a => a -> a -> a
`div` Platform -> Int
platformWordSizeInBytes Platform
plat))
  | Bool
otherwise
  = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_offset_extended_sf forall doc. IsDoc doc => doc -> doc -> doc
$$
    forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g forall doc. IsDoc doc => doc -> doc -> doc
$$
    forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
o
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just (UwDeref UnwindExpr
uw))
  = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_expression forall doc. IsDoc doc => doc -> doc -> doc
$$
    forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g forall doc. IsDoc doc => doc -> doc -> 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 GlobalReg
g' Int
0))
  | GlobalReg
g forall a. Eq a => a -> a -> Bool
== GlobalReg
g'
  = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value forall doc. IsDoc doc => doc -> doc -> doc
$$
    forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just UnwindExpr
uw)
  = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_val_expression forall doc. IsDoc doc => doc -> doc -> doc
$$
    forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g forall doc. IsDoc doc => doc -> doc -> doc
$$
    forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
plat Bool
True UnwindExpr
uw

-- | Print the register number of the given 'GlobalReg' as an unsigned LEB128
-- encoded number.
pprLEBRegNo :: IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo :: forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat = forall doc. IsDoc doc => Word -> doc
pprLEBWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 :: 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 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< Int
32 = forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_OP_lit0 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
          | Bool
otherwise        = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_consts forall doc. IsDoc doc => doc -> doc -> doc
$$ forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
i -- lazy...
        pprE (UwReg GlobalReg
Sp Int
i) | Bool
spIsCFA
                             = if Int
i forall a. Eq a => a -> a -> Bool
== Int
0
                               then forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_call_frame_cfa
                               else UnwindExpr -> doc
pprE (UnwindExpr -> UnwindExpr -> UnwindExpr
UwPlus (GlobalReg -> Int -> UnwindExpr
UwReg GlobalReg
Sp Int
0) (Int -> UnwindExpr
UwConst Int
i))
        pprE (UwReg GlobalReg
g Int
i)      = forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_OP_breg0forall a. Num a => a -> a -> a
+Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
platform GlobalReg
g) forall doc. IsDoc doc => doc -> doc -> doc
$$
                               forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
i
        pprE (UwDeref UnwindExpr
u)      = UnwindExpr -> doc
pprE UnwindExpr
u forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_deref
        pprE (UwLabel CLabel
l)      = forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_addr forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
l)
        pprE (UwPlus UnwindExpr
u1 UnwindExpr
u2)   = UnwindExpr -> doc
pprE UnwindExpr
u1 forall doc. IsDoc doc => doc -> doc -> doc
$$ UnwindExpr -> doc
pprE UnwindExpr
u2 forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_plus
        pprE (UwMinus UnwindExpr
u1 UnwindExpr
u2)  = UnwindExpr -> doc
pprE UnwindExpr
u1 forall doc. IsDoc doc => doc -> doc -> doc
$$ UnwindExpr -> doc
pprE UnwindExpr
u2 forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_minus
        pprE (UwTimes UnwindExpr
u1 UnwindExpr
u2)  = UnwindExpr -> doc
pprE UnwindExpr
u1 forall doc. IsDoc doc => doc -> doc -> doc
$$ UnwindExpr -> doc
pprE UnwindExpr
u2 forall doc. IsDoc doc => doc -> doc -> doc
$$ forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_mul
    in forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => String -> doc
text String
"\t.uleb128 2f-1f") forall doc. IsDoc doc => doc -> doc -> doc
$$ -- DW_FORM_block length
       -- computed as the difference of the following local labels 2: and 1:
       forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => String -> doc
text String
"1:") forall doc. IsDoc doc => doc -> doc -> doc
$$
       UnwindExpr -> doc
pprE UnwindExpr
expr forall doc. IsDoc doc => doc -> doc -> doc
$$
       forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => String -> doc
text String
"2:")

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


-- | Align assembly at (machine) word boundary
wordAlign :: IsDoc doc => Platform -> doc
wordAlign :: forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
plat =
  forall doc. IsDoc doc => Line doc -> doc
line forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"\t.align " 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 -> forall doc. IsLine doc => Char -> doc
char Char
'3'
      PlatformWordSize
PW4 -> forall doc. IsLine doc => Char -> doc
char Char
'2'
    OS
_other   -> forall doc. IsLine doc => Int -> doc
int (Platform -> Int
platformWordSizeInBytes Platform
plat)
{-# SPECIALIZE wordAlign :: Platform -> SDoc #-}
{-# SPECIALIZE wordAlign :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Assembly for a single byte of constant DWARF data
pprByte :: IsDoc doc => Word8 -> doc
pprByte :: forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
x = forall doc. IsDoc doc => Line doc -> doc
line forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"\t.byte " forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Integer -> doc
integer (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
{-# SPECIALIZE pprByte :: Word8 -> SDoc #-}
{-# SPECIALIZE pprByte :: Word8 -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Assembly for a two-byte constant integer
pprHalf :: IsDoc doc => Word16 -> doc
pprHalf :: forall doc. IsDoc doc => Word16 -> doc
pprHalf Word16
x = forall doc. IsDoc doc => Line doc -> doc
line forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => String -> doc
text String
"\t.short" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => Integer -> doc
integer (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
{-# SPECIALIZE pprHalf :: Word16 -> SDoc #-}
{-# SPECIALIZE pprHalf :: Word16 -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

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

-- | Assembly for 4 bytes of dynamic DWARF data
pprData4' :: IsDoc doc => Line doc -> doc
pprData4' :: forall doc. IsDoc doc => Line doc -> doc
pprData4' Line doc
x = forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => String -> doc
text String
"\t.long " forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
x)
{-# SPECIALIZE pprData4' :: SDoc -> SDoc #-}
{-# SPECIALIZE pprData4' :: HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Assembly for 4 bytes of constant DWARF data
pprData4 :: IsDoc doc => Word -> doc
pprData4 :: forall doc. IsDoc doc => Word -> doc
pprData4 = forall doc. IsDoc doc => Line doc -> doc
pprData4' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall doc. IsLine doc => Integer -> doc
integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Assembly for a DWARF word of dynamic data. This means 32 bit, as
-- we are generating 32 bit DWARF.
pprDwWord :: IsDoc doc => Line doc -> doc
pprDwWord :: forall doc. IsDoc doc => Line doc -> doc
pprDwWord = forall doc. IsDoc doc => Line doc -> doc
pprData4'
{-# SPECIALIZE pprDwWord :: SDoc -> SDoc #-}
{-# SPECIALIZE pprDwWord :: HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Assembly for a machine word of dynamic data. Depends on the
-- architecture we are currently generating code for.
pprWord :: IsDoc doc => Platform -> Line doc -> doc
pprWord :: forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
plat Line doc
s =
  forall doc. IsDoc doc => Line doc -> doc
line forall a b. (a -> b) -> a -> b
$ case Platform -> PlatformWordSize
platformWordSize Platform
plat of
    PlatformWordSize
PW4 -> forall doc. IsLine doc => String -> doc
text String
"\t.long " forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
s
    PlatformWordSize
PW8 -> forall doc. IsLine doc => String -> doc
text String
"\t.quad " forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
s
{-# SPECIALIZE pprWord :: Platform -> SDoc -> SDoc #-}
{-# SPECIALIZE pprWord :: Platform -> HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | 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 :: IsDoc doc => Word -> doc
pprLEBWord :: forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
x | Word
x forall a. Ord a => a -> a -> Bool
< Word
128   = forall doc. IsDoc doc => Word8 -> doc
pprByte (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x)
             | Bool
otherwise = forall doc. IsDoc doc => Word8 -> doc
pprByte (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word
128 forall a. Bits a => a -> a -> a
.|. (Word
x forall a. Bits a => a -> a -> a
.&. Word
127)) forall doc. IsDoc doc => doc -> doc -> doc
$$
                           forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word
x forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
{-# SPECIALIZE pprLEBWord :: Word -> SDoc #-}
{-# SPECIALIZE pprLEBWord :: Word -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Same as @pprLEBWord@, but for a signed number
pprLEBInt :: IsDoc doc => Int -> doc
pprLEBInt :: forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
x | Int
x forall a. Ord a => a -> a -> Bool
>= -Int
64 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
< Int
64
                        = forall doc. IsDoc doc => Word8 -> doc
pprByte (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Bits a => a -> a -> a
.&. Int
127))
            | Bool
otherwise = forall doc. IsDoc doc => Word8 -> doc
pprByte (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
128 forall a. Bits a => a -> a -> a
.|. (Int
x forall a. Bits a => a -> a -> a
.&. Int
127)) forall doc. IsDoc doc => doc -> doc -> doc
$$
                          forall {doc}. IsDoc doc => Int -> doc
pprLEBInt (Int
x forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
{-# SPECIALIZE pprLEBInt :: Int -> SDoc #-}
{-# SPECIALIZE pprLEBInt :: Int -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

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

-- | Generate a string constant. We take care to escape the string.
pprString :: IsDoc doc => String -> doc
pprString :: forall doc. IsDoc doc => String -> doc
pprString String
str
  = forall doc. IsDoc doc => Line doc -> doc
pprString' forall a b. (a -> b) -> a -> b
$ forall doc. IsLine doc => [doc] -> doc
hcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall doc. IsLine doc => Char -> doc
escapeChar forall a b. (a -> b) -> a -> b
$
    if String
str forall a. [a] -> Int -> Bool
`lengthIs` String -> Int
utf8EncodedLength String
str
    then String
str
    else forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack forall a b. (a -> b) -> a -> b
$ String -> ByteString
utf8EncodeByteString String
str

-- | Escape a single non-unicode character
escapeChar :: IsLine doc => Char -> doc
escapeChar :: forall doc. IsLine doc => Char -> doc
escapeChar Char
'\\' = forall doc. IsLine doc => String -> doc
text String
"\\\\"
escapeChar Char
'\"' = forall doc. IsLine doc => String -> doc
text String
"\\\""
escapeChar Char
'\n' = 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 forall a. Eq a => a -> a -> Bool
/= Char
'?' -- prevents trigraph warnings
  = forall doc. IsLine doc => Char -> doc
char Char
c
  | Bool
otherwise
  = forall doc. IsLine doc => Char -> doc
char Char
'\\' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit (Int
ch forall a. Integral a => a -> a -> a
`div` Int
64)) forall doc. IsLine doc => doc -> doc -> doc
<>
                 forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit ((Int
ch forall a. Integral a => a -> a -> a
`div` Int
8) forall a. Integral a => a -> a -> a
`mod` Int
8)) forall doc. IsLine doc => doc -> doc -> doc
<>
                 forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit (Int
ch forall a. Integral a => a -> a -> a
`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 :: 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  -> forall doc. IsDoc doc => Line doc -> doc
pprDwWord (Line doc
target forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'-' forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
section)
    OS
OSMinGW32 -> forall doc. IsDoc doc => Line doc -> doc
line (forall doc. IsLine doc => String -> doc
text String
"\t.secrel32 " forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
target)
    OS
_other    -> forall doc. IsDoc doc => Line doc -> doc
pprDwWord Line doc
target
{-# SPECIALIZE sectionOffset :: Platform -> SDoc -> SDoc -> SDoc #-}
{-# SPECIALIZE sectionOffset :: Platform -> HLine -> HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable