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

import Debug
import CLabel
import CmmExpr         ( GlobalReg(..) )
import Encoding
import FastString
import Outputable
import Platform
import Unique
import Reg
import SrcLoc
import Util

import Dwarf.Constants

import qualified Control.Monad.Trans.State.Strict as S
import Control.Monad (zipWithM, join)
import Data.Bits
import qualified Data.Map as Map
import Data.Word
import Data.Char

import CodeGen.Platform

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

-- | Abbreviation codes used for encoding above records in the
-- @.debug_info@ section.
data DwarfAbbrev
  = DwAbbrNull          -- ^ Pseudo, used for marking the end of lists
  | DwAbbrCompileUnit
  | DwAbbrSubprogram
  | DwAbbrSubprogramWithParent
  | DwAbbrBlockWithoutCode
  | DwAbbrBlock
  | DwAbbrGhcSrcNote
  deriving (DwarfAbbrev -> DwarfAbbrev -> Bool
(DwarfAbbrev -> DwarfAbbrev -> Bool)
-> (DwarfAbbrev -> DwarfAbbrev -> Bool) -> Eq DwarfAbbrev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
$c/= :: DwarfAbbrev -> DwarfAbbrev -> Bool
== :: DwarfAbbrev -> DwarfAbbrev -> Bool
$c== :: DwarfAbbrev -> DwarfAbbrev -> Bool
Eq, Int -> DwarfAbbrev
DwarfAbbrev -> Int
DwarfAbbrev -> [DwarfAbbrev]
DwarfAbbrev -> DwarfAbbrev
DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
(DwarfAbbrev -> DwarfAbbrev)
-> (DwarfAbbrev -> DwarfAbbrev)
-> (Int -> DwarfAbbrev)
-> (DwarfAbbrev -> Int)
-> (DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> (DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev])
-> Enum DwarfAbbrev
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThenTo :: DwarfAbbrev -> DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromTo :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
$cenumFromThen :: DwarfAbbrev -> DwarfAbbrev -> [DwarfAbbrev]
enumFrom :: DwarfAbbrev -> [DwarfAbbrev]
$cenumFrom :: DwarfAbbrev -> [DwarfAbbrev]
fromEnum :: DwarfAbbrev -> Int
$cfromEnum :: DwarfAbbrev -> Int
toEnum :: Int -> DwarfAbbrev
$ctoEnum :: Int -> DwarfAbbrev
pred :: DwarfAbbrev -> DwarfAbbrev
$cpred :: DwarfAbbrev -> DwarfAbbrev
succ :: DwarfAbbrev -> DwarfAbbrev
$csucc :: DwarfAbbrev -> DwarfAbbrev
Enum)

-- | Generate assembly for the given abbreviation code
pprAbbrev :: DwarfAbbrev -> SDoc
pprAbbrev :: DwarfAbbrev -> SDoc
pprAbbrev = Word -> SDoc
pprLEBWord (Word -> SDoc) -> (DwarfAbbrev -> Word) -> DwarfAbbrev -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
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 :: Bool -> SDoc
pprAbbrevDecls :: Bool -> SDoc
pprAbbrevDecls haveDebugLine :: Bool
haveDebugLine =
  let mkAbbrev :: DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev abbr :: DwarfAbbrev
abbr tag :: Word
tag chld :: Word8
chld flds :: [(Word, Word)]
flds =
        let fld :: (Word, Word) -> SDoc
fld (tag :: Word
tag, form :: Word
form) = Word -> SDoc
pprLEBWord Word
tag SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprLEBWord Word
form
        in DwarfAbbrev -> SDoc
pprAbbrev DwarfAbbrev
abbr SDoc -> SDoc -> SDoc
$$ Word -> SDoc
pprLEBWord Word
tag SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte Word8
chld SDoc -> SDoc -> SDoc
$$
           [SDoc] -> SDoc
vcat (((Word, Word) -> SDoc) -> [(Word, Word)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Word, Word) -> SDoc
fld [(Word, Word)]
flds) SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte 0 SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
pprByte 0
      -- These are shared between DwAbbrSubprogram and
      -- DwAbbrSubprogramWithParent
      subprogramAttrs :: [(Word, Word)]
subprogramAttrs =
           [ (Word
dW_AT_name, Word
dW_FORM_string)
           , (Word
dW_AT_MIPS_linkage_name, Word
dW_FORM_string)
           , (Word
dW_AT_external, Word
dW_FORM_flag)
           , (Word
dW_AT_low_pc, Word
dW_FORM_addr)
           , (Word
dW_AT_high_pc, Word
dW_FORM_addr)
           , (Word
dW_AT_frame_base, Word
dW_FORM_block1)
           ]
  in SDoc
dwarfAbbrevSection SDoc -> SDoc -> SDoc
$$
     PtrString -> SDoc
ptext PtrString
dwarfAbbrevLabel SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrCompileUnit Word
dW_TAG_compile_unit Word8
dW_CHILDREN_yes
       ([(Word
dW_AT_name,     Word
dW_FORM_string)
       , (Word
dW_AT_producer, Word
dW_FORM_string)
       , (Word
dW_AT_language, Word
dW_FORM_data4)
       , (Word
dW_AT_comp_dir, Word
dW_FORM_string)
       , (Word
dW_AT_use_UTF8, Word
dW_FORM_flag_present)  -- not represented in body
       , (Word
dW_AT_low_pc,   Word
dW_FORM_addr)
       , (Word
dW_AT_high_pc,  Word
dW_FORM_addr)
       ] [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
++
       (if Bool
haveDebugLine
        then [ (Word
dW_AT_stmt_list, Word
dW_FORM_data4) ]
        else [])) SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrSubprogram Word
dW_TAG_subprogram Word8
dW_CHILDREN_yes
       [(Word, Word)]
subprogramAttrs SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrSubprogramWithParent Word
dW_TAG_subprogram Word8
dW_CHILDREN_yes
       ([(Word, Word)]
subprogramAttrs [(Word, Word)] -> [(Word, Word)] -> [(Word, Word)]
forall a. [a] -> [a] -> [a]
++ [(Word
dW_AT_ghc_tick_parent, Word
dW_FORM_ref_addr)]) SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrBlockWithoutCode Word
dW_TAG_lexical_block Word8
dW_CHILDREN_yes
       [ (Word
dW_AT_name, Word
dW_FORM_string)
       ] SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrBlock Word
dW_TAG_lexical_block Word8
dW_CHILDREN_yes
       [ (Word
dW_AT_name, Word
dW_FORM_string)
       , (Word
dW_AT_low_pc, Word
dW_FORM_addr)
       , (Word
dW_AT_high_pc, Word
dW_FORM_addr)
       ] SDoc -> SDoc -> SDoc
$$
     DwarfAbbrev -> Word -> Word8 -> [(Word, Word)] -> SDoc
mkAbbrev DwarfAbbrev
DwAbbrGhcSrcNote Word
dW_TAG_ghc_src_note Word8
dW_CHILDREN_no
       [ (Word
dW_AT_ghc_span_file, Word
dW_FORM_string)
       , (Word
dW_AT_ghc_span_start_line, Word
dW_FORM_data4)
       , (Word
dW_AT_ghc_span_start_col, Word
dW_FORM_data2)
       , (Word
dW_AT_ghc_span_end_line, Word
dW_FORM_data4)
       , (Word
dW_AT_ghc_span_end_col, Word
dW_FORM_data2)
       ] SDoc -> SDoc -> SDoc
$$
     Word8 -> SDoc
pprByte 0

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

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

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

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

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

pprDwarfARange :: DwarfARange -> SDoc
pprDwarfARange :: DwarfARange -> SDoc
pprDwarfARange arng :: DwarfARange
arng = SDoc -> SDoc
pprWord (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> SDoc) -> CLabel -> SDoc
forall a b. (a -> b) -> a -> b
$ DwarfARange -> CLabel
dwArngStartLabel DwarfARange
arng) SDoc -> SDoc -> SDoc
$$ SDoc -> SDoc
pprWord SDoc
length
  where
    length :: SDoc
length = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DwarfARange -> CLabel
dwArngEndLabel DwarfARange
arng)
             SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '-' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DwarfARange -> CLabel
dwArngStartLabel DwarfARange
arng)

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

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

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

instance Outputable DwarfFrameBlock where
  ppr :: DwarfFrameBlock -> SDoc
ppr (DwarfFrameBlock hasInfo :: Bool
hasInfo unwinds :: [UnwindPoint]
unwinds) = SDoc -> SDoc
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
<+> [UnwindPoint] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [UnwindPoint]
unwinds

-- | Header for the @.debug_frame@ section. Here we emit the "Common
-- Information Entry" record that etablishes general call frame
-- parameters and the default stack layout.
pprDwarfFrame :: DwarfFrame -> SDoc
pprDwarfFrame :: DwarfFrame -> SDoc
pprDwarfFrame DwarfFrame{dwCieLabel :: DwarfFrame -> CLabel
dwCieLabel=CLabel
cieLabel,dwCieInit :: DwarfFrame -> UnwindTable
dwCieInit=UnwindTable
cieInit,dwCieProcs :: DwarfFrame -> [DwarfFrameProc]
dwCieProcs=[DwarfFrameProc]
procs}
  = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \plat :: Platform
plat ->
    let cieStartLabel :: CLabel
cieStartLabel= CLabel -> FastString -> CLabel
mkAsmTempDerivedLabel CLabel
cieLabel (String -> FastString
fsLit "_start")
        cieEndLabel :: CLabel
cieEndLabel = CLabel -> CLabel
mkAsmTempEndLabel CLabel
cieLabel
        length :: SDoc
length      = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
cieEndLabel SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '-' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
cieStartLabel
        spReg :: Word8
spReg       = Platform -> GlobalReg -> Word8
dwarfGlobalRegNo Platform
plat GlobalReg
Sp
        retReg :: Word8
retReg      = Platform -> Word8
dwarfReturnRegNo Platform
plat
        wordSize :: Int
wordSize    = Platform -> Int
platformWordSize Platform
plat
        pprInit :: (GlobalReg, Maybe UnwindExpr) -> SDoc
        pprInit :: (GlobalReg, Maybe UnwindExpr) -> SDoc
pprInit (g :: GlobalReg
g, uw :: Maybe UnwindExpr
uw) = Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc
pprSetUnwind Platform
plat GlobalReg
g (Maybe UnwindExpr
forall a. Maybe a
Nothing, Maybe UnwindExpr
uw)

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

              -- Preserve C stack pointer
            , SDoc
preserveSp

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

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

-- | Generates unwind information for a block. We only generate
-- instructions where unwind information actually changes. This small
-- optimisations saves a lot of space, as subsequent blocks often have
-- the same unwind information.
pprFrameBlock :: DwarfFrameBlock -> S.State UnwindTable SDoc
pprFrameBlock :: DwarfFrameBlock -> StateT UnwindTable Identity SDoc
pprFrameBlock (DwarfFrameBlock hasInfo :: Bool
hasInfo uws0 :: [UnwindPoint]
uws0) =
    [SDoc] -> SDoc
vcat ([SDoc] -> SDoc)
-> State UnwindTable [SDoc] -> StateT UnwindTable Identity SDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> UnwindPoint -> StateT UnwindTable Identity SDoc)
-> [Bool] -> [UnwindPoint] -> State UnwindTable [SDoc]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Bool -> UnwindPoint -> StateT UnwindTable Identity SDoc
pprFrameDecl (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [UnwindPoint]
uws0
  where
    pprFrameDecl :: Bool -> UnwindPoint -> S.State UnwindTable SDoc
    pprFrameDecl :: Bool -> UnwindPoint -> StateT UnwindTable Identity SDoc
pprFrameDecl firstDecl :: Bool
firstDecl (UnwindPoint lbl :: CLabel
lbl uws :: UnwindTable
uws) = (UnwindTable -> (SDoc, UnwindTable))
-> StateT UnwindTable Identity SDoc
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
S.state ((UnwindTable -> (SDoc, UnwindTable))
 -> StateT UnwindTable Identity SDoc)
-> (UnwindTable -> (SDoc, UnwindTable))
-> StateT UnwindTable Identity SDoc
forall a b. (a -> b) -> a -> b
$ \oldUws :: 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 g :: GlobalReg
g new :: 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 (SDoc
empty, UnwindTable
oldUws)
             else let -- see [Note: Info Offset]
                      needsOffset :: Bool
needsOffset = Bool
firstDecl Bool -> Bool -> Bool
&& Bool
hasInfo
                      lblDoc :: SDoc
lblDoc = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<>
                               if Bool
needsOffset then String -> SDoc
text "-1" else SDoc
empty
                      doc :: SDoc
doc = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \plat :: Platform
plat ->
                           Word8 -> SDoc
pprByte Word8
dW_CFA_set_loc SDoc -> SDoc -> SDoc
$$ SDoc -> SDoc
pprWord SDoc
lblDoc SDoc -> SDoc -> SDoc
$$
                           [SDoc] -> SDoc
vcat (((GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> SDoc)
-> [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc)
-> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> SDoc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc)
 -> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr)) -> SDoc)
-> (GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc)
-> (GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))
-> SDoc
forall a b. (a -> b) -> a -> b
$ Platform
-> GlobalReg -> (Maybe UnwindExpr, Maybe UnwindExpr) -> SDoc
pprSetUnwind Platform
plat) [(GlobalReg, (Maybe UnwindExpr, Maybe UnwindExpr))]
changed)
                  in (SDoc
doc, UnwindTable
uws)

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

-- | Get DWARF register ID for a given GlobalReg
dwarfGlobalRegNo :: Platform -> GlobalReg -> Word8
dwarfGlobalRegNo :: Platform -> GlobalReg -> Word8
dwarfGlobalRegNo p :: Platform
p UnwindReturnReg = Platform -> Word8
dwarfReturnRegNo Platform
p
dwarfGlobalRegNo p :: Platform
p reg :: GlobalReg
reg = Word8 -> (RealReg -> Word8) -> Maybe RealReg -> Word8
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 (Platform -> Reg -> Word8
dwarfRegNo Platform
p (Reg -> Word8) -> (RealReg -> Reg) -> RealReg -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealReg -> Reg
RegReal) (Maybe RealReg -> Word8) -> Maybe RealReg -> Word8
forall a b. (a -> b) -> a -> b
$ Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
p GlobalReg
reg

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

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

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


-- | Align assembly at (machine) word boundary
wordAlign :: SDoc
wordAlign :: SDoc
wordAlign = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \plat :: Platform
plat ->
  String -> SDoc
text "\t.align " SDoc -> SDoc -> SDoc
<> case Platform -> OS
platformOS Platform
plat of
    OSDarwin -> case Platform -> Int
platformWordSize Platform
plat of
      8      -> String -> SDoc
text "3"
      4      -> String -> SDoc
text "2"
      _other :: Int
_other -> String -> SDoc
forall a. HasCallStack => String -> a
error "wordAlign: Unsupported word size!"
    _other :: OS
_other   -> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Platform -> Int
platformWordSize Platform
plat)

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

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

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

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

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

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

-- | Assembly for a machine word of dynamic data. Depends on the
-- architecture we are currently generating code for.
pprWord :: SDoc -> SDoc
pprWord :: SDoc -> SDoc
pprWord s :: SDoc
s = (SDoc -> SDoc -> SDoc
<> SDoc
s) (SDoc -> SDoc)
-> ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \plat :: Platform
plat ->
  case Platform -> Int
platformWordSize Platform
plat of
    4 -> String -> SDoc
text "\t.long "
    8 -> String -> SDoc
text "\t.quad "
    n :: Int
n -> String -> SDoc
forall a. String -> a
panic (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ "pprWord: Unsupported target platform word length " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                 Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "!"

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

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

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

-- | Generate a string constant. We take care to escape the string.
pprString :: String -> SDoc
pprString :: String -> SDoc
pprString str :: String
str
  = SDoc -> SDoc
pprString' (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
hcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (Char -> SDoc) -> String -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Char -> SDoc
escapeChar (String -> [SDoc]) -> String -> [SDoc]
forall a b. (a -> b) -> a -> b
$
    if String
str String -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` String -> Int
utf8EncodedLength String
str
    then String
str
    else (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ FastString -> [Word8]
bytesFS (FastString -> [Word8]) -> FastString -> [Word8]
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString String
str

-- | Escape a single non-unicode character
escapeChar :: Char -> SDoc
escapeChar :: Char -> SDoc
escapeChar '\\' = String -> SDoc
text "\\\\"
escapeChar '\"' = String -> SDoc
text "\\\""
escapeChar '\n' = String -> SDoc
text "\\n"
escapeChar c :: 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
/= '?' -- prevents trigraph warnings
  = Char -> SDoc
char Char
c
  | Bool
otherwise
  = Char -> SDoc
char '\\' SDoc -> SDoc -> SDoc
<> Char -> SDoc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 64)) SDoc -> SDoc -> SDoc
<>
                 Char -> SDoc
char (Int -> Char
intToDigit ((Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 8)) SDoc -> SDoc -> SDoc
<>
                 Char -> SDoc
char (Int -> Char
intToDigit (Int
ch Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 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 :: SDoc -> SDoc -> SDoc
sectionOffset :: SDoc -> SDoc -> SDoc
sectionOffset target :: SDoc
target section :: SDoc
section = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \plat :: Platform
plat ->
  case Platform -> OS
platformOS Platform
plat of
    OSDarwin  -> SDoc -> SDoc
pprDwWord (SDoc
target SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '-' SDoc -> SDoc -> SDoc
<> SDoc
section)
    OSMinGW32 -> String -> SDoc
text "\t.secrel32 " SDoc -> SDoc -> SDoc
<> SDoc
target
    _other :: OS
_other    -> SDoc -> SDoc
pprDwWord SDoc
target