compiler/cmm/PprC.hs: constify labels in .rodata

Consider one-line module
    module B (v) where v = "hello"
in -fvia-C mode it generates code like
    static char gibberish_str[] = "hello";

It resides in data section (precious resource on ia64!).
The patch switches genrator to emit:
    static const char gibberish_str[] = "hello";

Other types if symbols that gained 'const' qualifier are:

- info tables (from haskell and CMM)
- static reference tables (from haskell and CMM)

Cleanups along the way:

- fixed info tables defined in .cmm to reside in .rodata
- split out closure declaration into 'IC_' / 'EC_'
- added label declaration (based on label type) right before
  each label definition (based on section type) so that C
  compiler could check if declaration and definition matches
  at definition site.

Signed-off-by: Sergei Trofimovich <slyfox@gentoo.org>

Test Plan: ran testsuite on unregisterised x86_64 compiler

Reviewers: simonmar, ezyang, austin, bgamari, erikd

Reviewed By: bgamari, erikd

Subscribers: rwbarton, thomie

GHC Trac Issues: #8996

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

1 files changed, 40 insertions, 22 deletions

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 56de94079f..21ed6f6516 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -83,12 +83,13 @@ pprC tops = vcat $ intersperse blankLine $ map pprTop tops
 -- top level procs
 --
 pprTop :: RawCmmDecl -> SDoc
-pprTop (CmmProc infos clbl _ graph) =
+pprTop (CmmProc infos clbl _in_live_regs graph) =
 
     (case mapLookup (g_entry graph) infos of
        Nothing -> empty
-       Just (Statics info_clbl info_dat) -> pprDataExterns info_dat $$
-                                            pprWordArray info_clbl info_dat) $$
+       Just (Statics info_clbl info_dat) ->
+           pprDataExterns info_dat $$
+           pprWordArray info_is_in_rodata info_clbl info_dat) $$
     (vcat [
            blankLine,
            extern_decls,
@@ -99,6 +100,8 @@ pprTop (CmmProc infos clbl _ graph) =
            rbrace ]
     )
   where
+        -- info tables are always in .rodata
+        info_is_in_rodata = True
         blocks = toBlockListEntryFirst graph
         (temp_decls, extern_decls) = pprTempAndExternDecls blocks
 
@@ -107,21 +110,23 @@ pprTop (CmmProc infos clbl _ graph) =
 
 -- We only handle (a) arrays of word-sized things and (b) strings.
 
-pprTop (CmmData _section (Statics lbl [CmmString str])) =
+pprTop (CmmData section (Statics lbl [CmmString str])) =
+  pprExternDecl lbl $$
   hcat [
-    pprLocalness lbl, text "char ", ppr lbl,
+    pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl,
     text "[] = ", pprStringInCStyle str, semi
   ]
 
-pprTop (CmmData _section (Statics lbl [CmmUninitialised size])) =
+pprTop (CmmData section (Statics lbl [CmmUninitialised size])) =
+  pprExternDecl lbl $$
   hcat [
-    pprLocalness lbl, text "char ", ppr lbl,
+    pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl,
     brackets (int size), semi
   ]
 
-pprTop (CmmData _section (Statics lbl lits)) =
+pprTop (CmmData section (Statics lbl lits)) =
   pprDataExterns lits $$
-  pprWordArray lbl lits
+  pprWordArray (isSecConstant section) lbl lits
 
 -- --------------------------------------------------------------------------
 -- BasicBlocks are self-contained entities: they always end in a jump.
@@ -141,10 +146,12 @@ pprBBlock block =
 -- Info tables. Just arrays of words.
 -- See codeGen/ClosureInfo, and nativeGen/PprMach
 
-pprWordArray :: CLabel -> [CmmStatic] -> SDoc
-pprWordArray lbl ds
+pprWordArray :: Bool -> CLabel -> [CmmStatic] -> SDoc
+pprWordArray is_ro lbl ds
   = sdocWithDynFlags $ \dflags ->
-    hcat [ pprLocalness lbl, text "StgWord"
+    -- TODO: align closures only
+    pprExternDecl lbl $$
+    hcat [ pprLocalness lbl, pprConstness is_ro, text "StgWord"
          , space, ppr lbl, text "[]"
          -- See Note [StgWord alignment]
          , pprAlignment (wordWidth dflags)
@@ -180,6 +187,10 @@ pprLocalness :: CLabel -> SDoc
 pprLocalness lbl | not $ externallyVisibleCLabel lbl = text "static "
                  | otherwise = empty
 
+pprConstness :: Bool -> SDoc
+pprConstness is_ro | is_ro = text "const "
+                   | otherwise = empty
+
 -- --------------------------------------------------------------------------
 -- Statements.
 --
@@ -984,31 +995,38 @@ is_cishCC JavaScriptCallConv = False
 pprTempAndExternDecls :: [CmmBlock] -> (SDoc{-temps-}, SDoc{-externs-})
 pprTempAndExternDecls stmts
   = (pprUFM (getUniqSet temps) (vcat . map pprTempDecl),
-     vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls)))
+     vcat (map pprExternDecl (Map.keys lbls)))
   where (temps, lbls) = runTE (mapM_ te_BB stmts)
 
 pprDataExterns :: [CmmStatic] -> SDoc
 pprDataExterns statics
-  = vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls))
+  = vcat (map pprExternDecl (Map.keys lbls))
   where (_, lbls) = runTE (mapM_ te_Static statics)
 
 pprTempDecl :: LocalReg -> SDoc
 pprTempDecl l@(LocalReg _ rep)
   = hcat [ machRepCType rep, space, pprLocalReg l, semi ]
 
-pprExternDecl :: Bool -> CLabel -> SDoc
-pprExternDecl _in_srt lbl
+pprExternDecl :: CLabel -> SDoc
+pprExternDecl lbl
   -- do not print anything for "known external" things
   | not (needsCDecl lbl) = empty
   | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz
   | otherwise =
-        hcat [ visibility, label_type lbl,
-               lparen, ppr lbl, text ");" ]
+        hcat [ visibility, label_type lbl , lparen, ppr lbl, text ");"
+             -- occasionally useful to see label type
+             -- , text "/* ", pprDebugCLabel lbl, text " */"
+             ]
  where
-  label_type lbl | isBytesLabel lbl     = text "B_"
-                 | isForeignLabel lbl && isCFunctionLabel lbl = text "FF_"
-                 | isCFunctionLabel lbl = text "F_"
-                 | otherwise            = text "I_"
+  label_type lbl | isBytesLabel lbl         = text "B_"
+                 | isForeignLabel lbl && isCFunctionLabel lbl
+                                            = text "FF_"
+                 | isCFunctionLabel lbl     = text "F_"
+                 | isStaticClosureLabel lbl = text "C_"
+                 -- generic .rodata labels
+                 | isSomeRODataLabel lbl    = text "RO_"
+                 -- generic .data labels (common case)
+                 | otherwise                = text "RW_"
 
   visibility
      | externallyVisibleCLabel lbl = char 'E'