calculate
/
gentoo-overlay
4
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '89e1e6db50'
${ noResults }
gentoo-overlay/dev-lang/ghc/files/ghc-8.2.1_rc1-cgen-constify...

379 lines
14 KiB
Raw Blame History

From 7e00046772e053c63ac93630a60b0f396e32a2d7 Mon Sep 17 00:00:00 2001
From: Sergei Trofimovich <slyfox@gentoo.org>
Date: Sun, 16 Apr 2017 10:43:38 +0100
Subject: [PATCH] compiler/cmm/PprC.hs: constify labels in .rodata
Summary:
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
Subscribers: rwbarton, thomie
GHC Trac Issues: #8996
Differential Revision: https://phabricator.haskell.org/D3481
---
compiler/cmm/CLabel.hs | 24 ++++++++++++++
compiler/cmm/Cmm.hs | 13 ++++++++
compiler/cmm/CmmInfo.hs | 2 +-
compiler/cmm/PprC.hs | 62 +++++++++++++++++++++++-------------
compiler/llvmGen/LlvmCodeGen/Data.hs | 12 -------
includes/Stg.h | 22 +++++++++----
includes/rts/storage/InfoTables.h | 2 +-
includes/stg/MiscClosures.h | 14 ++++----
8 files changed, 102 insertions(+), 49 deletions(-)
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 3ba4f7647a..62c8037e9c 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -89,6 +89,8 @@ module CLabel (
foreignLabelStdcallInfo,
isBytesLabel,
isForeignLabel,
+ isSomeRODataLabel,
+ isStaticClosureLabel,
mkCCLabel, mkCCSLabel,
DynamicLinkerLabelInfo(..),
@@ -575,6 +577,28 @@ isForeignLabel :: CLabel -> Bool
isForeignLabel (ForeignLabel _ _ _ _) = True
isForeignLabel _lbl = False
+-- | Whether label is a static closure label (can come from haskell or cmm)
+isStaticClosureLabel :: CLabel -> Bool
+-- Closure defined in haskell (.hs)
+isStaticClosureLabel (IdLabel _ _ Closure) = True
+-- Closure defined in cmm
+isStaticClosureLabel (CmmLabel _ _ CmmClosure) = True
+isStaticClosureLabel _lbl = False
+
+-- | Whether label is a .rodata label
+isSomeRODataLabel :: CLabel -> Bool
+-- info table defined in haskell (.hs)
+isSomeRODataLabel (IdLabel _ _ ClosureTable) = True
+isSomeRODataLabel (IdLabel _ _ ConInfoTable) = True
+isSomeRODataLabel (IdLabel _ _ InfoTable) = True
+isSomeRODataLabel (IdLabel _ _ LocalInfoTable) = True
+-- static reference tables defined in haskell (.hs)
+isSomeRODataLabel (IdLabel _ _ SRT) = True
+isSomeRODataLabel (SRTLabel _) = True
+-- info table defined in cmm (.cmm)
+isSomeRODataLabel (CmmLabel _ _ CmmInfo) = True
+isSomeRODataLabel _lbl = False
+
-- | Get the label size field from a ForeignLabel
foreignLabelStdcallInfo :: CLabel -> Maybe Int
foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index d2ee531686..bab20f3fdd 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -9,6 +9,7 @@ module Cmm (
CmmBlock,
RawCmmDecl, RawCmmGroup,
Section(..), SectionType(..), CmmStatics(..), CmmStatic(..),
+ isSecConstant,
-- ** Blocks containing lists
GenBasicBlock(..), blockId,
@@ -167,6 +168,18 @@ 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 Section = Section SectionType CLabel
data CmmStatic
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index b5e800a977..35e3a1888d 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -133,7 +133,7 @@ mkInfoTable dflags proc@(CmmProc infos entry_lbl live blocks)
--
return (top_decls ++
[CmmProc mapEmpty entry_lbl live blocks,
- mkDataLits (Section Data info_lbl) info_lbl
+ mkRODataLits info_lbl
(CmmLabel entry_lbl : rel_std_info ++ rel_extra_bits)])
--
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'
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 9bb5a75bda..adb86d312d 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -56,18 +56,6 @@ genLlvmData (sec, Statics lbl xs) = do
return ([globDef], [tyAlias])
--- | 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
-
-- | Format the section type part of a Cmm Section
llvmSectionType :: Platform -> SectionType -> FastString
llvmSectionType p t = case t of
diff --git a/includes/Stg.h b/includes/Stg.h
index 619984d8e5..b1b3190307 100644
--- a/includes/Stg.h
+++ b/includes/Stg.h
@@ -223,13 +223,23 @@ typedef StgInt I_;
typedef StgWord StgWordArray[];
typedef StgFunPtr F_;
-#define EB_(X) extern char X[]
-#define IB_(X) static char X[]
-#define EI_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8))
-#define II_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (8))
+/* byte arrays (and strings): */
+#define EB_(X) extern const char X[]
+#define IB_(X) static const char X[]
+/* static (non-heap) closures (requires alignment for pointer tagging): */
+#define EC_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8))
+#define IC_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (8))
+/* writable data (does not require alignment): */
+#define ERW_(X) extern StgWordArray (X)
+#define IRW_(X) static StgWordArray (X)
+/* read-only data (does not require alignment): */
+#define ERO_(X) extern const StgWordArray (X)
+#define IRO_(X) static const StgWordArray (X)
+/* stg-native functions: */
#define IF_(f) static StgFunPtr GNUC3_ATTRIBUTE(used) f(void)
-#define FN_(f) StgFunPtr f(void)
-#define EF_(f) StgFunPtr f(void) /* External Cmm functions */
+#define FN_(f) StgFunPtr f(void)
+#define EF_(f) StgFunPtr f(void) /* External Cmm functions */
+/* foreign functions: */
#define EFF_(f) void f() /* See Note [External function prototypes] */
/* Note [External function prototypes] See Trac #8965, #11395
diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h
index 307aac371c..163f1d1c87 100644
--- a/includes/rts/storage/InfoTables.h
+++ b/includes/rts/storage/InfoTables.h
@@ -266,7 +266,7 @@ typedef struct {
} StgFunInfoTable;
// canned bitmap for each arg type, indexed by constants in FunTypes.h
-extern StgWord stg_arg_bitmaps[];
+extern const StgWord stg_arg_bitmaps[];
/* -----------------------------------------------------------------------------
Return info tables
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index 9d907ab3ba..b604f1c42b 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -21,10 +21,10 @@
#define STGMISCCLOSURES_H
#if IN_STG_CODE
-# define RTS_RET_INFO(i) extern W_(i)[]
-# define RTS_FUN_INFO(i) extern W_(i)[]
-# define RTS_THUNK_INFO(i) extern W_(i)[]
-# define RTS_INFO(i) extern W_(i)[]
+# define RTS_RET_INFO(i) extern const W_(i)[]
+# define RTS_FUN_INFO(i) extern const W_(i)[]
+# define RTS_THUNK_INFO(i) extern const W_(i)[]
+# define RTS_INFO(i) extern const W_(i)[]
# define RTS_CLOSURE(i) extern W_(i)[]
# define RTS_FUN_DECL(f) extern DLL_IMPORT_RTS StgFunPtr f(void)
#else
@@ -489,9 +489,9 @@ extern StgWord RTS_VAR(sched_mutex);
// Apply.cmm
// canned bitmap for each arg type
-extern StgWord stg_arg_bitmaps[];
-extern StgWord stg_ap_stack_entries[];
-extern StgWord stg_stack_save_entries[];
+extern const StgWord stg_arg_bitmaps[];
+extern const StgWord stg_ap_stack_entries[];
+extern const StgWord stg_stack_save_entries[];
// Storage.c
extern unsigned int RTS_VAR(g0);
--
2.12.2
Reference in new issue View Git Blame Copy Permalink