Use correct section types syntax for architecture

Previously GHC would always assume that section types began with `@` while
producing assembly, which is not true. For instance, in ARM assembly syntax
section types begin with `%`. This abstracts out section type pretty-printing
and adjusts it to correctly account for the target architectures assembly
flavor.

Reviewers: austin, hvr, Phyx

Reviewed By: Phyx

Subscribers: Phyx, rwbarton, thomie, erikd

GHC Trac Issues: #13937

Differential Revision: https://phabricator.haskell.org/D3712

8 files changed, 47 insertions, 19 deletions

diff --git a/aclocal.m4 b/aclocal.m4
index c31c881466..71a874fa78 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -321,9 +321,18 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS],
     dnl so we empty CFLAGS while running this test
     CFLAGS2="$CFLAGS"
     CFLAGS=
+    case $TargetArch in
+      arm)
+        dnl See #13937.
+        progbits="%progbits"
+        ;;
+      *)
+        progbits="@progbits"
+        ;;
+    esac
     AC_MSG_CHECKING(for GNU non-executable stack support)
     AC_COMPILE_IFELSE(
-        [AC_LANG_PROGRAM([__asm__ (".section .note.GNU-stack,\"\",@progbits");], [0])],
+        [AC_LANG_PROGRAM([__asm__ (".section .note.GNU-stack,\"\",$progbits");], [0])],
         [AC_MSG_RESULT(yes)
          HaskellHaveGnuNonexecStack=True],
         [AC_MSG_RESULT(no)
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 1427a51bac..f40c8baed6 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -170,6 +170,7 @@ Library
         NameShape
         RnModIface
         Avail
+        AsmUtils
         BasicTypes
         ConLike
         DataCon
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index ad0e0c8c8a..a6873fb640 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -35,6 +35,7 @@ module DriverPipeline (
 
 #include "HsVersions.h"
 
+import AsmUtils
 import PipelineMonad
 import Packages
 import HeaderInfo
@@ -1714,14 +1715,15 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do
   where
     link_opts info = hcat [
       -- "link info" section (see Note [LinkInfo section])
-      makeElfNote dflags ghcLinkInfoSectionName ghcLinkInfoNoteName 0 info,
+      makeElfNote ghcLinkInfoSectionName ghcLinkInfoNoteName 0 info,
 
       -- ALL generated assembly must have this section to disable
       -- executable stacks.  See also
       -- compiler/nativeGen/AsmCodeGen.hs for another instance
       -- where we need to do this.
       if platformHasGnuNonexecStack (targetPlatform dflags)
-        then text ".section .note.GNU-stack,\"\",@progbits\n"
+        then text ".section .note.GNU-stack,\"\","
+             <> sectionType "progbits" <> char '\n'
         else Outputable.empty
       ]
 
diff --git a/compiler/main/Elf.hs b/compiler/main/Elf.hs
index 50f11a72a8..599d4d9160 100644
--- a/compiler/main/Elf.hs
+++ b/compiler/main/Elf.hs
@@ -14,9 +14,9 @@ module Elf (
     makeElfNote
   ) where
 
+import AsmUtils
 import Exception
 import DynFlags
-import Platform
 import ErrUtils
 import Maybes     (MaybeT(..),runMaybeT)
 import Util       (charToC)
@@ -415,12 +415,12 @@ readElfNoteAsString dflags path sectionName noteId = action `catchIO`  \_ -> do
 -- If we add new target platforms, we need to check that the generated words
 -- are 32-bit long, otherwise we need to use platform specific directives to
 -- force 32-bit .int in asWord32.
-makeElfNote :: DynFlags -> String -> String -> Word32 -> String -> SDoc
-makeElfNote dflags sectionName noteName typ contents = hcat [
+makeElfNote :: String -> String -> Word32 -> String -> SDoc
+makeElfNote sectionName noteName typ contents = hcat [
     text "\t.section ",
     text sectionName,
     text ",\"\",",
-    text elfSectionNote,
+    sectionType "note",
     text "\n",
 
     -- note name length (+ 1 for ending \0)
@@ -453,12 +453,6 @@ makeElfNote dflags sectionName noteName typ contents = hcat [
       text (show x),
       text "\n"]
 
-    elfSectionNote :: String
-    elfSectionNote = case platformArch (targetPlatform dflags) of
-                             ArchARM _ _ _ -> "%note"
-                             _             -> "@note"
-
-
 
 ------------------
 -- Helpers
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index e7a3efdfbe..45d170e28d 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -51,6 +51,7 @@ import qualified RegAlloc.Graph.Main            as Color
 import qualified RegAlloc.Graph.Stats           as Color
 import qualified RegAlloc.Graph.TrivColorable   as Color
 
+import AsmUtils
 import TargetReg
 import Platform
 import Config
@@ -770,7 +771,7 @@ makeImportsDoc dflags imports
                 -- security. GHC generated code does not need an executable
                 -- stack so add the note in:
             (if platformHasGnuNonexecStack platform
-             then text ".section .note.GNU-stack,\"\",@progbits"
+             then text ".section .note.GNU-stack,\"\"," <> sectionType "progbits"
              else Outputable.empty)
             $$
                 -- And just because every other compiler does, let's stick in
diff --git a/compiler/nativeGen/Dwarf/Constants.hs b/compiler/nativeGen/Dwarf/Constants.hs
index 880c7d77a0..a8034ef295 100644
--- a/compiler/nativeGen/Dwarf/Constants.hs
+++ b/compiler/nativeGen/Dwarf/Constants.hs
@@ -3,6 +3,7 @@
 
 module Dwarf.Constants where
 
+import AsmUtils
 import FastString
 import Platform
 import Outputable
@@ -150,14 +151,15 @@ dwarfGhcSection     = dwarfSection "ghc"
 dwarfARangesSection = dwarfSection "aranges"
 
 dwarfSection :: String -> SDoc
-dwarfSection name = sdocWithPlatform $ \plat -> ftext $ mkFastString $
+dwarfSection name = sdocWithPlatform $ \plat ->
   case platformOS plat of
     os | osElfTarget os
-       -> "\t.section .debug_" ++ name ++ ",\"\",@progbits"
+       -> text "\t.section .debug_" <> text name <> text ",\"\","
+          <> sectionType "progbits"
        | osMachOTarget os
-       -> "\t.section __DWARF,__debug_" ++ name ++ ",regular,debug"
+       -> text "\t.section __DWARF,__debug_" <> text name <> text ",regular,debug"
        | otherwise
-       -> "\t.section .debug_" ++ name ++ ",\"dr\""
+       -> text "\t.section .debug_" <> text name <> text ",\"dr\""
 
 -- * Dwarf section labels
 dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: LitString
diff --git a/compiler/nativeGen/PprBase.hs b/compiler/nativeGen/PprBase.hs
index 76ac13ef4b..aca427449d 100644
--- a/compiler/nativeGen/PprBase.hs
+++ b/compiler/nativeGen/PprBase.hs
@@ -16,6 +16,7 @@ module PprBase (
 
 where
 
+import AsmUtils
 import CLabel
 import Cmm
 import DynFlags
@@ -131,7 +132,7 @@ pprGNUSectionHeader sep t suffix = sdocWithDynFlags $ \dflags ->
       CString
         | OSMinGW32 <- platformOS (targetPlatform dflags)
                     -> empty
-        | otherwise -> text ",\"aMS\",@progbits,1"
+        | otherwise -> text ",\"aMS\"," <> sectionType "progbits" <> text ",1"
       _ -> empty
 
 -- XCOFF doesn't support relocating label-differences, so we place all
diff --git a/compiler/utils/AsmUtils.hs b/compiler/utils/AsmUtils.hs
new file mode 100644
index 0000000000..55f9d6d551
--- /dev/null
+++ b/compiler/utils/AsmUtils.hs
@@ -0,0 +1,18 @@
+-- | Various utilities used in generating assembler.
+--
+-- These are used not only by the native code generator, but also by the
+-- "DriverPipeline".
+module AsmUtils
+    ( sectionType
+    ) where
+
+import Platform
+import Outputable
+
+-- | Generate a section type (e.g. @\@progbits@). See #13937.
+sectionType :: String -- ^ section type
+            -> SDoc   -- ^ pretty assembler fragment
+sectionType ty = sdocWithPlatform $ \platform ->
+    case platformArch platform of
+      ArchARM{} -> char '%' <> text ty
+      _         -> char '@' <> text ty