Generate .loc/.file directives from source ticks

This generates DWARF, albeit indirectly using the assembler. This is
the easiest (and, apparently, quite standard) method of generating the
.debug_line DWARF section.

Notes:

* Note we have to make sure that .file directives appear correctly
  before the respective .loc. Right now we ppr them manually, which makes
  them absent from dumps. Fixing this would require .file to become a
  native instruction.

* We have to pass a lot of things around the native code generator. I
  know Ian did quite a bit of refactoring already, but having one common
  monad could *really* simplify things here...

* To support SplitObjcs, we need to emit/reset all DWARF data at every
  split. We use the occassion to move split marker generation to
  cmmNativeGenStream as well, so debug data extraction doesn't have to
  choke on it.

(From Phabricator D396)

3 files changed, 23 insertions, 1 deletions

diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 86d4b17abe..531213dc7f 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -31,6 +31,7 @@ import X86.Regs
 import X86.RegInfo
 import CodeGen.Platform
 import CPrim
+import Debug            ( DebugBlock(..) )
 import Instruction
 import PIC
 import NCGMonad
@@ -47,6 +48,8 @@ import CmmUtils
 import Cmm
 import Hoopl
 import CLabel
+import CoreSyn          ( Tickish(..) )
+import SrcLoc           ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 
 -- The rest:
 import ForeignCall      ( CCallConv(..) )
@@ -114,9 +117,17 @@ basicBlockCodeGen block = do
   let (_, nodes, tail)  = blockSplit block
       id = entryLabel block
       stmts = blockToList nodes
+  -- Generate location directive
+  dbg <- getDebugBlock (entryLabel block)
+  loc_instrs <- case dblSourceTick =<< dbg of
+    Just (SourceNote span name)
+      -> do fileId <- getFileId (srcSpanFile span)
+            let line = srcSpanStartLine span; col = srcSpanStartCol span
+            return $ unitOL $ LOCATION fileId line col name
+    _ -> return nilOL
   mid_instrs <- stmtsToInstrs stmts
   tail_instrs <- stmtToInstrs tail
-  let instrs = mid_instrs `appOL` tail_instrs
+  let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs
   -- code generation may introduce new basic block boundaries, which
   -- are indicated by the NEWBLOCK instruction.  We must split up the
   -- instruction stream into basic blocks again.  Also, we extract
diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs
index 0d85376868..8677badb02 100644
--- a/compiler/nativeGen/X86/Instr.hs
+++ b/compiler/nativeGen/X86/Instr.hs
@@ -165,6 +165,9 @@ data Instr
         -- comment pseudo-op
         = COMMENT FastString
 
+        -- location pseudo-op (file, line, col, name)
+        | LOCATION Int Int Int String
+
         -- some static data spat out during code
         -- generation.  Will be extracted before
         -- pretty-printing.
@@ -444,6 +447,7 @@ x86_regUsageOfInstr platform instr
     FETCHPC  reg        -> mkRU [] [reg]
 
     COMMENT _           -> noUsage
+    LOCATION{}          -> noUsage
     DELTA   _           -> noUsage
 
     POPCNT _ src dst -> mkRU (use_R src []) [dst]
@@ -616,6 +620,7 @@ x86_patchRegsOfInstr instr env
 
     NOP                 -> instr
     COMMENT _           -> instr
+    LOCATION {}         -> instr
     DELTA _             -> instr
 
     JXX _ _             -> instr
@@ -776,6 +781,7 @@ x86_isMetaInstr
 x86_isMetaInstr instr
  = case instr of
         COMMENT{}       -> True
+        LOCATION{}      -> True
         LDATA{}         -> True
         NEWBLOCK{}      -> True
         DELTA{}         -> True
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index ddd75c83f6..5b4eccd845 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -490,6 +490,11 @@ pprInstr (COMMENT _) = empty -- nuke 'em
 {-
 pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s
 -}
+
+pprInstr (LOCATION file line col name)
+   = ptext (sLit "\t.loc ") <> ppr file <+> ppr line <+> ppr col <>
+     ptext (sLit " /* ") <> text name <> ptext (sLit " */")
+
 pprInstr (DELTA d)
    = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))