Commit 36df0988 authored by Peter Wortmann's avatar Peter Wortmann Committed by Austin Seipp

Dwarf generation fixed pt 2

- Don't bracket HsTick expression uneccessarily
- Generate debug information in UTF8
- Reduce amount of information generated - we do not currently need
  block information, for example.

Special thanks to slyfox for the reports!
parent c9532f81
......@@ -665,7 +665,7 @@ ppr_expr (HsStatic e)
ppr_expr (HsTick tickish exp)
= pprTicks (ppr exp) $
ppr tickish <+> ppr exp
ppr tickish <+> ppr_lexpr exp
ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
= pprTicks (ppr exp) $
hcat [ptext (sLit "bintick<"),
......
......@@ -33,7 +33,10 @@ dwarfGen :: DynFlags -> ModLocation -> UniqSupply -> [DebugBlock]
dwarfGen df modLoc us blocks = do
-- Convert debug data structures to DWARF info records
let procs = debugSplitProcs blocks
-- We strip out block information, as it is not currently useful for
-- anything. In future we might want to only do this for -g1.
let procs = map stripBlocks $ debugSplitProcs blocks
stripBlocks dbg = dbg { dblBlocks = [] }
compPath <- getCurrentDirectory
let dwarfUnit = DwarfCompileUnit
{ dwChildren = map (procToDwarf df) procs
......
......@@ -41,7 +41,7 @@ dW_TAG_arg_variable = 257
-- | Dwarf attributes
dW_AT_name, dW_AT_stmt_list, dW_AT_low_pc, dW_AT_high_pc, dW_AT_language,
dW_AT_comp_dir, dW_AT_producer, dW_AT_external, dW_AT_frame_base,
dW_AT_MIPS_linkage_name :: Word
dW_AT_use_UTF8, dW_AT_MIPS_linkage_name :: Word
dW_AT_name = 0x03
dW_AT_stmt_list = 0x10
dW_AT_low_pc = 0x11
......@@ -51,6 +51,7 @@ dW_AT_comp_dir = 0x1b
dW_AT_producer = 0x25
dW_AT_external = 0x3f
dW_AT_frame_base = 0x40
dW_AT_use_UTF8 = 0x53
dW_AT_MIPS_linkage_name = 0x2007
-- | Abbrev declaration
......
......@@ -21,6 +21,7 @@ module Dwarf.Types
import Debug
import CLabel
import CmmExpr ( GlobalReg(..) )
import Encoding
import FastString
import Outputable
import Platform
......@@ -79,6 +80,7 @@ pprAbbrevDecls haveDebugLine =
, (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)
] ++
(if haveDebugLine
then [ (dW_AT_stmt_list, dW_FORM_data4) ]
......@@ -115,6 +117,7 @@ pprDwarfInfoOpen haveSrc (DwarfCompileUnit _ name producer compDir lineLbl) =
$$ pprString producer
$$ pprData4 dW_LANG_Haskell
$$ pprString compDir
$$ pprFlag True -- use UTF8
$$ if haveSrc
then pprData4' (sectionOffset lineLbl dwarfLineLabel)
else empty
......@@ -406,19 +409,25 @@ pprString' str = ptext (sLit "\t.asciz \"") <> str <> char '"'
-- | Generate a string constant. We take care to escape the string.
pprString :: String -> SDoc
pprString = pprString' . hcat . map escape
where escape '\\' = ptext (sLit "\\\\")
escape '\"' = ptext (sLit "\\\"")
escape '\n' = ptext (sLit "\\n")
escape c | isAscii c && isPrint c && c /= '?'
-- escaping '?' prevents trigraph warnings
= char c
| otherwise
= let ch = ord c
in char '\\' <>
char (intToDigit (ch `div` 64)) <>
char (intToDigit ((ch `div` 8) `mod` 8)) <>
char (intToDigit (ch `mod` 8))
pprString str
= pprString' $ hcat $ map escapeChar $
if utf8EncodedLength str == length str
then str
else map (chr . fromIntegral) $ bytesFS $ mkFastString str
-- | Escape a single non-unicode character
escapeChar :: Char -> SDoc
escapeChar '\\' = ptext (sLit "\\\\")
escapeChar '\"' = ptext (sLit "\\\"")
escapeChar '\n' = ptext (sLit "\\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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment