diff options
| -rw-r--r-- | compiler/cmm/CmmNode.hs | 11 | ||||
| -rw-r--r-- | compiler/nativeGen/Dwarf.hs | 4 | ||||
| -rw-r--r-- | compiler/nativeGen/Dwarf/Types.hs | 18 |
3 files changed, 25 insertions, 8 deletions
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index b405360e87..0f26d377b1 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -660,6 +660,8 @@ instance Ord CmmTickScope where instance Outputable CmmTickScope where ppr GlobalScope = text "global" + ppr (SubScope us GlobalScope) + = ppr us ppr (SubScope us s) = ppr s <> char '/' <> ppr us ppr combined = parens $ hcat $ punctuate (char '+') $ map (hcat . punctuate (char '/') . map ppr . reverse) $ @@ -675,10 +677,11 @@ isTickSubScope = cmp cmp s (CombinedScope s1' s2') = cmp s s1' || cmp s s2' cmp (SubScope u s) s'@(SubScope u' _) = u == u' || cmp s s' --- | Combine two tick scopes. This smart constructor will catch cases --- where one tick scope is a sub-scope of the other already. +-- | Combine two tick scopes. The new scope should be sub-scope of +-- both parameters. We simplfy automatically if one tick scope is a +-- sub-scope of the other already. combineTickScopes :: CmmTickScope -> CmmTickScope -> CmmTickScope combineTickScopes s1 s2 - | s1 `isTickSubScope` s2 = s2 - | s2 `isTickSubScope` s1 = s1 + | s1 `isTickSubScope` s2 = s1 + | s2 `isTickSubScope` s1 = s2 | otherwise = CombinedScope s1 s2 diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs index 4f9bdb64af..70fca4fdb7 100644 --- a/compiler/nativeGen/Dwarf.hs +++ b/compiler/nativeGen/Dwarf.hs @@ -83,8 +83,8 @@ compileUnitHeader unitU = sdocWithPlatform $ \plat -> in vcat [ ptext (sLit "\t.long ") <> length -- compilation unit size , ppr cuLabel <> colon , ptext (sLit "\t.word 3") -- DWARF version - , pprDwWord (ptext dwarfAbbrevLabel <> char '-' <> - ptext dwarfAbbrevLabel) -- pointer to our abbrevs + , pprDwWord (sectionOffset dwarfAbbrevLabel dwarfAbbrevLabel) + -- abbrevs offset , ptext (sLit "\t.byte ") <> ppr (platformWordSize plat) -- word size ] diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs index 96fea0ab90..47e0bd1265 100644 --- a/compiler/nativeGen/Dwarf/Types.hs +++ b/compiler/nativeGen/Dwarf/Types.hs @@ -14,6 +14,7 @@ module Dwarf.Types , pprLEBWord , pprLEBInt , wordAlign + , sectionOffset ) where @@ -94,7 +95,9 @@ pprAbbrevDecls haveDebugLine = [ (dW_AT_name, dW_FORM_string) , (dW_AT_low_pc, dW_FORM_addr) , (dW_AT_high_pc, dW_FORM_addr) - ] + ] $$ + pprByte 0 + -- | Generate assembly for DWARF data pprDwarfInfo :: Bool -> DwarfInfo -> SDoc pprDwarfInfo haveSrc d @@ -113,7 +116,7 @@ pprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lineLbl) = $$ pprData4 dW_LANG_Haskell $$ pprString compDir $$ if haveSrc - then pprData4' (ptext lineLbl <> char '-' <> ptext dwarfLineLabel) + then pprData4' (sectionOffset lineLbl dwarfLineLabel) else empty pprDwarfInfoOpen _ (DwarfSubprogram _ name label) = sdocWithDynFlags $ \df -> pprAbbrev DwAbbrSubprogram @@ -416,3 +419,14 @@ pprString = pprString' . hcat . map escape char (intToDigit (ch `div` 64)) <> char (intToDigit ((ch `div` 8) `mod` 8)) <> char (intToDigit (ch `mod` 8)) + +-- | 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. Meanwhile, +-- GNU tools expect us to just reference the target directly, and will +-- figure out on their own that we actually need an offset. +sectionOffset :: LitString -> LitString -> SDoc +sectionOffset target section = sdocWithPlatform $ \plat -> + case platformOS plat of + OSDarwin -> ptext target <> char '-' <> ptext section + _other -> ptext target |