Generate DWARF info section

This is where we actually make GHC emit DWARF code. The info section
contains all the general meta information bits as well as an entry for
every block of native code.

Notes:

* We need quite a few new labels in order to properly address starts
  and ends of blocks.

* Thanks to Nathan Howell for taking the iniative to get our own Haskell
  language ID for DWARF!

(From Phabricator D396)

1 files changed, 23 insertions, 7 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 37b8ada75b..603f2130e0 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -44,6 +44,8 @@ module CLabel (
         mkStringLitLabel,
 
         mkAsmTempLabel,
+        mkAsmTempDerivedLabel,
+        mkAsmTempEndLabel,
 
         mkPlainModuleInitLabel,
 
@@ -99,7 +101,7 @@ module CLabel (
         mkHpcTicksLabel,
 
         hasCAF,
-        needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
+        needsCDecl, maybeAsmTemp, externallyVisibleCLabel,
         isMathFun,
         isCFunctionLabel, isGcPtrLabel, labelDynamic,
 
@@ -123,6 +125,7 @@ import FastString
 import DynFlags
 import Platform
 import UniqSet
+import PprCore ( {- instances -} )
 
 -- -----------------------------------------------------------------------------
 -- The CLabel type
@@ -190,6 +193,10 @@ data CLabel
   | AsmTempLabel
         {-# UNPACK #-} !Unique
 
+  | AsmTempDerivedLabel
+        CLabel
+        FastString              -- suffix
+
   | StringLitLabel
         {-# UNPACK #-} !Unique
 
@@ -547,6 +554,11 @@ mkStringLitLabel                = StringLitLabel
 mkAsmTempLabel :: Uniquable a => a -> CLabel
 mkAsmTempLabel a                = AsmTempLabel (getUnique a)
 
+mkAsmTempDerivedLabel :: CLabel -> FastString -> CLabel
+mkAsmTempDerivedLabel = AsmTempDerivedLabel
+
+mkAsmTempEndLabel :: CLabel -> CLabel
+mkAsmTempEndLabel l = mkAsmTempDerivedLabel l (fsLit "_end")
 mkPlainModuleInitLabel :: Module -> CLabel
 mkPlainModuleInitLabel mod      = PlainModuleInitLabel mod
 
@@ -634,6 +646,7 @@ needsCDecl (PlainModuleInitLabel _)     = True
 
 needsCDecl (StringLitLabel _)           = False
 needsCDecl (AsmTempLabel _)             = False
+needsCDecl (AsmTempDerivedLabel _ _)    = False
 needsCDecl (RtsLabel _)                 = False
 
 needsCDecl (CmmLabel pkgId _ _)
@@ -652,12 +665,6 @@ needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
 needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
 needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
 
--- | Check whether a label is a local temporary for native code generation
-isAsmTemp  :: CLabel -> Bool
-isAsmTemp (AsmTempLabel _)              = True
-isAsmTemp _                             = False
-
-
 -- | If a label is a local temporary used for native code generation
 --      then return just its unique, otherwise nothing.
 maybeAsmTemp :: CLabel -> Maybe Unique
@@ -763,6 +770,7 @@ externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 externallyVisibleCLabel (CaseLabel _ _)         = False
 externallyVisibleCLabel (StringLitLabel _)      = False
 externallyVisibleCLabel (AsmTempLabel _)        = False
+externallyVisibleCLabel (AsmTempDerivedLabel _ _)= False
 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 externallyVisibleCLabel (RtsLabel _)            = True
 externallyVisibleCLabel (CmmLabel _ _ _)        = True
@@ -982,6 +990,13 @@ pprCLabel platform (AsmTempLabel u)
      else
         char '_' <> pprUnique u
 
+pprCLabel platform (AsmTempDerivedLabel l suf)
+ | cGhcWithNativeCodeGen == "YES"
+   = ptext (asmTempLabelPrefix platform)
+     <> case l of AsmTempLabel u -> pprUnique u
+                  _other         -> pprCLabel platform l
+     <> ftext suf
+
 pprCLabel platform (DynamicLinkerLabel info lbl)
  | cGhcWithNativeCodeGen == "YES"
    = pprDynamicLinkerAsmLabel platform info lbl
@@ -1107,6 +1122,7 @@ pprCLbl (HpcTicksLabel mod)
   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 
 pprCLbl (AsmTempLabel {})       = panic "pprCLbl AsmTempLabel"
+pprCLbl (AsmTempDerivedLabel {})= panic "pprCLbl AsmTempDerivedLabel"
 pprCLbl (DynamicLinkerLabel {}) = panic "pprCLbl DynamicLinkerLabel"
 pprCLbl (PicBaseLabel {})       = panic "pprCLbl PicBaseLabel"
 pprCLbl (DeadStripPreventer {}) = panic "pprCLbl DeadStripPreventer"