Commit b68697e5 authored by Sergei Trofimovich's avatar Sergei Trofimovich Committed by Ben Gamari

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: default avatarSergei 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
parent d5cb4d2b
......@@ -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
......
......@@ -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
......
......@@ -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)])
--
......
......@@ -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'
......
......@@ -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
......
......@@ -222,13 +222,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
......
......@@ -265,7 +265,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
......
......@@ -20,10 +20,10 @@
#pragma once
#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
......@@ -488,9 +488,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);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment