diff options
Diffstat (limited to 'dev-lang/ghc/files/ghc-8.2.1_rc1-cgen-constify.patch')
| -rw-r--r-- | dev-lang/ghc/files/ghc-8.2.1_rc1-cgen-constify.patch | 378 |
1 files changed, 378 insertions, 0 deletions
diff --git a/dev-lang/ghc/files/ghc-8.2.1_rc1-cgen-constify.patch b/dev-lang/ghc/files/ghc-8.2.1_rc1-cgen-constify.patch new file mode 100644 index 000000000000..2e1ef932b454 --- /dev/null +++ b/dev-lang/ghc/files/ghc-8.2.1_rc1-cgen-constify.patch @@ -0,0 +1,378 @@ +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 + |