llvmGen: Consider Relocatable read-only data as not constantReferences: #18137

6 files changed, 42 insertions, 13 deletions

diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index 48ffd25f1b..440b6fd9d0 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -12,7 +12,7 @@ module GHC.Cmm (
      CmmBlock, RawCmmDecl,
      Section(..), SectionType(..),
      GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),
-     isSecConstant,
+     SectionProtection(..), sectionProtection,
 
      -- ** Blocks containing lists
      GenBasicBlock(..), blockId,
@@ -185,17 +185,33 @@ data SectionType
   | OtherSection String
   deriving (Show)
 
--- | Should a data in this section be considered constant
-isSecConstant :: Section -> Bool
-isSecConstant (Section t _) = case t of
-    Text                    -> True
-    ReadOnlyData            -> True
-    RelocatableReadOnlyData -> True
-    ReadOnlyData16          -> True
-    CString                 -> True
-    Data                    -> False
-    UninitialisedData       -> False
-    (OtherSection _)        -> False
+data SectionProtection
+  = ReadWriteSection
+  | ReadOnlySection
+  | WriteProtectedSection -- See Note [Relocatable Read-Only Data]
+  deriving (Eq)
+
+-- | Should a data in this section be considered constant at runtime
+sectionProtection :: Section -> SectionProtection
+sectionProtection (Section t _) = case t of
+    Text                    -> ReadOnlySection
+    ReadOnlyData            -> ReadOnlySection
+    RelocatableReadOnlyData -> WriteProtectedSection
+    ReadOnlyData16          -> ReadOnlySection
+    CString                 -> ReadOnlySection
+    Data                    -> ReadWriteSection
+    UninitialisedData       -> ReadWriteSection
+    (OtherSection _)        -> ReadWriteSection
+
+{-
+Note [Relocatable Read-Only Data]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Relocatable data are only read-only after relocation at the start of the
+program. They should be writable from the source code until then. Failure to
+do so would end up in segfaults at execution when using linkers that do not
+enforce writability of those sections, such as the gold linker.
+-}
 
 data Section = Section SectionType CLabel
 
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index f4b8878fe2..d7b3fb05eb 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -129,6 +129,10 @@ pprTop dflags = \case
     pprDataExterns platform lits $$
     pprWordArray dflags (isSecConstant section) lbl lits
   where
+    isSecConstant section = case sectionProtection section of
+      ReadOnlySection -> True
+      WriteProtectedSection -> True
+      _ -> False
     platform = targetPlatform dflags
 
 -- --------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToLlvm/Data.hs b/compiler/GHC/CmmToLlvm/Data.hs
index b8db6ba4ed..aa91621cfd 100644
--- a/compiler/GHC/CmmToLlvm/Data.hs
+++ b/compiler/GHC/CmmToLlvm/Data.hs
@@ -83,7 +83,8 @@ genLlvmData (sec, CmmStaticsRaw lbl xs) = do
                             Section CString _ -> if (platformArch platform == ArchS390X)
                                                     then Just 2 else Just 1
                             _                 -> Nothing
-        const          = if isSecConstant sec then Constant else Global
+        const          = if sectionProtection sec == ReadOnlySection
+                            then Constant else Global
         varDef         = LMGlobalVar label tyAlias link lmsec align const
         globDef        = LMGlobal varDef struct
 
diff --git a/testsuite/tests/codeGen/should_gen_asm/T18137.asm b/testsuite/tests/codeGen/should_gen_asm/T18137.asm
new file mode 100644
index 0000000000..c38e425b94
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/T18137.asm
@@ -0,0 +1 @@
+\.section	\.data\.rel\.ro\.RelocRoData_SomeData_closure_tbl,"aw",(?:%|@)progbits
\ No newline at end of file
diff --git a/testsuite/tests/codeGen/should_gen_asm/T18137.hs b/testsuite/tests/codeGen/should_gen_asm/T18137.hs
new file mode 100644
index 0000000000..f96960ba63
--- /dev/null
+++ b/testsuite/tests/codeGen/should_gen_asm/T18137.hs
@@ -0,0 +1,6 @@
+module RelocRoData
+    ( SomeData(..)
+    )
+where
+
+data SomeData = SomeConstr
diff --git a/testsuite/tests/codeGen/should_gen_asm/all.T b/testsuite/tests/codeGen/should_gen_asm/all.T
index fbacf2b86b..fa3ed1ccf5 100644
--- a/testsuite/tests/codeGen/should_gen_asm/all.T
+++ b/testsuite/tests/codeGen/should_gen_asm/all.T
@@ -9,3 +9,4 @@ test('memcpy-unroll-conprop', is_amd64_codegen, compile_cmp_asm, ['cmm', ''])
 test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', ''])
 test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
 test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
+test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections'])