diff options
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/cmm/CLabel.hs | 24 | ||||
-rw-r--r-- | compiler/cmm/Cmm.hs | 13 | ||||
-rw-r--r-- | compiler/cmm/CmmInfo.hs | 2 | ||||
-rw-r--r-- | compiler/cmm/PprC.hs | 62 | ||||
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Data.hs | 12 |
5 files changed, 78 insertions, 35 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 |