From 7e00046772e053c63ac93630a60b0f396e32a2d7 Mon Sep 17 00:00:00 2001 From: Sergei Trofimovich 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 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