{-# 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
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
(DwarfAbbrev -> DwarfAbbrev -> Bool)
-> (DwarfAbbrev -> DwarfAbbrev -> Bool) -> Eq DwarfAbbrev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DwarfAbbrev -> DwarfAbbrev -> Bool
== :: DwarfAbbrev -> DwarfAbbrev -> Bool
$c/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
Eq, Int -> DwarfAbbrev
DwarfAbbrev -> Int
DwarfAbbrev -> [DwarfAbbrev]
DwarfAbbrev -> DwarfAbbrev
DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
(DwarfAbbrev -> DwarfAbbrev)
-> (DwarfAbbrev -> DwarfAbbrev)
-> (Int -> DwarfAbbrev)
-> (DwarfAbbrev -> Int)
-> (DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> Enum DwarfAbbrev
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DwarfAbbrev -> DwarfAbbrev
succ :: DwarfAbbrev -> DwarfAbbrev
$cpred :: DwarfAbbrev -> DwarfAbbrev
pred :: DwarfAbbrev -> DwarfAbbrev
$ctoEnum :: Int -> DwarfAbbrev
toEnum :: Int -> DwarfAbbrev
$cfromEnum :: DwarfAbbrev -> Int
fromEnum :: DwarfAbbrev -> Int
$cenumFrom :: DwarfAbbrev -> [DwarfAbbrev]
enumFrom :: DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
Enum)

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

-- | 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) = Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
tag doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
form
        in DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
abbr doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
tag doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
chld doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (((Word, Word) -> doc) -> [(Word, Word)] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Word, Word) -> doc
forall {doc}. IsDoc doc => (Word, Word) -> doc
fld [(Word, Word)]
flds) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0 doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
      -- 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 Platform -> doc
forall doc. IsDoc doc => Platform -> doc
dwarfAbbrevSection Platform
platform doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc
forall doc. IsLine doc => doc
dwarfAbbrevLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrCompileUnit Word
dW_TAG_compile_unit Word8
dW_CHILDREN_yes
       ([(Word
dW_AT_name,     Word
dW_FORM_string)
       , (Word
dW_AT_producer, Word
dW_FORM_string)
       , (Word
dW_AT_language, Word
dW_FORM_data4)
       , (Word
dW_AT_comp_dir, Word
dW_FORM_string)
       , (Word
dW_AT_use_UTF8, Word
dW_FORM_flag_present)  -- 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 [])) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrSubprogram Word
dW_TAG_subprogram Word8
dW_CHILDREN_yes
       [(Word, Word)]
subprogramAttrs doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrSubprogramWithParent Word
dW_TAG_subprogram Word8
dW_CHILDREN_yes
       ([(Word, Word)]
subprogramAttrs [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
++ [(Word
dW_AT_ghc_tick_parent, Word
dW_FORM_ref_addr)]) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode Word
dW_TAG_lexical_block Word8
dW_CHILDREN_yes
       [ (Word
dW_AT_name, Word
dW_FORM_string)
       ] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrBlock Word
dW_TAG_lexical_block Word8
dW_CHILDREN_yes
       [ (Word
dW_AT_name, Word
dW_FORM_string)
       , (Word
dW_AT_low_pc, Word
dW_FORM_addr)
       , (Word
dW_AT_high_pc, Word
dW_FORM_addr)
       ] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
forall {doc}.
IsDoc doc =>
DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> doc
mkAbbrev DwarfAbbrev
DwAbbrGhcSrcNote Word
dW_TAG_ghc_src_note Word8
dW_CHILDREN_no
       [ (Word
dW_AT_ghc_span_file, Word
dW_FORM_string)
       , (Word
dW_AT_ghc_span_start_line, Word
dW_FORM_data4)
       , (Word
dW_AT_ghc_span_start_col, Word
dW_FORM_data2)
       , (Word
dW_AT_ghc_span_end_line, Word
dW_FORM_data4)
       , (Word
dW_AT_ghc_span_end_col, Word
dW_FORM_data2)
       ] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0
{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> SDoc #-}
{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> HDoc #-} -- 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 =
        Platform -> Bool -> DwarfInfo -> doc
forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfoOpen Platform
platform Bool
haveSrc DwarfInfo
d doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
        [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((DwarfInfo -> doc) -> [DwarfInfo] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Bool -> DwarfInfo -> doc
forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfo Platform
platform Bool
haveSrc) (DwarfInfo -> [DwarfInfo]
dwChildren DwarfInfo
d)) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
        doc
forall doc. IsDoc doc => doc
pprDwarfInfoClose
    noChildren :: doc
noChildren = Platform -> Bool -> DwarfInfo -> doc
forall doc. IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
pprDwarfInfoOpen Platform
platform Bool
haveSrc DwarfInfo
d
{-# SPECIALIZE pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> SDoc #-}
{-# SPECIALIZE pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> HDoc #-} -- 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 =
   Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprString'                  -- we don't need to escape the string as labels don't contain exotic characters
    (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprCLabel Platform
platform CLabel
label -- 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) =
  DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrCompileUnit
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
name
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
producer
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprData4 Word
dW_LANG_Haskell
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
compDir
     -- Offset due to Note [Info Offset]
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lowLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1")
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
highLabel)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ if Bool
haveSrc
     then Platform -> Line doc -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform Line doc
forall doc. IsLine doc => doc
dwarfLineLabel Line doc
forall doc. IsLine doc => doc
dwarfLineLabel
     else doc
forall doc. IsOutput doc => doc
empty
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfSubprogram [DwarfInfo]
_ String
name CLabel
label Maybe CLabel
parent) =
  Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
abbrev
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> doc
forall doc. IsDoc doc => String -> doc
pprString String
name
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Bool -> doc
forall doc. IsDoc doc => Bool -> doc
pprFlag (CLabel -> Bool
externallyVisibleCLabel CLabel
label)
     -- Offset due to Note [Info Offset]
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
label Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1")
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> Line doc) -> CLabel -> Line doc
forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
label)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
1
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_OP_call_frame_cfa
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ doc
parentValue
  where
    abbrev :: DwarfAbbrev
abbrev = case Maybe CLabel
parent of Maybe CLabel
Nothing -> DwarfAbbrev
DwAbbrSubprogram
                            Just CLabel
_  -> DwarfAbbrev
DwAbbrSubprogramWithParent
    parentValue :: doc
parentValue = doc -> (CLabel -> doc) -> Maybe CLabel -> doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe doc
forall doc. IsOutput doc => doc
empty CLabel -> doc
pprParentDie Maybe CLabel
parent
    pprParentDie :: CLabel -> doc
pprParentDie CLabel
sym = Platform -> Line doc -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> Line doc -> doc
sectionOffset Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
sym) Line doc
forall doc. IsLine doc => doc
dwarfInfoLabel
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label Maybe CLabel
Nothing) =
  Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
pprDwarfInfoOpen Platform
platform Bool
_ (DwarfBlock [DwarfInfo]
_ CLabel
label (Just CLabel
marker)) =
  Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempDieLabel CLabel
label) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrBlock
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabelString Platform
platform CLabel
label
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
marker)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> Line doc) -> CLabel -> Line doc
forall a b. (a -> b) -> a -> b
$ CLabel -> CLabel
mkAsmTempEndLabel CLabel
marker)
pprDwarfInfoOpen Platform
_ Bool
_ (DwarfSrcNote RealSrcSpan
ss) =
  DwarfAbbrev -> doc
forall doc. IsDoc doc => DwarfAbbrev -> doc
pprAbbrev DwarfAbbrev
DwAbbrGhcSrcNote
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprString' (FastString -> Line doc
forall doc. IsLine doc => FastString -> doc
ftext (FastString -> Line doc) -> FastString -> Line doc
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
ss)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprData4 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word16 -> doc
forall doc. IsDoc doc => Word16 -> doc
pprHalf (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprData4 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss)
  doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word16 -> doc
forall doc. IsDoc doc => Word16 -> doc
pprHalf (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
ss)

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

-- | 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) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
hasInfo SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> [UnwindPoint] -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
env [UnwindPoint]
unwinds

-- | 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      = Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieStartLabel
        spReg :: Word8
spReg       = Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
platform GlobalReg
Sp
        retReg :: Word8
retReg      = Platform -> Word8
dwarfReturnRegNo Platform
platform
        wordSize :: Int
wordSize    = Platform -> Int
platformWordSizeInBytes Platform
platform
        pprInit :: (GlobalReg, Maybe UnwindExpr) -> doc
        pprInit :: (GlobalReg, Maybe UnwindExpr) -> doc
pprInit (GlobalReg
g, Maybe UnwindExpr
uw) = Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
forall doc.
IsDoc doc =>
Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> doc
pprSetUnwind Platform
platform GlobalReg
g (Maybe UnwindExpr
forall a. Maybe a
Nothing, Maybe UnwindExpr
uw)

        -- 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    -> Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
4
          Arch
ArchX86_64 -> Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
7
          Arch
_          -> doc
forall doc. IsOutput doc => doc
empty
    in [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
            , Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' Line doc
length -- Length of CIE
            , Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieStartLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
            , Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"-1")
                               -- Common Information Entry marker (-1 = 0xf..f)
            , Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
3        -- CIE version (we require DWARF 3)
            , Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0        -- Augmentation (none)
            , Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
1        -- Code offset multiplicator
            , Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
128Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
wordSize)
                               -- Data offset multiplicator
                               -- (stacks grow down => "-w" in signed LEB128)
            , Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
retReg   -- virtual register holding return address
            ] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       -- Initial unwind table
       [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (((GlobalReg, Maybe UnwindExpr) -> doc)
-> [(GlobalReg, Maybe UnwindExpr)] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (GlobalReg, Maybe UnwindExpr) -> doc
pprInit ([(GlobalReg, Maybe UnwindExpr)] -> [doc])
-> [(GlobalReg, Maybe UnwindExpr)] -> [doc]
forall a b. (a -> b) -> a -> b
$ UnwindTable -> [(GlobalReg, Maybe UnwindExpr)]
forall k a. Map k a -> [(k, a)]
Map.toList UnwindTable
cieInit) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [ -- RET = *CFA
              Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_CFA_offsetWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+Word8
retReg)
            , Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
0

              -- 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)
            , Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_val_offset
            , Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
spReg)
            , Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord Word
0
            ] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       Platform -> doc
forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
platform doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
cieEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       -- Procedure unwind tables
       [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((DwarfFrameProc -> doc) -> [DwarfFrameProc] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> doc
forall doc.
IsDoc doc =>
Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> doc
pprFrameProc Platform
platform CLabel
cieLabel UnwindTable
cieInit) [DwarfFrameProc]
procs)
{-# SPECIALIZE pprDwarfFrame :: Platform -> DwarfFrame -> SDoc #-}
{-# SPECIALIZE pprDwarfFrame :: Platform -> DwarfFrame -> HDoc #-} -- 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 String -> Line doc
forall doc. IsLine doc => String -> doc
text String
str else Line doc
forall doc. IsOutput doc => doc
empty
                      -- see Note [Info Offset]
    in [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [ doc -> doc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"# Unwinding for" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon
            , Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeLabel)
            , Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
            , Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
frameLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
dwarfFrameLabel)    -- Reference to CIE
            , Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
ifInfo String
"-1") -- Code pointer
            , Platform -> Line doc -> doc
forall doc. IsDoc doc => Platform -> Line doc -> doc
pprWord Platform
platform (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procEnd Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<>
                                 Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
procLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
ifInfo String
"+1") -- Block byte length
            ] doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (State UnwindTable [doc] -> UnwindTable -> [doc]
forall s a. State s a -> s -> a
S.evalState ((DwarfFrameBlock -> State UnwindTable doc)
-> [DwarfFrameBlock] -> State UnwindTable [doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Platform -> DwarfFrameBlock -> State UnwindTable doc
forall doc.
IsDoc doc =>
Platform -> DwarfFrameBlock -> State UnwindTable doc
pprFrameBlock Platform
platform) [DwarfFrameBlock]
blocks) UnwindTable
initUw) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       Platform -> doc
forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
platform doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
fdeEndLabel Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)

-- | 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) =
    [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ([doc] -> doc) -> State UnwindTable [doc] -> State UnwindTable doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> UnwindPoint -> State UnwindTable doc)
-> [Bool] -> [UnwindPoint] -> State UnwindTable [doc]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Bool -> UnwindPoint -> State UnwindTable doc
pprFrameDecl (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [UnwindPoint]
uws0
  where
    pprFrameDecl :: Bool -> UnwindPoint -> S.State UnwindTable doc
    pprFrameDecl :: Bool -> UnwindPoint -> State UnwindTable doc
pprFrameDecl Bool
firstDecl (UnwindPoint CLabel
lbl UnwindTable
uws) = (UnwindTable -> (doc, UnwindTable)) -> State UnwindTable doc
forall s a. (s -> (a, s)) -> State s a
S.state ((UnwindTable -> (doc, UnwindTable)) -> State UnwindTable doc)
-> (UnwindTable -> (doc, UnwindTable)) -> State UnwindTable doc
forall a b. (a -> b) -> a -> b
$ \UnwindTable
oldUws ->
        let -- 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
== 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
join Maybe (Maybe UnwindExpr)
old, Maybe UnwindExpr
new)
              where
                old :: Maybe (Maybe UnwindExpr)
old = GlobalReg -> UnwindTable -> Maybe (Maybe UnwindExpr)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GlobalReg
g UnwindTable
oldUws

            changed :: [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
changed = Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
 -> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))])
-> Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
forall a b. (a -> b) -> a -> b
$ (GlobalReg
 -> Maybe UnwindExpr -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr))
-> UnwindTable
-> Map GlobalReg (Maybe UnwindExpr, Maybe UnwindExpr)
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey GlobalReg
-> Maybe UnwindExpr -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr)
isChanged UnwindTable
uws

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

-- 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 = 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 :: 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)
  = Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprUndefUnwind Platform
plat GlobalReg
g
pprSetUnwind Platform
_    GlobalReg
Sp (Just (UwReg GlobalRegUse
s Int
_), Just (UwReg GlobalRegUse
s' Int
o')) | GlobalRegUse
s GlobalRegUse -> GlobalRegUse -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalRegUse
s'
  = if Int
o' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
    then Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_offset doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o')
    else Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_offset_sf doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> doc
forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just (UwReg (GlobalRegUse GlobalReg
s' CmmType
_) Int
o'))
  = if Int
o' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
    then Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
s' doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
o')
    else Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_sf doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
s' doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Int -> doc
forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
o'
pprSetUnwind Platform
plat GlobalReg
Sp (Maybe UnwindExpr
_, Just UnwindExpr
uw)
  = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_def_cfa_expression doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Bool -> UnwindExpr -> doc
forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
plat Bool
False UnwindExpr
uw
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just (UwDeref (UwReg (GlobalRegUse GlobalReg
Sp CmmType
_) Int
o)))
  | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& ((-Int
o) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Platform -> Int
platformWordSizeInBytes Platform
plat) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -- expected case
  = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word8
dW_CFA_offset Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat GlobalReg
g) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((-Int
o) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Platform -> Int
platformWordSizeInBytes Platform
plat))
  | Bool
otherwise
  = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_offset_extended_sf doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Int -> doc
forall {doc}. IsDoc doc => Int -> doc
pprLEBInt Int
o
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just (UwDeref UnwindExpr
uw))
  = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_expression doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Platform -> Bool -> UnwindExpr -> doc
forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
plat Bool
True UnwindExpr
uw
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just (UwReg (GlobalRegUse GlobalReg
g' CmmType
_) Int
0))
  | GlobalReg
g GlobalReg -> GlobalReg -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalReg
g'
  = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_same_value doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g
pprSetUnwind Platform
plat GlobalReg
g  (Maybe UnwindExpr
_, Just UnwindExpr
uw)
  = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_val_expression doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
    Platform -> Bool -> UnwindExpr -> doc
forall doc. IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
pprUnwindExpr Platform
plat Bool
True UnwindExpr
uw

-- | 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 = Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word -> doc) -> (GlobalReg -> Word) -> GlobalReg -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word) -> (GlobalReg -> Word8) -> GlobalReg -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat

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

-- | 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  = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte Word8
dW_CFA_undefined doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                         Platform -> GlobalReg -> doc
forall doc. IsDoc doc => Platform -> GlobalReg -> doc
pprLEBRegNo Platform
plat GlobalReg
g


-- | Align assembly at (machine) word boundary
wordAlign :: IsDoc doc => Platform -> doc
wordAlign :: forall doc. IsDoc doc => Platform -> doc
wordAlign Platform
plat =
  Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.align " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> case Platform -> OS
platformOS Platform
plat of
    OS
OSDarwin -> case Platform -> PlatformWordSize
platformWordSize Platform
plat of
      PlatformWordSize
PW8 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'3'
      PlatformWordSize
PW4 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'2'
    OS
_other   -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int (Platform -> Int
platformWordSizeInBytes Platform
plat)
{-# SPECIALIZE wordAlign :: Platform -> SDoc #-}
{-# SPECIALIZE wordAlign :: Platform -> HDoc #-} -- 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 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.byte " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Integer -> Line doc
forall doc. IsLine doc => Integer -> doc
integer (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
{-# SPECIALIZE pprByte :: Word8 -> SDoc #-}
{-# SPECIALIZE pprByte :: Word8 -> HDoc #-} -- 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 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.short" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Integer -> Line doc
forall doc. IsLine doc => Integer -> doc
integer (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
{-# SPECIALIZE pprHalf :: Word16 -> SDoc #-}
{-# SPECIALIZE pprHalf :: Word16 -> HDoc #-} -- 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 = Word8 -> doc
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 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
x)
{-# SPECIALIZE pprData4' :: SDoc -> SDoc #-}
{-# SPECIALIZE pprData4' :: HLine -> HDoc #-} -- 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 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprData4' (Line doc -> doc) -> (Word -> Line doc) -> Word -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Line doc
forall doc. IsLine doc => Integer -> doc
integer (Integer -> Line doc) -> (Word -> Integer) -> Word -> Line doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 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 = Line doc -> doc
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 =
  Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ case Platform -> PlatformWordSize
platformWordSize Platform
plat of
    PlatformWordSize
PW4 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
s
    PlatformWordSize
PW8 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.quad " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
s
{-# SPECIALIZE pprWord :: Platform -> SDoc -> SDoc #-}
{-# SPECIALIZE pprWord :: Platform -> HLine -> HDoc #-} -- 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 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
128   = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x)
             | Bool
otherwise = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word8) -> Word -> Word8
forall a b. (a -> b) -> a -> b
$ Word
128 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
x Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
127)) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                           Word -> doc
forall doc. IsDoc doc => Word -> doc
pprLEBWord (Word
x Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
7)
{-# SPECIALIZE pprLEBWord :: Word -> SDoc #-}
{-# SPECIALIZE pprLEBWord :: Word -> HDoc #-} -- 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int
64 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
64
                        = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
127))
            | Bool
otherwise = Word8 -> doc
forall doc. IsDoc doc => Word8 -> doc
pprByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
128 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
127)) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                          Int -> doc
forall {doc}. IsDoc doc => Int -> doc
pprLEBInt (Int
x Int -> Int -> Int
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 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.asciz \"" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
str Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'"')

-- | 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
  = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprString' (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat ([Line doc] -> Line doc) -> [Line doc] -> Line doc
forall a b. (a -> b) -> a -> b
$ (Char -> Line doc) -> String -> [Line doc]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Line doc
forall doc. IsLine doc => Char -> doc
escapeChar (String -> [Line doc]) -> String -> [Line doc]
forall a b. (a -> b) -> a -> b
$
    if String
str String -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` String -> Int
utf8EncodedLength String
str
    then String
str
    else (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
utf8EncodeByteString String
str

-- | Escape a single non-unicode character
escapeChar :: IsLine doc => Char -> doc
escapeChar :: forall doc. IsLine doc => Char -> doc
escapeChar Char
'\\' = String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\\\"
escapeChar Char
'\"' = String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\\""
escapeChar Char
'\n' = String -> doc
forall doc. IsLine doc => String -> doc
text String
"\\n"
escapeChar Char
c
  | Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?' -- prevents trigraph warnings
  = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
c
  | Bool
otherwise
  = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'\\' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
64)) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<>
                 Char -> doc
forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit ((Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<>
                 Char -> doc
forall doc. IsLine doc => Char -> doc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8))
  where ch :: Int
ch = Char -> Int
ord Char
c

-- | 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  -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprDwWord (Line doc
target Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
section)
    OS
OSMinGW32 -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.secrel32 " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
target)
    OS
_other    -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
pprDwWord Line doc
target
{-# SPECIALIZE sectionOffset :: Platform -> SDoc -> SDoc -> SDoc #-}
{-# SPECIALIZE sectionOffset :: Platform -> HLine -> HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable