{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} module GHC.CmmToAsm.Dwarf.Types ( -- * Dwarf information DwarfInfo(..) , pprDwarfInfo , pprAbbrevDecls -- * Dwarf address range table , DwarfARange(..) , pprDwarfARanges -- * Dwarf frame , DwarfFrame(..), DwarfFrameProc(..), DwarfFrameBlock(..) , pprDwarfFrame -- * Utilities , pprByte , pprHalf , pprData4' , pprDwWord , pprWord , pprLEBWord , pprLEBInt , wordAlign , sectionOffset ) where import GHC.Prelude import GHC.Cmm.DebugBlock import GHC.Cmm.CLabel import GHC.Cmm.Expr ( GlobalReg(..) ) import GHC.Utils.Encoding import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Platform import GHC.Types.Unique import GHC.Platform.Reg import GHC.Types.SrcLoc import GHC.Utils.Misc import GHC.CmmToAsm.Dwarf.Constants import qualified Data.ByteString as BS import qualified GHC.Utils.Monad.State.Strict as S import Control.Monad (zipWithM, join) import qualified Data.Map as Map import Data.Word import Data.Char import GHC.Platform.Regs -- | Individual dwarf records. Each one will be encoded as an entry in -- the @.debug_info@ section. data DwarfInfo = DwarfCompileUnit { dwChildren :: [DwarfInfo] , dwName :: String , dwProducer :: String , dwCompDir :: String , dwLowLabel :: CLabel , dwHighLabel :: CLabel } | DwarfSubprogram { dwChildren :: [DwarfInfo] , dwName :: String , dwLabel :: CLabel , dwParent :: Maybe CLabel -- ^ label of DIE belonging to the parent tick } | DwarfBlock { dwChildren :: [DwarfInfo] , dwLabel :: CLabel , dwMarker :: Maybe CLabel } | DwarfSrcNote { 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 (Eq, Enum) -- | Generate assembly for the given abbreviation code pprAbbrev :: IsDoc doc => DwarfAbbrev -> doc pprAbbrev = pprLEBWord . fromIntegral . 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 platform haveDebugLine = let mkAbbrev abbr tag chld flds = let fld (tag, form) = pprLEBWord tag $$ pprLEBWord form in pprAbbrev abbr $$ pprLEBWord tag $$ pprByte chld $$ vcat (map fld flds) $$ pprByte 0 $$ pprByte 0 -- These are shared between DwAbbrSubprogram and -- DwAbbrSubprogramWithParent subprogramAttrs = [ (dW_AT_name, dW_FORM_string) , (dW_AT_linkage_name, dW_FORM_string) , (dW_AT_external, dW_FORM_flag) , (dW_AT_low_pc, dW_FORM_addr) , (dW_AT_high_pc, dW_FORM_addr) , (dW_AT_frame_base, dW_FORM_block1) ] in dwarfAbbrevSection platform $$ line (dwarfAbbrevLabel <> colon) $$ mkAbbrev DwAbbrCompileUnit dW_TAG_compile_unit dW_CHILDREN_yes ([(dW_AT_name, dW_FORM_string) , (dW_AT_producer, dW_FORM_string) , (dW_AT_language, dW_FORM_data4) , (dW_AT_comp_dir, dW_FORM_string) , (dW_AT_use_UTF8, dW_FORM_flag_present) -- not represented in body , (dW_AT_low_pc, dW_FORM_addr) , (dW_AT_high_pc, dW_FORM_addr) ] ++ (if haveDebugLine then [ (dW_AT_stmt_list, dW_FORM_data4) ] else [])) $$ mkAbbrev DwAbbrSubprogram dW_TAG_subprogram dW_CHILDREN_yes subprogramAttrs $$ mkAbbrev DwAbbrSubprogramWithParent dW_TAG_subprogram dW_CHILDREN_yes (subprogramAttrs ++ [(dW_AT_ghc_tick_parent, dW_FORM_ref_addr)]) $$ mkAbbrev DwAbbrBlockWithoutCode dW_TAG_lexical_block dW_CHILDREN_yes [ (dW_AT_name, dW_FORM_string) ] $$ mkAbbrev DwAbbrBlock dW_TAG_lexical_block dW_CHILDREN_yes [ (dW_AT_name, dW_FORM_string) , (dW_AT_low_pc, dW_FORM_addr) , (dW_AT_high_pc, dW_FORM_addr) ] $$ mkAbbrev DwAbbrGhcSrcNote dW_TAG_ghc_src_note dW_CHILDREN_no [ (dW_AT_ghc_span_file, dW_FORM_string) , (dW_AT_ghc_span_start_line, dW_FORM_data4) , (dW_AT_ghc_span_start_col, dW_FORM_data2) , (dW_AT_ghc_span_end_line, dW_FORM_data4) , (dW_AT_ghc_span_end_col, dW_FORM_data2) ] $$ pprByte 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 platform haveSrc d = case d of DwarfCompileUnit {} -> hasChildren DwarfSubprogram {} -> hasChildren DwarfBlock {} -> hasChildren DwarfSrcNote {} -> noChildren where hasChildren = pprDwarfInfoOpen platform haveSrc d $$ vcat (map (pprDwarfInfo platform haveSrc) (dwChildren d)) $$ pprDwarfInfoClose noChildren = pprDwarfInfoOpen platform haveSrc 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 platform label = pprString' -- we don't need to escape the string as labels don't contain exotic characters $ pprCLabel platform 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 platform haveSrc (DwarfCompileUnit _ name producer compDir lowLabel highLabel) = pprAbbrev DwAbbrCompileUnit $$ pprString name $$ pprString producer $$ pprData4 dW_LANG_Haskell $$ pprString compDir -- Offset due to Note [Info Offset] $$ pprWord platform (pprAsmLabel platform lowLabel <> text "-1") $$ pprWord platform (pprAsmLabel platform highLabel) $$ if haveSrc then sectionOffset platform dwarfLineLabel dwarfLineLabel else empty pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) = line (pprAsmLabel platform (mkAsmTempDieLabel label) <> colon) $$ pprAbbrev abbrev $$ pprString name $$ pprLabelString platform label $$ pprFlag (externallyVisibleCLabel label) -- Offset due to Note [Info Offset] $$ pprWord platform (pprAsmLabel platform label <> text "-1") $$ pprWord platform (pprAsmLabel platform $ mkAsmTempProcEndLabel label) $$ pprByte 1 $$ pprByte dW_OP_call_frame_cfa $$ parentValue where abbrev = case parent of Nothing -> DwAbbrSubprogram Just _ -> DwAbbrSubprogramWithParent parentValue = maybe empty pprParentDie parent pprParentDie sym = sectionOffset platform (pprAsmLabel platform sym) dwarfInfoLabel pprDwarfInfoOpen platform _ (DwarfBlock _ label Nothing) = line (pprAsmLabel platform (mkAsmTempDieLabel label) <> colon) $$ pprAbbrev DwAbbrBlockWithoutCode $$ pprLabelString platform label pprDwarfInfoOpen platform _ (DwarfBlock _ label (Just marker)) = line (pprAsmLabel platform (mkAsmTempDieLabel label) <> colon) $$ pprAbbrev DwAbbrBlock $$ pprLabelString platform label $$ pprWord platform (pprAsmLabel platform marker) $$ pprWord platform (pprAsmLabel platform $ mkAsmTempEndLabel marker) pprDwarfInfoOpen _ _ (DwarfSrcNote ss) = pprAbbrev DwAbbrGhcSrcNote $$ pprString' (ftext $ srcSpanFile ss) $$ pprData4 (fromIntegral $ srcSpanStartLine ss) $$ pprHalf (fromIntegral $ srcSpanStartCol ss) $$ pprData4 (fromIntegral $ srcSpanEndLine ss) $$ pprHalf (fromIntegral $ srcSpanEndCol ss) -- | Close a DWARF info record with children pprDwarfInfoClose :: IsDoc doc => doc pprDwarfInfoClose = pprAbbrev 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 { dwArngStartLabel :: CLabel , dwArngEndLabel :: CLabel } -- | Print assembler directives corresponding to a DWARF @.debug_aranges@ -- address table entry. pprDwarfARanges :: IsDoc doc => Platform -> [DwarfARange] -> Unique -> doc pprDwarfARanges platform arngs unitU = let wordSize = platformWordSizeInBytes platform 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 n = vcat $ replicate n $ pprByte 0 -- Fix for #17428 initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize in pprDwWord (int initialLength) $$ pprHalf 2 $$ sectionOffset platform (pprAsmLabel platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel $$ pprByte (fromIntegral wordSize) $$ pprByte 0 $$ pad paddingSize -- body $$ vcat (map (pprDwarfARange platform) arngs) -- terminus $$ pprWord platform (char '0') $$ pprWord platform (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 platform arng = -- Offset due to Note [Info Offset]. pprWord platform (pprAsmLabel platform (dwArngStartLabel arng) <> text "-1") $$ pprWord platform length where length = pprAsmLabel platform (dwArngEndLabel arng) <> char '-' <> pprAsmLabel platform (dwArngStartLabel arng) -- | Information about unwind instructions for a procedure. This -- corresponds to a "Common Information Entry" (CIE) in DWARF. data DwarfFrame = DwarfFrame { dwCieLabel :: CLabel , dwCieInit :: UnwindTable , dwCieProcs :: [DwarfFrameProc] } -- | Unwind instructions for an individual procedure. Corresponds to a -- "Frame Description Entry" (FDE) in DWARF. data DwarfFrameProc = DwarfFrameProc { dwFdeProc :: CLabel , dwFdeHasInfo :: Bool , dwFdeBlocks :: [DwarfFrameBlock] -- ^ List of blocks. Order must match asm! } -- | Unwind instructions for a block. Will become part of the -- containing FDE. data DwarfFrameBlock = DwarfFrameBlock { dwFdeBlkHasInfo :: Bool , dwFdeUnwind :: [UnwindPoint] -- ^ these unwind points must occur in the same order as they occur -- in the block } instance OutputableP Platform DwarfFrameBlock where pdoc env (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> pdoc env 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 platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs} = let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit "_start") cieEndLabel = mkAsmTempEndLabel cieLabel length = pprAsmLabel platform cieEndLabel <> char '-' <> pprAsmLabel platform cieStartLabel spReg = dwarfGlobalRegNo platform Sp retReg = dwarfReturnRegNo platform wordSize = platformWordSizeInBytes platform pprInit :: (GlobalReg, Maybe UnwindExpr) -> doc pprInit (g, uw) = pprSetUnwind platform g (Nothing, uw) -- Preserve C stack pointer: This necessary to override that default -- unwinding behavior of setting $sp = CFA. preserveSp = case platformArch platform of ArchX86 -> pprByte dW_CFA_same_value $$ pprLEBWord 4 ArchX86_64 -> pprByte dW_CFA_same_value $$ pprLEBWord 7 _ -> empty in vcat [ line (pprAsmLabel platform cieLabel <> colon) , pprData4' length -- Length of CIE , line (pprAsmLabel platform cieStartLabel <> colon) , pprData4' (text "-1") -- Common Information Entry marker (-1 = 0xf..f) , pprByte 3 -- CIE version (we require DWARF 3) , pprByte 0 -- Augmentation (none) , pprByte 1 -- Code offset multiplicator , pprByte (128-fromIntegral wordSize) -- Data offset multiplicator -- (stacks grow down => "-w" in signed LEB128) , pprByte retReg -- virtual register holding return address ] $$ -- Initial unwind table vcat (map pprInit $ Map.toList cieInit) $$ vcat [ -- RET = *CFA pprByte (dW_CFA_offset+retReg) , pprByte 0 -- Preserve C stack pointer , preserveSp -- Sp' = CFA -- (we need to set this manually as our (STG) Sp register is -- often not the architecture's default stack register) , pprByte dW_CFA_val_offset , pprLEBWord (fromIntegral spReg) , pprLEBWord 0 ] $$ wordAlign platform $$ line (pprAsmLabel platform cieEndLabel <> colon) $$ -- Procedure unwind tables vcat (map (pprFrameProc platform cieLabel cieInit) 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 platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks) = let fdeLabel = mkAsmTempDerivedLabel procLbl (fsLit "_fde") fdeEndLabel = mkAsmTempDerivedLabel procLbl (fsLit "_fde_end") procEnd = mkAsmTempProcEndLabel procLbl ifInfo str = if hasInfo then text str else empty -- see Note [Info Offset] in vcat [ whenPprDebug $ line $ text "# Unwinding for" <+> pprAsmLabel platform procLbl <> colon , pprData4' (pprAsmLabel platform fdeEndLabel <> char '-' <> pprAsmLabel platform fdeLabel) , line (pprAsmLabel platform fdeLabel <> colon) , pprData4' (pprAsmLabel platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE , pprWord platform (pprAsmLabel platform procLbl <> ifInfo "-1") -- Code pointer , pprWord platform (pprAsmLabel platform procEnd <> char '-' <> pprAsmLabel platform procLbl <> ifInfo "+1") -- Block byte length ] $$ vcat (S.evalState (mapM (pprFrameBlock platform) blocks) initUw) $$ wordAlign platform $$ line (pprAsmLabel platform fdeEndLabel <> 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 platform (DwarfFrameBlock hasInfo uws0) = vcat <$> zipWithM pprFrameDecl (True : repeat False) uws0 where pprFrameDecl :: Bool -> UnwindPoint -> S.State UnwindTable doc pprFrameDecl firstDecl (UnwindPoint lbl uws) = S.state $ \oldUws -> let -- Did a register's unwind expression change? isChanged :: GlobalReg -> Maybe UnwindExpr -> Maybe (Maybe UnwindExpr, Maybe UnwindExpr) isChanged g new -- the value didn't change | Just new == old = Nothing -- the value was and still is undefined | Nothing <- old , Nothing <- new = Nothing -- the value changed | otherwise = Just (join old, new) where old = Map.lookup g oldUws changed = Map.toList $ Map.mapMaybeWithKey isChanged uws in if oldUws == uws then (empty, oldUws) else let -- see Note [Info Offset] needsOffset = firstDecl && hasInfo lblDoc = pprAsmLabel platform lbl <> if needsOffset then text "-1" else empty doc = pprByte dW_CFA_set_loc $$ pprWord platform lblDoc $$ vcat (map (uncurry $ pprSetUnwind platform) changed) in (doc, 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 p UnwindReturnReg = dwarfReturnRegNo p dwarfGlobalRegNo p reg = maybe 0 (dwarfRegNo p . RegReal) $ globalRegMaybe p 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 plat g (_, Nothing) = pprUndefUnwind plat g pprSetUnwind _ Sp (Just (UwReg s _), Just (UwReg s' o')) | s == s' = if o' >= 0 then pprByte dW_CFA_def_cfa_offset $$ pprLEBWord (fromIntegral o') else pprByte dW_CFA_def_cfa_offset_sf $$ pprLEBInt o' pprSetUnwind plat Sp (_, Just (UwReg s' o')) = if o' >= 0 then pprByte dW_CFA_def_cfa $$ pprLEBRegNo plat s' $$ pprLEBWord (fromIntegral o') else pprByte dW_CFA_def_cfa_sf $$ pprLEBRegNo plat s' $$ pprLEBInt o' pprSetUnwind plat Sp (_, Just uw) = pprByte dW_CFA_def_cfa_expression $$ pprUnwindExpr plat False uw pprSetUnwind plat g (_, Just (UwDeref (UwReg Sp o))) | o < 0 && ((-o) `mod` platformWordSizeInBytes plat) == 0 -- expected case = pprByte (dW_CFA_offset + dwarfGlobalRegNo plat g) $$ pprLEBWord (fromIntegral ((-o) `div` platformWordSizeInBytes plat)) | otherwise = pprByte dW_CFA_offset_extended_sf $$ pprLEBRegNo plat g $$ pprLEBInt o pprSetUnwind plat g (_, Just (UwDeref uw)) = pprByte dW_CFA_expression $$ pprLEBRegNo plat g $$ pprUnwindExpr plat True uw pprSetUnwind plat g (_, Just (UwReg g' 0)) | g == g' = pprByte dW_CFA_same_value $$ pprLEBRegNo plat g pprSetUnwind plat g (_, Just uw) = pprByte dW_CFA_val_expression $$ pprLEBRegNo plat g $$ pprUnwindExpr plat True uw -- | Print the register number of the given 'GlobalReg' as an unsigned LEB128 -- encoded number. pprLEBRegNo :: IsDoc doc => Platform -> GlobalReg -> doc pprLEBRegNo plat = pprLEBWord . fromIntegral . dwarfGlobalRegNo 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 platform spIsCFA expr = let pprE (UwConst i) | i >= 0 && i < 32 = pprByte (dW_OP_lit0 + fromIntegral i) | otherwise = pprByte dW_OP_consts $$ pprLEBInt i -- lazy... pprE (UwReg Sp i) | spIsCFA = if i == 0 then pprByte dW_OP_call_frame_cfa else pprE (UwPlus (UwReg Sp 0) (UwConst i)) pprE (UwReg g i) = pprByte (dW_OP_breg0+dwarfGlobalRegNo platform g) $$ pprLEBInt i pprE (UwDeref u) = pprE u $$ pprByte dW_OP_deref pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pprAsmLabel platform l) pprE (UwPlus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus pprE (UwMinus u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus pprE (UwTimes u1 u2) = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul in line (text "\t.uleb128 2f-1f") $$ -- DW_FORM_block length -- computed as the difference of the following local labels 2: and 1: line (text "1:") $$ pprE expr $$ line (text "2:") -- | Generate code for re-setting the unwind information for a -- register to @undefined@ pprUndefUnwind :: IsDoc doc => Platform -> GlobalReg -> doc pprUndefUnwind plat g = pprByte dW_CFA_undefined $$ pprLEBRegNo plat g -- | Align assembly at (machine) word boundary wordAlign :: IsDoc doc => Platform -> doc wordAlign plat = line $ text "\t.align " <> case platformOS plat of OSDarwin -> case platformWordSize plat of PW8 -> char '3' PW4 -> char '2' _other -> int (platformWordSizeInBytes 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 x = line $ text "\t.byte " <> integer (fromIntegral 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 x = line $ text "\t.short" <+> integer (fromIntegral 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 f = pprByte (if f then 0xff else 0x00) -- | Assembly for 4 bytes of dynamic DWARF data pprData4' :: IsDoc doc => Line doc -> doc pprData4' x = line (text "\t.long " <> 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 = pprData4' . integer . 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 = 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 plat s = line $ case platformWordSize plat of PW4 -> text "\t.long " <> s PW8 -> text "\t.quad " <> 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 x | x < 128 = pprByte (fromIntegral x) | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$ pprLEBWord (x `shiftR` 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 x | x >= -64 && x < 64 = pprByte (fromIntegral (x .&. 127)) | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$ pprLEBInt (x `shiftR` 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' str = line (text "\t.asciz \"" <> str <> char '"') -- | Generate a string constant. We take care to escape the string. pprString :: IsDoc doc => String -> doc pprString str = pprString' $ hcat $ map escapeChar $ if str `lengthIs` utf8EncodedLength str then str else map (chr . fromIntegral) $ BS.unpack $ utf8EncodeByteString str -- | Escape a single non-unicode character escapeChar :: IsLine doc => Char -> doc escapeChar '\\' = text "\\\\" escapeChar '\"' = text "\\\"" escapeChar '\n' = text "\\n" escapeChar c | isAscii c && isPrint c && c /= '?' -- prevents trigraph warnings = char c | otherwise = char '\\' <> char (intToDigit (ch `div` 64)) <> char (intToDigit ((ch `div` 8) `mod` 8)) <> char (intToDigit (ch `mod` 8)) where ch = ord 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 plat target section = case platformOS plat of OSDarwin -> pprDwWord (target <> char '-' <> section) OSMinGW32 -> line (text "\t.secrel32 " <> target) _other -> pprDwWord target {-# SPECIALIZE sectionOffset :: Platform -> SDoc -> SDoc -> SDoc #-} {-# SPECIALIZE sectionOffset :: Platform -> HLine -> HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable