| 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 |
| |
