diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2011-08-23 09:14:46 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2011-08-25 11:12:31 +0100 |
| commit | 4efb0abc5b1b3d33036b640f36ed1efcb10e6cd4 (patch) | |
| tree | 8c49fcc5c8cfe88d76a7f4074d8dc78e3304d5a3 | |
| parent | 190d8e13165bc21411a3357cc685a734a0f36370 (diff) | |
| download | haskell-4efb0abc5b1b3d33036b640f36ed1efcb10e6cd4.tar.gz | |
Renaming only
CmmTop -> CmmDecl
CmmPgm -> CmmGroup
45 files changed, 273 insertions, 265 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 93ac141ac7..f18b417ad9 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -10,8 +10,8 @@ module Cmm ( -- * Cmm top-level datatypes - CmmPgm, GenCmmPgm, - CmmTop, GenCmmTop(..), + CmmProgram, CmmGroup, GenCmmGroup, + CmmDecl, GenCmmDecl(..), CmmGraph, GenCmmGraph(..), CmmBlock, Section(..), CmmStatics(..), CmmStatic(..), @@ -46,10 +46,22 @@ import Data.Word ( Word8 ) -- Cmm, GenCmm ----------------------------------------------------------------------------- --- A file is a list of top-level chunks. These may be arbitrarily --- re-orderd during code generation. +-- A CmmProgram is a list of CmmGroups +-- A CmmGroup is a list of top-level declarations --- GenCmm is abstracted over +-- When object-splitting is on,each group is compiled into a separate +-- .o file. So typically we put closely related stuff in a CmmGroup. + +type CmmProgram = [CmmGroup] + +type GenCmmGroup d h g = [GenCmmDecl d h g] +type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph + +----------------------------------------------------------------------------- +-- CmmDecl, GenCmmDecl +----------------------------------------------------------------------------- + +-- GenCmmDecl is abstracted over -- d, the type of static data elements in CmmData -- h, the static info preceding the code of a CmmProc -- g, the control-flow graph of a CmmProc @@ -60,18 +72,10 @@ import Data.Word ( Word8 ) -- (b) Native code, populated with data/instructions -- -- A second family of instances based on Hoopl is in Cmm.hs. --- -type GenCmmPgm d h g = [GenCmmTop d h g] - -type CmmPgm = GenCmmPgm CmmStatics CmmTopInfo CmmGraph - ------------------------------------------------------------------------------ --- CmmTop, GenCmmTop ------------------------------------------------------------------------------ -- | A top-level chunk, abstracted over the type of the contents of -- the basic blocks (Cmm or instructions are the likely instantiations). -data GenCmmTop d h g +data GenCmmDecl d h g = CmmProc -- A procedure h -- Extra header such as the info table CLabel -- Entry label @@ -81,7 +85,7 @@ data GenCmmTop d h g Section d -type CmmTop = GenCmmTop CmmStatics CmmTopInfo CmmGraph +type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph ----------------------------------------------------------------------------- -- Graphs diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs index baf4f8dac3..3e54aacc77 100644 --- a/compiler/cmm/CmmBuildInfoTables.hs +++ b/compiler/cmm/CmmBuildInfoTables.hs @@ -160,7 +160,7 @@ live_ptrs oldByte slotEnv areaMap bid = -- Construct the stack maps for a procedure _if_ it needs an infotable. -- When wouldn't a procedure need an infotable? If it is a procpoint that -- is not the successor of a call. -setInfoTableStackMap :: SlotEnv -> AreaMap -> CmmTop -> CmmTop +setInfoTableStackMap :: SlotEnv -> AreaMap -> CmmDecl -> CmmDecl setInfoTableStackMap slotEnv areaMap t@(CmmProc (TopInfo {stack_info=StackInfo {updfr_space = Just updfr_off}}) _ (CmmGraph {g_entry = eid})) @@ -240,7 +240,7 @@ addCAF caf srt = , elt_map = Map.insert caf last (elt_map srt) } where last = next_elt srt -srtToData :: TopSRT -> CmmPgm +srtToData :: TopSRT -> CmmGroup srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)] where tbl = map (CmmStaticLit . CmmLabel) (reverse (rev_elts srt)) @@ -253,7 +253,7 @@ srtToData srt = [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)] -- we make sure they're all close enough to the bottom of the table that the -- bitmap will be able to cover all of them. buildSRTs :: TopSRT -> Map CLabel CAFSet -> CAFSet -> - FuelUniqSM (TopSRT, Maybe CmmTop, C_SRT) + FuelUniqSM (TopSRT, Maybe CmmDecl, C_SRT) buildSRTs topSRT topCAFMap cafs = do let liftCAF lbl () z = -- get CAFs for functions without static closures case Map.lookup lbl topCAFMap of Just cafs -> z `Map.union` cafs @@ -296,7 +296,7 @@ buildSRTs topSRT topCAFMap cafs = -- Construct an SRT bitmap. -- Adapted from simpleStg/SRT.lhs, which expects Id's. procpointSRT :: CLabel -> Map CLabel Int -> [CLabel] -> - FuelUniqSM (Maybe CmmTop, C_SRT) + FuelUniqSM (Maybe CmmDecl, C_SRT) procpointSRT _ _ [] = return (Nothing, NoC_SRT) procpointSRT top_srt top_table entries = @@ -314,7 +314,7 @@ maxBmpSize :: Int maxBmpSize = widthInBits wordWidth `div` 2 -- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT. -to_SRT :: CLabel -> Int -> Int -> Bitmap -> FuelUniqSM (Maybe CmmTop, C_SRT) +to_SRT :: CLabel -> Int -> Int -> Bitmap -> FuelUniqSM (Maybe CmmDecl, C_SRT) to_SRT top_srt off len bmp | len > maxBmpSize || bmp == [fromIntegral srt_escape] = do id <- getUniqueM @@ -335,7 +335,7 @@ to_SRT top_srt off len bmp -- keep its CAFs live.) -- Any procedure referring to a non-static CAF c must keep live -- any CAF that is reachable from c. -localCAFInfo :: CAFEnv -> CmmTop -> Maybe (CLabel, CAFSet) +localCAFInfo :: CAFEnv -> CmmDecl -> Maybe (CLabel, CAFSet) localCAFInfo _ (CmmData _ _) = Nothing localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) = case info_tbl top_info of @@ -373,19 +373,19 @@ mkTopCAFInfo localCAFs = foldl addToTop Map.empty g (map (\n@(l, cafs) -> (n, l, Map.keys cafs)) localCAFs) -- Bundle the CAFs used at a procpoint. -bundleCAFs :: CAFEnv -> CmmTop -> (CAFSet, CmmTop) +bundleCAFs :: CAFEnv -> CmmDecl -> (CAFSet, CmmDecl) bundleCAFs cafEnv t@(CmmProc _ _ (CmmGraph {g_entry=entry})) = (expectJust "bundleCAFs" (mapLookup entry cafEnv), t) bundleCAFs _ t = (Map.empty, t) -- Construct the SRTs for the given procedure. -setInfoTableSRT :: Map CLabel CAFSet -> TopSRT -> (CAFSet, CmmTop) -> - FuelUniqSM (TopSRT, [CmmTop]) +setInfoTableSRT :: Map CLabel CAFSet -> TopSRT -> (CAFSet, CmmDecl) -> + FuelUniqSM (TopSRT, [CmmDecl]) setInfoTableSRT topCAFMap topSRT (cafs, t) = setSRT cafs topCAFMap topSRT t setSRT :: CAFSet -> Map CLabel CAFSet -> TopSRT -> - CmmTop -> FuelUniqSM (TopSRT, [CmmTop]) + CmmDecl -> FuelUniqSM (TopSRT, [CmmDecl]) setSRT cafs topCAFMap topSRT t = do (topSRT, cafTable, srt) <- buildSRTs topSRT topCAFMap cafs let t' = updInfo id (const srt) t @@ -395,7 +395,7 @@ setSRT cafs topCAFMap topSRT t = type StackLayout = Liveness -updInfo :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmTop -> CmmTop +updInfo :: (StackLayout -> StackLayout) -> (C_SRT -> C_SRT) -> CmmDecl -> CmmDecl updInfo toVars toSrt (CmmProc top_info top_l g) = CmmProc (top_info {info_tbl=updInfoTbl toVars toSrt (info_tbl top_info)}) top_l g updInfo _ _ t = t @@ -426,7 +426,7 @@ updInfoTbl _ _ t@CmmNonInfoTable = t -- needed to generate the infotables along with the Cmm data and procedures. -- JD: Why not do this while splitting procedures? -lowerSafeForeignCalls :: AreaMap -> CmmTop -> FuelUniqSM CmmTop +lowerSafeForeignCalls :: AreaMap -> CmmDecl -> FuelUniqSM CmmDecl lowerSafeForeignCalls _ t@(CmmData _ _) = return t lowerSafeForeignCalls areaMap (CmmProc info l g@(CmmGraph {g_entry=entry})) = do let block b mblocks = mblocks >>= lowerSafeCallBlock entry areaMap b diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index a04b3a43e1..f8007cc347 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -21,7 +21,7 @@ import Prelude hiding (succ, unzip, zip) import Util ------------------------------------ -runCmmContFlowOpts :: CmmPgm -> CmmPgm +runCmmContFlowOpts :: CmmGroup -> CmmGroup runCmmContFlowOpts prog = runCmmOpts cmmCfgOpts prog oldCmmCfgOpts :: Old.ListGraph Old.CmmStmt -> Old.ListGraph Old.CmmStmt @@ -33,11 +33,11 @@ cmmCfgOpts = -- Here branchChainElim can ultimately be replaced -- with a more exciting combination of optimisations -runCmmOpts :: (g -> g) -> GenCmmPgm d h g -> GenCmmPgm d h g +runCmmOpts :: (g -> g) -> GenCmmGroup d h g -> GenCmmGroup d h g -- Lifts a transformer on a single graph to one on the whole program runCmmOpts opt = map (optProc opt) -optProc :: (g -> g) -> GenCmmTop d h g -> GenCmmTop d h g +optProc :: (g -> g) -> GenCmmDecl d h g -> GenCmmDecl d h g optProc _ top@(CmmData {}) = top optProc opt (CmmProc info lbl g) = CmmProc info lbl (opt g) diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs index c0f715d211..2d46917115 100644 --- a/compiler/cmm/CmmCvt.hs +++ b/compiler/cmm/CmmCvt.hs @@ -17,7 +17,7 @@ import Data.Maybe import Maybes import Outputable -cmmOfZgraph :: CmmPgm -> Old.CmmPgm +cmmOfZgraph :: CmmGroup -> Old.CmmGroup cmmOfZgraph tops = map mapTop tops where mapTop (CmmProc h l g) = CmmProc (Old.CmmInfo Nothing Nothing (info_tbl h)) l (ofZgraph g) mapTop (CmmData s ds) = CmmData s ds diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index bea613e507..c270e01706 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -30,7 +30,7 @@ mkEmptyContInfoTable info_lbl , cit_prof = NoProfilingInfo , cit_srt = NoC_SRT } -cmmToRawCmm :: [Old.CmmPgm] -> IO [Old.RawCmmPgm] +cmmToRawCmm :: [Old.CmmGroup] -> IO [Old.RawCmmGroup] cmmToRawCmm cmms = do { uniqs <- mkSplitUniqSupply 'i' ; return (initUs_ uniqs (mapM (concatMapM mkInfoTable) cmms)) } @@ -68,7 +68,7 @@ cmmToRawCmm cmms -- -- * The SRT slot is only there if there is SRT info to record -mkInfoTable :: CmmTop -> UniqSM [RawCmmTop] +mkInfoTable :: CmmDecl -> UniqSM [RawCmmDecl] mkInfoTable (CmmData sec dat) = return [CmmData sec dat] @@ -89,17 +89,21 @@ type InfoTableContents = ( [CmmLit] -- The standard part -- These Lits have *not* had mkRelativeTo applied to them mkInfoTableContents :: CmmInfoTable - -> Maybe StgHalfWord -- override default RTS type tag? - -> UniqSM ([RawCmmTop], -- Auxiliary top decls + -> Maybe StgHalfWord -- Override default RTS type tag? + -> UniqSM ([RawCmmDecl], -- Auxiliary top decls InfoTableContents) -- Info tbl + extra bits -mkInfoTableContents info@(CmmInfoTable { cit_rep = RTSRep ty rep }) _ - = mkInfoTableContents info{cit_rep = rep} (Just ty) +mkInfoTableContents info@(CmmInfoTable { cit_lbl = info_lbl + , cit_rep = smrep + , cit_prof = prof + , cit_srt = srt }) + mb_rts_tag + | RTSRep rts_tag rep <- smrep + = mkInfoTableContents info{cit_rep = rep} (Just rts_tag) + -- Completely override the rts_tag that mkInfoTableContents would + -- otherwise compute, with the rts_tag stored in the RTSRep + -- (which in turn came from a handwritten .cmm file) -mkInfoTableContents (CmmInfoTable { cit_lbl = info_lbl - , cit_rep = smrep - , cit_prof = prof - , cit_srt = srt }) mb_rts_tag | StackRep frame <- smrep = do { (prof_lits, prof_data) <- mkProfLits prof ; let (srt_label, srt_bitmap) = mkSRTLit srt @@ -128,7 +132,7 @@ mkInfoTableContents (CmmInfoTable { cit_lbl = info_lbl -> UniqSM ( Maybe StgHalfWord -- Override the SRT field with this , Maybe CmmLit -- Override the layout field with this , [CmmLit] -- "Extra bits" for info table - , [RawCmmTop]) -- Auxiliary data decls + , [RawCmmDecl]) -- Auxiliary data decls mk_pieces (Constr con_tag con_descr) _no_srt -- A data constructor = do { (descr_lit, decl) <- newStringLit con_descr ; return (Just con_tag, Nothing, [descr_lit], [decl]) } @@ -180,7 +184,7 @@ mkSRTLit (C_SRT lbl off bitmap) = ([cmmLabelOffW lbl off], bitmap) -- * the "extra bits" (StgFunInfoExtraRev etc.) -- * the entry label -- * the code --- and lays them out in memory, producing a list of RawCmmTop +-- and lays them out in memory, producing a list of RawCmmDecl -- The value of tablesNextToCode determines the relative positioning -- of the extra bits and the standard info table, and whether the @@ -192,7 +196,7 @@ mkInfoTableAndCode :: CLabel -- Info table label -> InfoTableContents -> CLabel -- Entry label -> ListGraph CmmStmt -- Entry code - -> [RawCmmTop] + -> [RawCmmDecl] mkInfoTableAndCode info_lbl (std_info, extra_bits) entry_lbl blocks | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc = [CmmProc (Just $ Statics info_lbl $ map CmmStaticLit $ @@ -256,7 +260,7 @@ makeRelativeRefTo _ lit = lit -- The head of the stack layout is the top of the stack and -- the least-significant bit. -mkLivenessBits :: Liveness -> UniqSM (CmmLit, [RawCmmTop]) +mkLivenessBits :: Liveness -> UniqSM (CmmLit, [RawCmmDecl]) -- ^ Returns: -- 1. The bitmap (literal value or label) -- 2. Large bitmap CmmData if needed @@ -327,14 +331,14 @@ mkStdInfoTable (type_descr, closure_descr) cl_type srt_len layout_lit -- ------------------------------------------------------------------------- -mkProfLits :: ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmTop]) +mkProfLits :: ProfilingInfo -> UniqSM ((CmmLit,CmmLit), [RawCmmDecl]) mkProfLits NoProfilingInfo = return ((zeroCLit, zeroCLit), []) mkProfLits (ProfilingInfo td cd) = do { (td_lit, td_decl) <- newStringLit td ; (cd_lit, cd_decl) <- newStringLit cd ; return ((td_lit,cd_lit), [td_decl,cd_decl]) } -newStringLit :: [Word8] -> UniqSM (CmmLit, GenCmmTop CmmStatics info stmt) +newStringLit :: [Word8] -> UniqSM (CmmLit, GenCmmDecl CmmStatics info stmt) newStringLit bytes = do { uniq <- getUniqueUs ; return (mkByteStringCLit uniq bytes) } diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index dd47c4433e..8229d33f00 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -31,12 +31,12 @@ import Data.Maybe -- Exported entry points: cmmLint :: (Outputable d, Outputable h) - => Platform -> GenCmmPgm d h (ListGraph CmmStmt) -> Maybe SDoc -cmmLint platform tops = runCmmLint platform (mapM_ lintCmmTop) tops + => Platform -> GenCmmGroup d h (ListGraph CmmStmt) -> Maybe SDoc +cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops cmmLintTop :: (Outputable d, Outputable h) - => Platform -> GenCmmTop d h (ListGraph CmmStmt) -> Maybe SDoc -cmmLintTop platform top = runCmmLint platform lintCmmTop top + => Platform -> GenCmmDecl d h (ListGraph CmmStmt) -> Maybe SDoc +cmmLintTop platform top = runCmmLint platform lintCmmDecl top runCmmLint :: PlatformOutputable a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc @@ -48,13 +48,13 @@ runCmmLint platform l p = nest 2 (pprPlatform platform p)]) Right _ -> Nothing -lintCmmTop :: (GenCmmTop h i (ListGraph CmmStmt)) -> CmmLint () -lintCmmTop (CmmProc _ lbl (ListGraph blocks)) +lintCmmDecl :: (GenCmmDecl h i (ListGraph CmmStmt)) -> CmmLint () +lintCmmDecl (CmmProc _ lbl (ListGraph blocks)) = addLintInfo (text "in proc " <> pprCLabel lbl) $ let labels = foldl (\s b -> setInsert (blockId b) s) setEmpty blocks in mapM_ (lintCmmBlock labels) blocks -lintCmmTop (CmmData {}) +lintCmmDecl (CmmData {}) = return () lintCmmBlock :: BlockSet -> GenBasicBlock CmmStmt -> CmmLint () diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index 5480d9c597..5d0e2b247a 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -672,7 +672,7 @@ exactLog2 x_ except factorial, but what the hell. -} -cmmLoopifyForC :: RawCmmTop -> RawCmmTop +cmmLoopifyForC :: RawCmmDecl -> RawCmmDecl cmmLoopifyForC p@(CmmProc Nothing _ _) = p -- only if there's an info table, ignore case alts cmmLoopifyForC p@(CmmProc (Just info@(Statics info_lbl _)) entry_lbl (ListGraph blocks@(BasicBlock top_id _ : _))) = diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 6f72388cd5..f31468ec11 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -1061,7 +1061,7 @@ initEnv = listToUFM [ VarN (CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordWidth) )) ] -parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe CmmPgm) +parseCmmFile :: DynFlags -> FilePath -> IO (Messages, Maybe CmmGroup) parseCmmFile dflags filename = do showPass dflags "ParseCmm" buf <- hGetStringBuffer filename diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 8c6e0a765f..3c7e3ed6a2 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -53,9 +53,9 @@ import StaticFlags -- we actually need to do the initial pass. cmmPipeline :: HscEnv -- Compilation env including -- dynamic flags: -dcmm-lint -ddump-cps-cmm - -> (TopSRT, [CmmPgm]) -- SRT table and accumulating list of compiled procs - -> CmmPgm -- Input C-- with Procedures - -> IO (TopSRT, [CmmPgm]) -- Output CPS transformed C-- + -> (TopSRT, [CmmGroup]) -- SRT table and accumulating list of compiled procs + -> CmmGroup -- Input C-- with Procedures + -> IO (TopSRT, [CmmGroup]) -- Output CPS transformed C-- cmmPipeline hsc_env (topSRT, rst) prog = do let dflags = hsc_dflags hsc_env -- @@ -63,7 +63,7 @@ cmmPipeline hsc_env (topSRT, rst) prog = let tops = runCmmContFlowOpts prog (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops - -- tops :: [[(CmmTop,CAFSet]] (one list per group) + -- tops :: [[(CmmDecl,CAFSet]] (one list per group) let topCAFEnv = mkTopCAFInfo (concat cafEnvs) @@ -90,7 +90,7 @@ global to one compiler session. -- input for any given phase, besides just turning it all on with -- -ddump-cmmz -cpsTop :: HscEnv -> CmmTop -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmTop)]) +cpsTop :: HscEnv -> CmmDecl -> IO ([(CLabel, CAFSet)], [(CAFSet, CmmDecl)]) cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, p)]) cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) l g) = do @@ -162,7 +162,7 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) mapM_ (dumpPlatform platform Opt_D_dump_cmmz_cafs "after bundleCAFs") gs return (localCAFs, gs) - -- gs :: [ (CAFSet, CmmTop) ] + -- gs :: [ (CAFSet, CmmDecl) ] -- localCAFs :: [ (CLabel, CAFSet) ] -- statics filtered out(?) where dflags = hsc_dflags hsc_env @@ -186,8 +186,8 @@ cpsTop hsc_env (CmmProc h@(TopInfo {stack_info=StackInfo {arg_space=entry_off}}) -- This probably belongs in CmmBuildInfoTables? -- We're just finishing the job here: once we know what CAFs are defined -- in non-static closures, we can build the SRTs. -toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmTop]]) - -> [(CAFSet, CmmTop)] -> IO (TopSRT, [[CmmTop]]) +toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmDecl]]) + -> [(CAFSet, CmmDecl)] -> IO (TopSRT, [[CmmDecl]]) toTops hsc_env topCAFEnv (topSRT, tops) gs = do let setSRT (topSRT, rst) g = do (topSRT, gs) <- setInfoTableSRT topCAFEnv topSRT g diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs index 604ddea047..7468294156 100644 --- a/compiler/cmm/CmmProcPoint.hs +++ b/compiler/cmm/CmmProcPoint.hs @@ -381,7 +381,7 @@ add_CopyOuts protos procPoints g = foldGraphBlocks mb_copy_out (return mapEmpty) -- ToDo: use the _ret naming convention that the old code generator -- used. -- EZY splitAtProcPoints :: CLabel -> ProcPointSet-> ProcPointSet -> BlockEnv Status -> - CmmTop -> FuelUniqSM [CmmTop] + CmmDecl -> FuelUniqSM [CmmDecl] splitAtProcPoints entry_label callPPs procPoints procMap (CmmProc (TopInfo {info_tbl=info_tbl, stack_info=stack_info}) diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 73a66c7636..47a5b09882 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -124,19 +124,19 @@ mkIntCLit i = CmmInt (toInteger i) wordWidth zeroCLit :: CmmLit zeroCLit = CmmInt 0 wordWidth -mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmTop CmmStatics info stmt) +mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmDecl CmmStatics info stmt) -- We have to make a top-level decl for the string, -- and return a literal pointing to it mkByteStringCLit uniq bytes = (CmmLabel lbl, CmmData ReadOnlyData $ Statics lbl [CmmString bytes]) where lbl = mkStringLitLabel uniq -mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt +mkDataLits :: Section -> CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt -- Build a data-segment data block mkDataLits section lbl lits = CmmData section (Statics lbl $ map CmmStaticLit lits) -mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt +mkRODataLits :: CLabel -> [CmmLit] -> GenCmmDecl CmmStatics info stmt -- Build a read-only data block mkRODataLits lbl lits = mkDataLits section lbl lits diff --git a/compiler/cmm/OldCmm.hs b/compiler/cmm/OldCmm.hs index 2827d04cfd..36d00bd991 100644 --- a/compiler/cmm/OldCmm.hs +++ b/compiler/cmm/OldCmm.hs @@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- module OldCmm ( - CmmPgm, GenCmmPgm, RawCmmPgm, CmmTop, RawCmmTop, + CmmGroup, GenCmmGroup, RawCmmGroup, CmmDecl, RawCmmDecl, ListGraph(..), CmmInfo(..), UpdateFrame(..), CmmInfoTable(..), ClosureTypeInfo(..), CmmStatic(..), CmmStatics(..), CmmFormal, CmmActual, @@ -17,7 +17,7 @@ module OldCmm ( CmmStmt(..), CmmReturnInfo(..), CmmHinted(..), HintedCmmFormal, HintedCmmActual, CmmSafety(..), CmmCallTarget(..), - New.GenCmmTop(..), + New.GenCmmDecl(..), New.ForeignHint(..), module CmmExpr, Section(..), @@ -27,7 +27,7 @@ module OldCmm ( #include "HsVersions.h" import qualified Cmm as New -import Cmm ( CmmInfoTable(..), GenCmmPgm, CmmStatics(..), GenCmmTop(..), +import Cmm ( CmmInfoTable(..), GenCmmGroup, CmmStatics(..), GenCmmDecl(..), CmmFormal, CmmActual, Section(..), CmmStatic(..), ProfilingInfo(..), ClosureTypeInfo(..) ) @@ -63,7 +63,7 @@ data UpdateFrame = [CmmExpr] -- Frame remainder. Behaves like the arguments of a 'jump'. ----------------------------------------------------------------------------- --- Cmm, CmmTop, CmmBasicBlock +-- Cmm, CmmDecl, CmmBasicBlock ----------------------------------------------------------------------------- -- A file is a list of top-level chunks. These may be arbitrarily @@ -80,15 +80,15 @@ newtype ListGraph i = ListGraph [GenBasicBlock i] -- across a whole compilation unit. -- | Cmm with the info table as a data type -type CmmPgm = GenCmmPgm CmmStatics CmmInfo (ListGraph CmmStmt) -type CmmTop = GenCmmTop CmmStatics CmmInfo (ListGraph CmmStmt) +type CmmGroup = GenCmmGroup CmmStatics CmmInfo (ListGraph CmmStmt) +type CmmDecl = GenCmmDecl CmmStatics CmmInfo (ListGraph CmmStmt) -- | Cmm with the info tables converted to a list of 'CmmStatic' along with the info -- table label. If we are building without tables-next-to-code there will be no statics -- -- INVARIANT: if there is an info table, it has at least one CmmStatic -type RawCmmPgm = GenCmmPgm CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt) -type RawCmmTop = GenCmmTop CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt) +type RawCmmGroup = GenCmmGroup CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt) +type RawCmmDecl = GenCmmDecl CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt) -- A basic block containing a single label, at the beginning. @@ -118,11 +118,11 @@ mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs) -- graph maps ---------------------------------------------------------------- -cmmMapGraph :: (g -> g') -> GenCmmPgm d h g -> GenCmmPgm d h g' -cmmTopMapGraph :: (g -> g') -> GenCmmTop d h g -> GenCmmTop d h g' +cmmMapGraph :: (g -> g') -> GenCmmGroup d h g -> GenCmmGroup d h g' +cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g' -cmmMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmPgm d h g -> m (GenCmmPgm d h g') -cmmTopMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmTop d h g -> m (GenCmmTop d h g') +cmmMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmGroup d h g -> m (GenCmmGroup d h g') +cmmTopMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmDecl d h g -> m (GenCmmDecl d h g') cmmMapGraph f tops = map (cmmTopMapGraph f) tops cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 80135503ff..3afdaf1100 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -65,7 +65,7 @@ import Control.Monad.ST -- -------------------------------------------------------------------------- -- Top level -pprCs :: DynFlags -> [RawCmmPgm] -> SDoc +pprCs :: DynFlags -> [RawCmmGroup] -> SDoc pprCs dflags cmms = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms) where @@ -73,7 +73,7 @@ pprCs dflags cmms | dopt Opt_SplitObjs dflags = ptext (sLit "__STG_SPLIT_MARKER") | otherwise = empty -writeCs :: DynFlags -> Handle -> [RawCmmPgm] -> IO () +writeCs :: DynFlags -> Handle -> [RawCmmGroup] -> IO () writeCs dflags handle cmms = printForC handle (pprCs dflags cmms) @@ -83,13 +83,13 @@ writeCs dflags handle cmms -- for fun, we could call cmmToCmm over the tops... -- -pprC :: RawCmmPgm -> SDoc +pprC :: RawCmmGroup -> SDoc pprC tops = vcat $ intersperse blankLine $ map pprTop tops -- -- top level procs -- -pprTop :: RawCmmTop -> SDoc +pprTop :: RawCmmDecl -> SDoc pprTop (CmmProc mb_info clbl (ListGraph blocks)) = (case mb_info of Nothing -> empty diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs index c973f2d2f0..5cd3501b11 100644 --- a/compiler/cmm/PprCmmDecl.hs +++ b/compiler/cmm/PprCmmDecl.hs @@ -33,7 +33,7 @@ -- module PprCmmDecl - ( writeCmms, pprCmms, pprCmmPgm, pprSection, pprStatic + ( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic ) where @@ -54,19 +54,19 @@ import SMRep pprCmms :: (Outputable info, PlatformOutputable g) - => Platform -> [GenCmmPgm CmmStatics info g] -> SDoc + => Platform -> [GenCmmGroup CmmStatics info g] -> SDoc pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pprPlatform platform) cmms)) where separator = space $$ ptext (sLit "-------------------") $$ space writeCmms :: (Outputable info, PlatformOutputable g) - => Platform -> Handle -> [GenCmmPgm CmmStatics info g] -> IO () + => Platform -> Handle -> [GenCmmGroup CmmStatics info g] -> IO () writeCmms platform handle cmms = printForC handle (pprCmms platform cmms) ----------------------------------------------------------------------------- instance (Outputable d, Outputable info, PlatformOutputable i) - => PlatformOutputable (GenCmmTop d info i) where + => PlatformOutputable (GenCmmDecl d info i) where pprPlatform platform t = pprTop platform t instance Outputable CmmStatics where @@ -81,16 +81,16 @@ instance Outputable CmmInfoTable where ----------------------------------------------------------------------------- -pprCmmPgm :: (Outputable d, Outputable info, PlatformOutputable g) - => Platform -> GenCmmPgm d info g -> SDoc -pprCmmPgm platform tops +pprCmmGroup :: (Outputable d, Outputable info, PlatformOutputable g) + => Platform -> GenCmmGroup d info g -> SDoc +pprCmmGroup platform tops = vcat $ intersperse blankLine $ map (pprTop platform) tops -- -------------------------------------------------------------------------- -- Top level `procedure' blocks. -- pprTop :: (Outputable d, Outputable info, PlatformOutputable i) - => Platform -> GenCmmTop d info i -> SDoc + => Platform -> GenCmmDecl d info i -> SDoc pprTop platform (CmmProc info lbl graph) diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index 33fedfd01b..889b1db752 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -402,7 +402,7 @@ For charlike and intlike closures there is a fixed array of static closures predeclared. \begin{code} -cgTyCon :: TyCon -> FCode CmmPgm -- each constructor gets a separate CmmPgm +cgTyCon :: TyCon -> FCode CmmGroup -- each constructor gets a separate CmmGroup cgTyCon tycon = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon) diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs index 6ee9581087..f9ddeb959c 100644 --- a/compiler/codeGen/CgMonad.lhs +++ b/compiler/codeGen/CgMonad.lhs @@ -120,7 +120,7 @@ initCgInfoDown dflags mod data CgState = MkCgState { cgs_stmts :: OrdList CgStmt, -- Current proc - cgs_tops :: OrdList CmmTop, + cgs_tops :: OrdList CmmDecl, -- Other procedures and data blocks in this compilation unit -- Both the latter two are ordered only so that we can -- reduce forward references, when it's easy to do so @@ -736,7 +736,7 @@ emitCgStmt stmt ; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt } } -emitDecl :: CmmTop -> Code +emitDecl :: CmmDecl -> Code emitDecl decl = do { state <- getState ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } } @@ -755,7 +755,7 @@ emitSimpleProc lbl code ; blks <- cgStmtsToBlocks stmts ; emitProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] blks } -getCmm :: Code -> FCode CmmPgm +getCmm :: Code -> FCode CmmGroup -- Get all the CmmTops (there should be no stmts) -- Return a single Cmm which may be split from other Cmms by -- object splitting (at a later stage) diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index 77f88470a5..2fed13e452 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -960,7 +960,7 @@ get_Regtable_addr_from_offset rep offset = -- | Fixup global registers so that they assign to locations within the -- RegTable if they aren't pinned for the current target. -fixStgRegisters :: RawCmmTop -> RawCmmTop +fixStgRegisters :: RawCmmDecl -> RawCmmDecl fixStgRegisters top@(CmmData _ _) = top fixStgRegisters (CmmProc info lbl (ListGraph blocks)) = diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs index b22e6ed64d..806f654df0 100644 --- a/compiler/codeGen/CodeGen.lhs +++ b/compiler/codeGen/CodeGen.lhs @@ -53,7 +53,7 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs -> HpcInfo - -> IO [CmmPgm] -- Output + -> IO [CmmGroup] -- Output -- N.B. returning '[Cmm]' and not 'Cmm' here makes it -- possible for object splitting to split up the diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index 6f404f04a0..3e0fc4dd65 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -47,7 +47,7 @@ codeGen :: DynFlags -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs -> HpcInfo - -> IO [CmmPgm] -- Output + -> IO [CmmGroup] -- Output codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info @@ -213,7 +213,7 @@ For charlike and intlike closures there is a fixed array of static closures predeclared. -} -cgTyCon :: TyCon -> FCode CmmPgm -- All constructors merged together +cgTyCon :: TyCon -> FCode CmmGroup -- All constructors merged together cgTyCon tycon = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon) @@ -230,7 +230,7 @@ cgTyCon tycon ; return (concat (extra ++ constrs)) } -cgEnumerationTyCon :: TyCon -> FCode [CmmPgm] +cgEnumerationTyCon :: TyCon -> FCode [CmmGroup] cgEnumerationTyCon tycon | isEnumerationTyCon tycon = do { tbl <- getCmm $ diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index c8da75003a..55dd45b0ec 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -242,7 +242,7 @@ data CgState = MkCgState { cgs_stmts :: CmmAGraph, -- Current procedure - cgs_tops :: OrdList CmmTop, + cgs_tops :: OrdList CmmDecl, -- Other procedures and data blocks in this compilation unit -- Both are ordered only so that we can -- reduce forward references, when it's easy to do so @@ -591,7 +591,7 @@ emit ag = do { state <- getState ; setState $ state { cgs_stmts = cgs_stmts state <*> ag } } -emitDecl :: CmmTop -> FCode () +emitDecl :: CmmDecl -> FCode () emitDecl decl = do { state <- getState ; setState $ state { cgs_tops = cgs_tops state `snocOL` decl } } @@ -614,7 +614,7 @@ emitSimpleProc :: CLabel -> CmmAGraph -> FCode () emitSimpleProc lbl code = emitProc CmmNonInfoTable lbl [] code -getCmm :: FCode () -> FCode CmmPgm +getCmm :: FCode () -> FCode CmmGroup -- Get all the CmmTops (there should be no stmts) -- Return a single Cmm which may be split from other Cmms by -- object splitting (at a later stage) diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index e9c50b25ef..5622221713 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -33,7 +33,7 @@ import System.IO -- ----------------------------------------------------------------------------- -- | Top-level of the LLVM Code generator -- -llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmPgm] -> IO () +llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO () llvmCodeGen dflags h us cmms = let cmm = concat cmms (cdata,env) = foldr split ([],initLlvmEnv) cmm @@ -77,7 +77,7 @@ cmmDataLlvmGens dflags h env (cmm:cmms) lmdata -- ----------------------------------------------------------------------------- -- | Do LLVM code generation on all these Cmms procs. -- -cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop] +cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmDecl] -> Int -- ^ count, used for generating unique subsections -> [[LlvmVar]] -- ^ info tables that need to be marked as 'used' -> IO () @@ -102,26 +102,26 @@ cmmProcLlvmGens dflags h us env ((CmmProc _ _ (ListGraph [])) : cmms) count ivar cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm - let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm + let (docs, ivar) = mapAndUnzip (pprLlvmCmmDecl env' count) llvm Prt.bufLeftRender h $ Prt.vcat docs cmmProcLlvmGens dflags h us' env' cmms (count + 2) (ivar ++ ivars) -- | Complete LLVM code generation phase for a single top-level chunk of Cmm. -cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop - -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] ) +cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl + -> IO ( UniqSupply, LlvmEnv, [LlvmCmmDecl] ) cmmLlvmGen dflags us env cmm = do -- rewrite assignments to global regs let fixed_cmm = fixStgRegisters cmm dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" - (pprCmmPgm (targetPlatform dflags) [fixed_cmm]) + (pprCmmGroup (targetPlatform dflags) [fixed_cmm]) -- generate llvm code from cmm let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" - (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC) + (vcat $ map (docToSDoc . fst . pprLlvmCmmDecl env' 0) llvmBC) return (usGen, env', llvmBC) diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 1c7592ad2d..c41ced8b76 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -6,7 +6,7 @@ module LlvmCodeGen.Base ( - LlvmCmmTop, LlvmBasicBlock, + LlvmCmmDecl, LlvmBasicBlock, LlvmUnresData, LlvmData, UnresLabel, UnresStatic, LlvmVersion, defaultLlvmVersion, @@ -41,7 +41,7 @@ import Unique -- * Some Data Types -- -type LlvmCmmTop = GenCmmTop [LlvmData] (Maybe CmmStatics) (ListGraph LlvmStatement) +type LlvmCmmDecl = GenCmmDecl [LlvmData] (Maybe CmmStatics) (ListGraph LlvmStatement) type LlvmBasicBlock = GenBasicBlock LlvmStatement -- | Unresolved code. diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index d7047379ae..a5f8160d42 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -35,7 +35,7 @@ type LlvmStatements = OrdList LlvmStatement -- ----------------------------------------------------------------------------- -- | Top-level of the LLVM proc Code generator -- -genLlvmProc :: LlvmEnv -> RawCmmTop -> UniqSM (LlvmEnv, [LlvmCmmTop]) +genLlvmProc :: LlvmEnv -> RawCmmDecl -> UniqSM (LlvmEnv, [LlvmCmmDecl]) genLlvmProc env (CmmProc info lbl (ListGraph blocks)) = do (env', lmblocks, lmdata) <- basicBlocksCodeGen env blocks ([], []) let proc = CmmProc info lbl (ListGraph lmblocks) @@ -50,8 +50,8 @@ genLlvmProc _ _ = panic "genLlvmProc: case that shouldn't reach here!" -- | Generate code for a list of blocks that make up a complete procedure. basicBlocksCodeGen :: LlvmEnv -> [CmmBasicBlock] - -> ( [LlvmBasicBlock] , [LlvmCmmTop] ) - -> UniqSM (LlvmEnv, [LlvmBasicBlock] , [LlvmCmmTop] ) + -> ( [LlvmBasicBlock] , [LlvmCmmDecl] ) + -> UniqSM (LlvmEnv, [LlvmBasicBlock] , [LlvmCmmDecl] ) basicBlocksCodeGen env ([]) (blocks, tops) = do let (blocks', allocs) = mapAndUnzip dominateAllocs blocks let allocs' = concat allocs @@ -80,7 +80,7 @@ dominateAllocs (BasicBlock id stmts) -- | Generate code for one block basicBlockCodeGen :: LlvmEnv -> CmmBasicBlock - -> UniqSM ( LlvmEnv, [LlvmBasicBlock], [LlvmCmmTop] ) + -> UniqSM ( LlvmEnv, [LlvmBasicBlock], [LlvmCmmDecl] ) basicBlockCodeGen env (BasicBlock id stmts) = do (env', instrs, top) <- stmtsToInstrs env stmts (nilOL, []) return (env', [BasicBlock id (fromOL instrs)], top) @@ -93,12 +93,12 @@ basicBlockCodeGen env (BasicBlock id stmts) -- A statement conversion return data. -- * LlvmEnv: The new environment -- * LlvmStatements: The compiled LLVM statements. --- * LlvmCmmTop: Any global data needed. -type StmtData = (LlvmEnv, LlvmStatements, [LlvmCmmTop]) +-- * LlvmCmmDecl: Any global data needed. +type StmtData = (LlvmEnv, LlvmStatements, [LlvmCmmDecl]) -- | Convert a list of CmmStmt's to LlvmStatement's -stmtsToInstrs :: LlvmEnv -> [CmmStmt] -> (LlvmStatements, [LlvmCmmTop]) +stmtsToInstrs :: LlvmEnv -> [CmmStmt] -> (LlvmStatements, [LlvmCmmDecl]) -> UniqSM StmtData stmtsToInstrs env [] (llvm, top) = return (env, llvm, top) @@ -361,8 +361,8 @@ getFunPtr env funTy targ = case targ of -- | Conversion of call arguments. arg_vars :: LlvmEnv -> [HintedCmmActual] - -> ([LlvmVar], LlvmStatements, [LlvmCmmTop]) - -> UniqSM (LlvmEnv, [LlvmVar], LlvmStatements, [LlvmCmmTop]) + -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl]) + -> UniqSM (LlvmEnv, [LlvmVar], LlvmStatements, [LlvmCmmDecl]) arg_vars env [] (vars, stmts, tops) = return (env, vars, stmts, tops) @@ -669,8 +669,8 @@ genSwitch env cond maybe_ids = do -- * LlvmEnv: The new enviornment -- * LlvmVar: The var holding the result of the expression -- * LlvmStatements: Any statements needed to evaluate the expression --- * LlvmCmmTop: Any global data needed for this expression -type ExprData = (LlvmEnv, LlvmVar, LlvmStatements, [LlvmCmmTop]) +-- * LlvmCmmDecl: Any global data needed for this expression +type ExprData = (LlvmEnv, LlvmVar, LlvmStatements, [LlvmCmmDecl]) -- | Values which can be passed to 'exprToVar' to configure its -- behaviour in certain circumstances. diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 399a82f451..8f585ca3d5 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -3,7 +3,7 @@ -- module LlvmCodeGen.Ppr ( - pprLlvmHeader, pprLlvmCmmTop, pprLlvmData, infoSection, iTableSuf + pprLlvmHeader, pprLlvmCmmDecl, pprLlvmData, infoSection, iTableSuf ) where #include "HsVersions.h" @@ -85,11 +85,11 @@ pprLlvmData (globals, types) = -- | Pretty print LLVM code -pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar]) -pprLlvmCmmTop _ _ (CmmData _ lmdata) +pprLlvmCmmDecl :: LlvmEnv -> Int -> LlvmCmmDecl -> (Doc, [LlvmVar]) +pprLlvmCmmDecl _ _ (CmmData _ lmdata) = (vcat $ map pprLlvmData lmdata, []) -pprLlvmCmmTop env count (CmmProc mb_info entry_lbl (ListGraph blks)) +pprLlvmCmmDecl env count (CmmProc mb_info entry_lbl (ListGraph blks)) = let (idoc, ivar) = case mb_info of Nothing -> (empty, []) Just (Statics info_lbl dat) diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 597f9621d3..4941d5eea1 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -18,7 +18,7 @@ import PprC ( writeCs ) import CmmLint ( cmmLint ) import Packages import Util -import OldCmm ( RawCmmPgm ) +import OldCmm ( RawCmmGroup ) import HscTypes import DynFlags import Config @@ -48,7 +48,7 @@ codeOutput :: DynFlags -> ModLocation -> ForeignStubs -> [PackageId] - -> [RawCmmPgm] -- Compiled C-- + -> [RawCmmGroup] -- Compiled C-- -> IO (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}) codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC @@ -96,7 +96,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action \begin{code} outputC :: DynFlags -> FilePath - -> [RawCmmPgm] + -> [RawCmmGroup] -> [PackageId] -> IO () @@ -134,7 +134,7 @@ outputC dflags filenm flat_absC packages %************************************************************************ \begin{code} -outputAsm :: DynFlags -> FilePath -> [RawCmmPgm] -> IO () +outputAsm :: DynFlags -> FilePath -> [RawCmmGroup] -> IO () outputAsm dflags filenm flat_absC | cGhcWithNativeCodeGen == "YES" = do ncg_uniqs <- mkSplitUniqSupply 'n' @@ -155,7 +155,7 @@ outputAsm dflags filenm flat_absC %************************************************************************ \begin{code} -outputLlvm :: DynFlags -> FilePath -> [RawCmmPgm] -> IO () +outputLlvm :: DynFlags -> FilePath -> [RawCmmGroup] -> IO () outputLlvm dflags filenm flat_absC = do ncg_uniqs <- mkSplitUniqSupply 'n' doOutput filenm $ \f -> llvmCodeGen dflags f ncg_uniqs flat_absC diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index c43c396c64..30a0c651b2 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -115,7 +115,7 @@ import TyCon ( TyCon, isDataTyCon ) import Name ( Name, NamedThing(..) ) import SimplStg ( stg2stg ) import CodeGen ( codeGen ) -import OldCmm as Old ( CmmPgm ) +import OldCmm as Old ( CmmGroup ) import PprCmm ( pprCmms ) import CmmParse ( parseCmmFile ) import CmmBuildInfoTables @@ -1190,7 +1190,7 @@ tryNewCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [(StgBinding,[(Id,[Id])])] -> HpcInfo - -> IO [Old.CmmPgm] + -> IO [Old.CmmGroup] tryNewCodeGen hsc_env this_mod data_tycons cost_centre_info stg_binds hpc_info = do { let dflags = hsc_dflags hsc_env diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index aabe39af85..09963c4f7a 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -133,22 +133,22 @@ The machine-dependent bits break down as follows: -- Top-level of the native codegen data NcgImpl statics instr jumpDest = NcgImpl { - cmmTopCodeGen :: RawCmmTop -> NatM [NatCmmTop statics instr], - generateJumpTableForInstr :: instr -> Maybe (NatCmmTop statics instr), + cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr], + generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr), getJumpDestBlockId :: jumpDest -> Maybe BlockId, canShortcut :: instr -> Maybe jumpDest, shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics, shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr, - pprNatCmmTop :: Platform -> NatCmmTop statics instr -> Doc, + pprNatCmmDecl :: Platform -> NatCmmDecl statics instr -> Doc, maxSpillSlots :: Int, allocatableRegs :: [RealReg], - ncg_x86fp_kludge :: [NatCmmTop statics instr] -> [NatCmmTop statics instr], - ncgExpandTop :: [NatCmmTop statics instr] -> [NatCmmTop statics instr], + ncg_x86fp_kludge :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr], + ncgExpandTop :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr], ncgMakeFarBranches :: [NatBasicBlock instr] -> [NatBasicBlock instr] } -------------------- -nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmPgm] -> IO () +nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO () nativeCodeGen dflags h us cmms = let nCG' :: (Outputable statics, PlatformOutputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO () nCG' ncgImpl = nativeCodeGen' dflags ncgImpl h us cmms @@ -159,7 +159,7 @@ nativeCodeGen dflags h us cmms ,canShortcut = X86.Instr.canShortcut ,shortcutStatics = X86.Instr.shortcutStatics ,shortcutJump = X86.Instr.shortcutJump - ,pprNatCmmTop = X86.Ppr.pprNatCmmTop + ,pprNatCmmDecl = X86.Ppr.pprNatCmmDecl ,maxSpillSlots = X86.Instr.maxSpillSlots ,allocatableRegs = X86.Regs.allocatableRegs ,ncg_x86fp_kludge = id @@ -177,7 +177,7 @@ nativeCodeGen dflags h us cmms ,canShortcut = PPC.RegInfo.canShortcut ,shortcutStatics = PPC.RegInfo.shortcutStatics ,shortcutJump = PPC.RegInfo.shortcutJump - ,pprNatCmmTop = PPC.Ppr.pprNatCmmTop + ,pprNatCmmDecl = PPC.Ppr.pprNatCmmDecl ,maxSpillSlots = PPC.Instr.maxSpillSlots ,allocatableRegs = PPC.Regs.allocatableRegs ,ncg_x86fp_kludge = id @@ -192,7 +192,7 @@ nativeCodeGen dflags h us cmms ,canShortcut = SPARC.ShortcutJump.canShortcut ,shortcutStatics = SPARC.ShortcutJump.shortcutStatics ,shortcutJump = SPARC.ShortcutJump.shortcutJump - ,pprNatCmmTop = SPARC.Ppr.pprNatCmmTop + ,pprNatCmmDecl = SPARC.Ppr.pprNatCmmDecl ,maxSpillSlots = SPARC.Instr.maxSpillSlots ,allocatableRegs = SPARC.Regs.allocatableRegs ,ncg_x86fp_kludge = id @@ -209,7 +209,7 @@ nativeCodeGen dflags h us cmms nativeCodeGen' :: (Outputable statics, PlatformOutputable instr, Instruction instr) => DynFlags -> NcgImpl statics instr jumpDest - -> Handle -> UniqSupply -> [RawCmmPgm] -> IO () + -> Handle -> UniqSupply -> [RawCmmGroup] -> IO () nativeCodeGen' dflags ncgImpl h us cmms = do let platform = targetPlatform dflags @@ -227,7 +227,7 @@ nativeCodeGen' dflags ncgImpl h us cmms -- dump native code dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" - (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) $ concat native) + (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) $ concat native) -- dump global NCG stats for graph coloring allocator (case concat $ catMaybes colorStats of @@ -278,14 +278,14 @@ cmmNativeGens :: (Outputable statics, PlatformOutputable instr, Instruction inst -> NcgImpl statics instr jumpDest -> BufHandle -> UniqSupply - -> [RawCmmTop] + -> [RawCmmDecl] -> [[CLabel]] - -> [ ([NatCmmTop statics instr], + -> [ ([NatCmmDecl statics instr], Maybe [Color.RegAllocStats statics instr], Maybe [Linear.RegAllocStats]) ] -> Int -> IO ( [[CLabel]], - [([NatCmmTop statics instr], + [([NatCmmDecl statics instr], Maybe [Color.RegAllocStats statics instr], Maybe [Linear.RegAllocStats])] ) @@ -298,7 +298,7 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count <- cmmNativeGen dflags ncgImpl us cmm count Pretty.bufLeftRender h - $ {-# SCC "pprNativeCode" #-} Pretty.vcat $ map (pprNatCmmTop ncgImpl (targetPlatform dflags)) native + $ {-# SCC "pprNativeCode" #-} Pretty.vcat $ map (pprNatCmmDecl ncgImpl (targetPlatform dflags)) native -- carefully evaluate this strictly. Binding it with 'let' -- and then using 'seq' doesn't work, because the let @@ -332,10 +332,10 @@ cmmNativeGen => DynFlags -> NcgImpl statics instr jumpDest -> UniqSupply - -> RawCmmTop -- ^ the cmm to generate code for + -> RawCmmDecl -- ^ the cmm to generate code for -> Int -- ^ sequence number of this top thing -> IO ( UniqSupply - , [NatCmmTop statics instr] -- native code + , [NatCmmDecl statics instr] -- native code , [CLabel] -- things imported by this cmm , Maybe [Color.RegAllocStats statics instr] -- stats for the coloring register allocator , Maybe [Linear.RegAllocStats]) -- stats for the linear register allocators @@ -356,7 +356,7 @@ cmmNativeGen dflags ncgImpl us cmm count dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" - (pprCmmPgm platform [opt_cmm]) + (pprCmmGroup platform [opt_cmm]) -- generate native code from cmm let ((native, lastMinuteImports), usGen) = @@ -365,7 +365,7 @@ cmmNativeGen dflags ncgImpl us cmm count dumpIfSet_dyn dflags Opt_D_dump_asm_native "Native code" - (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) native) + (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) native) -- tag instructions with register liveness information let (withLiveness, usLive) = @@ -403,7 +403,7 @@ cmmNativeGen dflags ncgImpl us cmm count -- dump out what happened during register allocation dumpIfSet_dyn dflags Opt_D_dump_asm_regalloc "Registers allocated" - (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) alloced) + (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) alloced) dumpIfSet_dyn dflags Opt_D_dump_asm_regalloc_stages "Build/spill stages" @@ -434,7 +434,7 @@ cmmNativeGen dflags ncgImpl us cmm count dumpIfSet_dyn dflags Opt_D_dump_asm_regalloc "Registers allocated" - (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) alloced) + (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) alloced) let mPprStats = if dopt Opt_D_dump_asm_stats dflags @@ -478,7 +478,7 @@ cmmNativeGen dflags ncgImpl us cmm count dumpIfSet_dyn dflags Opt_D_dump_asm_expanded "Synthetic instructions expanded" - (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl platform) expanded) + (vcat $ map (docToSDoc . pprNatCmmDecl ncgImpl platform) expanded) return ( usAlloc , expanded @@ -487,7 +487,7 @@ cmmNativeGen dflags ncgImpl us cmm count , ppr_raStatsLinear) -x86fp_kludge :: NatCmmTop (Alignment, CmmStatics) X86.Instr.Instr -> NatCmmTop (Alignment, CmmStatics) X86.Instr.Instr +x86fp_kludge :: NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr -> NatCmmDecl (Alignment, CmmStatics) X86.Instr.Instr x86fp_kludge top@(CmmData _ _) = top x86fp_kludge (CmmProc info lbl (ListGraph code)) = CmmProc info lbl (ListGraph $ X86.Instr.i386_insert_ffrees code) @@ -502,7 +502,7 @@ makeImportsDoc dflags imports #if HAVE_SUBSECTIONS_VIA_SYMBOLS -- On recent versions of Darwin, the linker supports -- dead-stripping of code and data on a per-symbol basis. - -- There's a hack to make this work in PprMach.pprNatCmmTop. + -- There's a hack to make this work in PprMach.pprNatCmmDecl. Pretty.$$ Pretty.text ".subsections_via_symbols" #endif #if HAVE_GNU_NONEXEC_STACK @@ -560,7 +560,7 @@ makeImportsDoc dflags imports sequenceTop :: Instruction instr - => NcgImpl statics instr jumpDest -> NatCmmTop statics instr -> NatCmmTop statics instr + => NcgImpl statics instr jumpDest -> NatCmmDecl statics instr -> NatCmmDecl statics instr sequenceTop _ top@(CmmData _ _) = top sequenceTop ncgImpl (CmmProc info lbl (ListGraph blocks)) = @@ -675,7 +675,7 @@ makeFarBranches blocks -- table instructions. generateJumpTables :: NcgImpl statics instr jumpDest - -> [NatCmmTop statics instr] -> [NatCmmTop statics instr] + -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr] generateJumpTables ncgImpl xs = concatMap f xs where f p@(CmmProc _ _ (ListGraph xs)) = p : concatMap g xs f p = [p] @@ -687,8 +687,8 @@ generateJumpTables ncgImpl xs = concatMap f xs shortcutBranches :: DynFlags -> NcgImpl statics instr jumpDest - -> [NatCmmTop statics instr] - -> [NatCmmTop statics instr] + -> [NatCmmDecl statics instr] + -> [NatCmmDecl statics instr] shortcutBranches dflags ncgImpl tops | optLevel dflags < 1 = tops -- only with -O or higher @@ -698,8 +698,8 @@ shortcutBranches dflags ncgImpl tops mapping = foldr plusUFM emptyUFM mappings build_mapping :: NcgImpl statics instr jumpDest - -> GenCmmTop d t (ListGraph instr) - -> (GenCmmTop d t (ListGraph instr), UniqFM jumpDest) + -> GenCmmDecl d t (ListGraph instr) + -> (GenCmmDecl d t (ListGraph instr), UniqFM jumpDest) build_mapping _ top@(CmmData _ _) = (top, emptyUFM) build_mapping _ (CmmProc info lbl (ListGraph [])) = (CmmProc info lbl (ListGraph []), emptyUFM) @@ -729,8 +729,8 @@ build_mapping ncgImpl (CmmProc info lbl (ListGraph (head:blocks))) apply_mapping :: NcgImpl statics instr jumpDest -> UniqFM jumpDest - -> GenCmmTop statics h (ListGraph instr) - -> GenCmmTop statics h (ListGraph instr) + -> GenCmmDecl statics h (ListGraph instr) + -> GenCmmDecl statics h (ListGraph instr) apply_mapping ncgImpl ufm (CmmData sec statics) = CmmData sec (shortcutStatics ncgImpl (lookupUFM ufm) statics) apply_mapping ncgImpl ufm (CmmProc info lbl (ListGraph blocks)) @@ -763,10 +763,10 @@ apply_mapping ncgImpl ufm (CmmProc info lbl (ListGraph blocks)) genMachCode :: DynFlags - -> (RawCmmTop -> NatM [NatCmmTop statics instr]) - -> RawCmmTop + -> (RawCmmDecl -> NatM [NatCmmDecl statics instr]) + -> RawCmmDecl -> UniqSM - ( [NatCmmTop statics instr] + ( [NatCmmDecl statics instr] , [CLabel]) genMachCode dflags cmmTopCodeGen cmm_top @@ -807,7 +807,7 @@ Ideas for other things we could do (put these in Hoopl please!): temp assignments, and certain assigns to mem...) -} -cmmToCmm :: DynFlags -> RawCmmTop -> (RawCmmTop, [CLabel]) +cmmToCmm :: DynFlags -> RawCmmDecl -> (RawCmmDecl, [CLabel]) cmmToCmm _ top@(CmmData _ _) = (top, []) cmmToCmm dflags (CmmProc info lbl (ListGraph blocks)) = runCmmOpt dflags $ do blocks' <- mapM cmmBlockConFold (cmmMiniInline (cmmEliminateDeadBlocks blocks)) diff --git a/compiler/nativeGen/Instruction.hs b/compiler/nativeGen/Instruction.hs index 31827b9088..0d4161f843 100644 --- a/compiler/nativeGen/Instruction.hs +++ b/compiler/nativeGen/Instruction.hs @@ -3,7 +3,7 @@ module Instruction ( RegUsage(..), noUsage, NatCmm, - NatCmmTop, + NatCmmDecl, NatBasicBlock, Instruction(..) ) @@ -37,13 +37,13 @@ noUsage = RU [] [] -- Our flavours of the Cmm types -- Type synonyms for Cmm populated with native code type NatCmm instr - = GenCmmPgm + = GenCmmGroup CmmStatics (Maybe CmmStatics) (ListGraph instr) -type NatCmmTop statics instr - = GenCmmTop +type NatCmmDecl statics instr + = GenCmmDecl statics (Maybe CmmStatics) (ListGraph instr) diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs index 7f59fd6fc9..439f36d4b3 100644 --- a/compiler/nativeGen/PIC.hs +++ b/compiler/nativeGen/PIC.hs @@ -373,7 +373,7 @@ picRelative :: Arch -> OS -> CLabel -> CmmLit -- Darwin, but not x86_64: -- The PIC base register points to the PIC base label at the beginning --- of the current CmmTop. We just have to use a label difference to +-- of the current CmmDecl. We just have to use a label difference to -- get the offset. -- We have already made sure that all labels that are not from the current -- module are accessed indirectly ('as' can't calculate differences between @@ -681,7 +681,7 @@ pprImportedSymbol _ _ _ -- PIC base register. It adds the appropriate instructions to the -- top of the CmmProc. --- It is assumed that the first NatCmmTop in the input list is a Proc +-- It is assumed that the first NatCmmDecl in the input list is a Proc -- and the rest are CmmDatas. -- Darwin is simple: just fetch the address of a local label. @@ -709,8 +709,8 @@ pprImportedSymbol _ _ _ initializePicBase_ppc :: Arch -> OS -> Reg - -> [NatCmmTop CmmStatics PPC.Instr] - -> NatM [NatCmmTop CmmStatics PPC.Instr] + -> [NatCmmDecl CmmStatics PPC.Instr] + -> NatM [NatCmmDecl CmmStatics PPC.Instr] initializePicBase_ppc ArchPPC os picReg (CmmProc info lab (ListGraph blocks) : statics) @@ -761,8 +761,8 @@ initializePicBase_ppc _ _ _ _ initializePicBase_x86 :: Arch -> OS -> Reg - -> [NatCmmTop (Alignment, CmmStatics) X86.Instr] - -> NatM [NatCmmTop (Alignment, CmmStatics) X86.Instr] + -> [NatCmmDecl (Alignment, CmmStatics) X86.Instr] + -> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr] initializePicBase_x86 ArchX86 os picReg (CmmProc info lab (ListGraph blocks) : statics) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index b1936fe124..359a63392c 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -67,8 +67,8 @@ import FastString -- order. cmmTopCodeGen - :: RawCmmTop - -> NatM [NatCmmTop CmmStatics Instr] + :: RawCmmDecl + -> NatM [NatCmmDecl CmmStatics Instr] cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks @@ -87,7 +87,7 @@ cmmTopCodeGen (CmmData sec dat) = do basicBlockCodeGen :: CmmBasicBlock -> NatM ( [NatBasicBlock Instr] - , [NatCmmTop CmmStatics Instr]) + , [NatCmmDecl CmmStatics Instr]) basicBlockCodeGen (BasicBlock id stmts) = do instrs <- stmtsToInstrs stmts @@ -1184,7 +1184,7 @@ genSwitch expr ids ] return code -generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop CmmStatics Instr) +generateJumpTableForInstr :: Instr -> Maybe (NatCmmDecl CmmStatics Instr) generateJumpTableForInstr (BCTR ids (Just lbl)) = let jumpTable | opt_PIC = map jumpTableEntryRel ids diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index 54056c9e4d..4c73a329b5 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- module PPC.Ppr ( - pprNatCmmTop, + pprNatCmmDecl, pprBasicBlock, pprSectionHeader, pprData, @@ -50,20 +50,20 @@ import Data.Bits -- ----------------------------------------------------------------------------- -- Printing this stuff out -pprNatCmmTop :: Platform -> NatCmmTop CmmStatics Instr -> Doc -pprNatCmmTop _ (CmmData section dats) = +pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> Doc +pprNatCmmDecl _ (CmmData section dats) = pprSectionHeader section $$ pprDatas dats -- special case for split markers: -pprNatCmmTop _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl +pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl -- special case for code without an info table: -pprNatCmmTop platform (CmmProc Nothing lbl (ListGraph blocks)) = +pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph blocks)) = pprSectionHeader Text $$ pprLabel lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock platform) blocks) -pprNatCmmTop platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = +pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = pprSectionHeader Text $$ ( #if HAVE_SUBSECTIONS_VIA_SYMBOLS diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs index a499e1d562..41901bb9da 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs @@ -27,8 +27,8 @@ import Data.List -- the same and the move instruction safely erased. regCoalesce :: Instruction instr - => [LiveCmmTop statics instr] - -> UniqSM [LiveCmmTop statics instr] + => [LiveCmmDecl statics instr] + -> UniqSM [LiveCmmDecl statics instr] regCoalesce code = do @@ -61,7 +61,7 @@ sinkReg fm r -- then we can rename the two regs to the same thing and eliminate the move. slurpJoinMovs :: Instruction instr - => LiveCmmTop statics instr + => LiveCmmDecl statics instr -> Bag (Reg, Reg) slurpJoinMovs live diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index 5321a34695..19497145f2 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -49,8 +49,8 @@ regAlloc => DynFlags -> UniqFM (UniqSet RealReg) -- ^ the registers we can use for allocation -> UniqSet Int -- ^ the set of available spill slots. - -> [LiveCmmTop statics instr] -- ^ code annotated with liveness information. - -> UniqSM ( [NatCmmTop statics instr], [RegAllocStats statics instr] ) + -> [LiveCmmDecl statics instr] -- ^ code annotated with liveness information. + -> UniqSM ( [NatCmmDecl statics instr], [RegAllocStats statics instr] ) -- ^ code with registers allocated and stats for each stage of -- allocation @@ -242,7 +242,7 @@ regAlloc_spin -- | Build a graph from the liveness and coalesce information in this code. buildGraph :: Instruction instr - => [LiveCmmTop statics instr] + => [LiveCmmDecl statics instr] -> UniqSM (Color.Graph VirtualReg RegClass RealReg) buildGraph code @@ -325,7 +325,7 @@ graphAddCoalesce _ _ patchRegsFromGraph :: (Outputable statics, PlatformOutputable instr, Instruction instr) => Platform -> Color.Graph VirtualReg RegClass RealReg - -> LiveCmmTop statics instr -> LiveCmmTop statics instr + -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr patchRegsFromGraph platform graph code = let diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs index c4fb783688..e44a65daf5 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs @@ -41,11 +41,11 @@ import qualified Data.Set as Set -- regSpill :: Instruction instr - => [LiveCmmTop statics instr] -- ^ the code + => [LiveCmmDecl statics instr] -- ^ the code -> UniqSet Int -- ^ available stack slots -> UniqSet VirtualReg -- ^ the regs to spill -> UniqSM - ([LiveCmmTop statics instr] -- code with SPILL and RELOAD meta instructions added. + ([LiveCmmDecl statics instr] -- code with SPILL and RELOAD meta instructions added. , UniqSet Int -- left over slots , SpillStats ) -- stats about what happened during spilling @@ -81,8 +81,8 @@ regSpill code slotsFree regs regSpill_top :: Instruction instr => RegMap Int -- ^ map of vregs to slots they're being spilled to. - -> LiveCmmTop statics instr -- ^ the top level thing. - -> SpillM (LiveCmmTop statics instr) + -> LiveCmmDecl statics instr -- ^ the top level thing. + -> SpillM (LiveCmmDecl statics instr) regSpill_top regSlotMap cmm = case cmm of diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs index da13eab045..94c274dfaf 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs +++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs @@ -55,7 +55,7 @@ type Slot = Int -- | Clean out unneeded spill\/reloads from this top level thing. cleanSpills :: Instruction instr - => Platform -> LiveCmmTop statics instr -> LiveCmmTop statics instr + => Platform -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr cleanSpills platform cmm = evalState (cleanSpin platform 0 cmm) initCleanS @@ -65,8 +65,8 @@ cleanSpin :: Instruction instr => Platform -> Int - -> LiveCmmTop statics instr - -> CleanM (LiveCmmTop statics instr) + -> LiveCmmDecl statics instr + -> CleanM (LiveCmmDecl statics instr) {- cleanSpin _ spinCount code @@ -287,8 +287,8 @@ cleanReload _ _ _ _ -- cleanTopBackward :: Instruction instr - => LiveCmmTop statics instr - -> CleanM (LiveCmmTop statics instr) + => LiveCmmDecl statics instr + -> CleanM (LiveCmmDecl statics instr) cleanTopBackward cmm = case cmm of diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs index 3ea150a3df..e11532e15f 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs +++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs @@ -65,7 +65,7 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2) -- slurpSpillCostInfo :: (PlatformOutputable instr, Instruction instr) => Platform - -> LiveCmmTop statics instr + -> LiveCmmDecl statics instr -> SpillCostInfo slurpSpillCostInfo platform cmm diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs index 15ec6e7f87..2d783f82ec 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs @@ -40,29 +40,29 @@ data RegAllocStats statics instr -- initial graph = RegAllocStatsStart - { raLiveCmm :: [LiveCmmTop statics instr] -- ^ initial code, with liveness + { raLiveCmm :: [LiveCmmDecl statics instr] -- ^ initial code, with liveness , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the initial, uncolored graph , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill -- a spill stage | RegAllocStatsSpill - { raCode :: [LiveCmmTop statics instr] -- ^ the code we tried to allocate registers for + { raCode :: [LiveCmmDecl statics instr] -- ^ the code we tried to allocate registers for , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the partially colored graph , raCoalesced :: UniqFM VirtualReg -- ^ the regs that were coaleced , raSpillStats :: SpillStats -- ^ spiller stats , raSpillCosts :: SpillCostInfo -- ^ number of instrs each reg lives for - , raSpilled :: [LiveCmmTop statics instr] } -- ^ code with spill instructions added + , raSpilled :: [LiveCmmDecl statics instr] } -- ^ code with spill instructions added -- a successful coloring | RegAllocStatsColored - { raCode :: [LiveCmmTop statics instr] -- ^ the code we tried to allocate registers for + { raCode :: [LiveCmmDecl statics instr] -- ^ the code we tried to allocate registers for , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the uncolored graph , raGraphColored :: Color.Graph VirtualReg RegClass RealReg -- ^ the coalesced and colored graph , raCoalesced :: UniqFM VirtualReg -- ^ the regs that were coaleced - , raCodeCoalesced :: [LiveCmmTop statics instr] -- ^ code with coalescings applied - , raPatched :: [LiveCmmTop statics instr] -- ^ code with vregs replaced by hregs - , raSpillClean :: [LiveCmmTop statics instr] -- ^ code with unneeded spill\/reloads cleaned out - , raFinal :: [NatCmmTop statics instr] -- ^ final code + , raCodeCoalesced :: [LiveCmmDecl statics instr] -- ^ code with coalescings applied + , raPatched :: [LiveCmmDecl statics instr] -- ^ code with vregs replaced by hregs + , raSpillClean :: [LiveCmmDecl statics instr] -- ^ code with unneeded spill\/reloads cleaned out + , raFinal :: [NatCmmDecl statics instr] -- ^ final code , raSRMs :: (Int, Int, Int) } -- ^ spill\/reload\/reg-reg moves present in this code instance (Outputable statics, PlatformOutputable instr) => PlatformOutputable (RegAllocStats statics instr) where @@ -256,7 +256,7 @@ pprStatsLifeConflict stats graph -- Lets us see how well the register allocator has done. countSRMs :: Instruction instr - => LiveCmmTop statics instr -> (Int, Int, Int) + => LiveCmmDecl statics instr -> (Int, Int, Int) countSRMs cmm = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0) diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index f1af6a5e39..fc0bde44a0 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -129,8 +129,8 @@ import Control.Monad regAlloc :: (PlatformOutputable instr, Instruction instr) => DynFlags - -> LiveCmmTop statics instr - -> UniqSM (NatCmmTop statics instr, Maybe RegAllocStats) + -> LiveCmmDecl statics instr + -> UniqSM (NatCmmDecl statics instr, Maybe RegAllocStats) regAlloc _ (CmmData sec d) = return diff --git a/compiler/nativeGen/RegAlloc/Linear/Stats.hs b/compiler/nativeGen/RegAlloc/Linear/Stats.hs index 0c059eac27..21664b12ba 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Stats.hs @@ -37,7 +37,7 @@ binSpillReasons reasons -- | Count reg-reg moves remaining in this code. countRegRegMovesNat :: Instruction instr - => NatCmmTop statics instr -> Int + => NatCmmDecl statics instr -> Int countRegRegMovesNat cmm = execState (mapGenBlockTopM countBlock cmm) 0 @@ -58,7 +58,7 @@ countRegRegMovesNat cmm -- | Pretty print some RegAllocStats pprStats :: Instruction instr - => [NatCmmTop statics instr] -> [RegAllocStats] -> SDoc + => [NatCmmDecl statics instr] -> [RegAllocStats] -> SDoc pprStats code statss = let -- sum up all the instrs inserted by the spiller diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index 2b7975dcb4..a5e8579f47 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -11,7 +11,7 @@ module RegAlloc.Liveness ( RegSet, RegMap, emptyRegMap, BlockMap, emptyBlockMap, - LiveCmmTop, + LiveCmmDecl, InstrSR (..), LiveInstr (..), Liveness (..), @@ -67,8 +67,8 @@ type BlockMap a = BlockEnv a -- | A top level thing which carries liveness information. -type LiveCmmTop statics instr - = GenCmmTop +type LiveCmmDecl statics instr + = GenCmmDecl statics LiveInfo [SCC (LiveBasicBlock instr)] @@ -226,7 +226,7 @@ instance Outputable LiveInfo where -- mapBlockTop :: (LiveBasicBlock instr -> LiveBasicBlock instr) - -> LiveCmmTop statics instr -> LiveCmmTop statics instr + -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr mapBlockTop f cmm = evalState (mapBlockTopM (\x -> return $ f x) cmm) () @@ -237,7 +237,7 @@ mapBlockTop f cmm mapBlockTopM :: Monad m => (LiveBasicBlock instr -> m (LiveBasicBlock instr)) - -> LiveCmmTop statics instr -> m (LiveCmmTop statics instr) + -> LiveCmmDecl statics instr -> m (LiveCmmDecl statics instr) mapBlockTopM _ cmm@(CmmData{}) = return cmm @@ -259,7 +259,7 @@ mapSCCM f (CyclicSCC xs) -- map a function across all the basic blocks in this code mapGenBlockTop :: (GenBasicBlock i -> GenBasicBlock i) - -> (GenCmmTop d h (ListGraph i) -> GenCmmTop d h (ListGraph i)) + -> (GenCmmDecl d h (ListGraph i) -> GenCmmDecl d h (ListGraph i)) mapGenBlockTop f cmm = evalState (mapGenBlockTopM (\x -> return $ f x) cmm) () @@ -269,7 +269,7 @@ mapGenBlockTop f cmm mapGenBlockTopM :: Monad m => (GenBasicBlock i -> m (GenBasicBlock i)) - -> (GenCmmTop d h (ListGraph i) -> m (GenCmmTop d h (ListGraph i))) + -> (GenCmmDecl d h (ListGraph i) -> m (GenCmmDecl d h (ListGraph i))) mapGenBlockTopM _ cmm@(CmmData{}) = return cmm @@ -285,7 +285,7 @@ mapGenBlockTopM f (CmmProc header label (ListGraph blocks)) -- slurpConflicts :: Instruction instr - => LiveCmmTop statics instr + => LiveCmmDecl statics instr -> (Bag (UniqSet Reg), Bag (Reg, Reg)) slurpConflicts live @@ -360,7 +360,7 @@ slurpConflicts live -- slurpReloadCoalesce :: forall statics instr. Instruction instr - => LiveCmmTop statics instr + => LiveCmmDecl statics instr -> Bag (Reg, Reg) slurpReloadCoalesce live @@ -368,7 +368,7 @@ slurpReloadCoalesce live where slurpCmm :: Bag (Reg, Reg) - -> GenCmmTop t t1 [SCC (LiveBasicBlock instr)] + -> GenCmmDecl t t1 [SCC (LiveBasicBlock instr)] -> Bag (Reg, Reg) slurpCmm cs CmmData{} = cs slurpCmm cs (CmmProc _ _ sccs) @@ -458,12 +458,12 @@ slurpReloadCoalesce live Just r2 -> r1 == r2 ] --- | Strip away liveness information, yielding NatCmmTop +-- | Strip away liveness information, yielding NatCmmDecl stripLive :: (Outputable statics, PlatformOutputable instr, Instruction instr) => Platform - -> LiveCmmTop statics instr - -> NatCmmTop statics instr + -> LiveCmmDecl statics instr + -> NatCmmDecl statics instr stripLive platform live = stripCmm live @@ -528,8 +528,8 @@ stripLiveBlock platform (BasicBlock i lis) eraseDeltasLive :: Instruction instr - => LiveCmmTop statics instr - -> LiveCmmTop statics instr + => LiveCmmDecl statics instr + -> LiveCmmDecl statics instr eraseDeltasLive cmm = mapBlockTop eraseBlock cmm @@ -546,7 +546,7 @@ eraseDeltasLive cmm patchEraseLive :: Instruction instr => (Reg -> Reg) - -> LiveCmmTop statics instr -> LiveCmmTop statics instr + -> LiveCmmDecl statics instr -> LiveCmmDecl statics instr patchEraseLive patchF cmm = patchCmm cmm @@ -619,12 +619,12 @@ patchRegsLiveInstr patchF li -------------------------------------------------------------------------------- --- | Convert a NatCmmTop to a LiveCmmTop, with empty liveness information +-- | Convert a NatCmmDecl to a LiveCmmDecl, with empty liveness information natCmmTopToLive :: Instruction instr - => NatCmmTop statics instr - -> LiveCmmTop statics instr + => NatCmmDecl statics instr + -> LiveCmmDecl statics instr natCmmTopToLive (CmmData i d) = CmmData i d @@ -662,8 +662,8 @@ sccBlocks blocks = stronglyConnCompFromEdgedVertices graph regLiveness :: (PlatformOutputable instr, Instruction instr) => Platform - -> LiveCmmTop statics instr - -> UniqSM (LiveCmmTop statics instr) + -> LiveCmmDecl statics instr + -> UniqSM (LiveCmmDecl statics instr) regLiveness _ (CmmData i d) = returnUs $ CmmData i d @@ -724,7 +724,7 @@ checkIsReverseDependent sccs' -- | If we've compute liveness info for this code already we have to reverse -- the SCCs in each top to get them back to the right order so we can do it again. -reverseBlocksInTops :: LiveCmmTop statics instr -> LiveCmmTop statics instr +reverseBlocksInTops :: LiveCmmDecl statics instr -> LiveCmmDecl statics instr reverseBlocksInTops top = case top of CmmData{} -> top diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index 6f454a3733..acdf41c2bd 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -51,8 +51,8 @@ import Unique import Control.Monad ( mapAndUnzipM ) -- | Top level code generation -cmmTopCodeGen :: RawCmmTop - -> NatM [NatCmmTop CmmStatics Instr] +cmmTopCodeGen :: RawCmmDecl + -> NatM [NatCmmDecl CmmStatics Instr] cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do @@ -77,7 +77,7 @@ cmmTopCodeGen (CmmData sec dat) = do basicBlockCodeGen :: Platform -> CmmBasicBlock -> NatM ( [NatBasicBlock Instr] - , [NatCmmTop CmmStatics Instr]) + , [NatCmmDecl CmmStatics Instr]) basicBlockCodeGen platform cmm@(BasicBlock id stmts) = do instrs <- stmtsToInstrs stmts @@ -315,7 +315,7 @@ genSwitch expr ids , JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label , NOP ] -generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop CmmStatics Instr) +generateJumpTableForInstr :: Instr -> Maybe (NatCmmDecl CmmStatics Instr) generateJumpTableForInstr (JMP_TBL _ ids label) = let jumpTable = map jumpTableEntry ids in Just (CmmData ReadOnlyData (Statics label jumpTable)) diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs index 3e49f5c025..f65cbaa01a 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs @@ -21,7 +21,7 @@ import Outputable import OrdList -- | Expand out synthetic instructions in this top level thing -expandTop :: NatCmmTop CmmStatics Instr -> NatCmmTop CmmStatics Instr +expandTop :: NatCmmDecl CmmStatics Instr -> NatCmmDecl CmmStatics Instr expandTop top@(CmmData{}) = top diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index bf3fd3c303..e9859fe297 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- module SPARC.Ppr ( - pprNatCmmTop, + pprNatCmmDecl, pprBasicBlock, pprSectionHeader, pprData, @@ -48,20 +48,20 @@ import Data.Word -- ----------------------------------------------------------------------------- -- Printing this stuff out -pprNatCmmTop :: Platform -> NatCmmTop CmmStatics Instr -> Doc -pprNatCmmTop _ (CmmData section dats) = +pprNatCmmDecl :: Platform -> NatCmmDecl CmmStatics Instr -> Doc +pprNatCmmDecl _ (CmmData section dats) = pprSectionHeader section $$ pprDatas dats -- special case for split markers: -pprNatCmmTop _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl +pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl -- special case for code without info table: -pprNatCmmTop _ (CmmProc Nothing lbl (ListGraph blocks)) = +pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph blocks)) = pprSectionHeader Text $$ pprLabel lbl $$ -- blocks guaranteed not null, so label needed vcat (map pprBasicBlock blocks) -pprNatCmmTop _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = +pprNatCmmDecl _ (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = pprSectionHeader Text $$ ( #if HAVE_SUBSECTIONS_VIA_SYMBOLS diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index b929c5eb2e..5474905f9b 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -85,8 +85,8 @@ if_sse2 sse2 x87 = do if b then sse2 else x87 cmmTopCodeGen - :: RawCmmTop - -> NatM [NatCmmTop (Alignment, CmmStatics) Instr] + :: RawCmmDecl + -> NatM [NatCmmDecl (Alignment, CmmStatics) Instr] cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks @@ -107,7 +107,7 @@ cmmTopCodeGen (CmmData sec dat) = do basicBlockCodeGen :: CmmBasicBlock -> NatM ( [NatBasicBlock Instr] - , [NatCmmTop (Alignment, CmmStatics) Instr]) + , [NatCmmDecl (Alignment, CmmStatics) Instr]) basicBlockCodeGen (BasicBlock id stmts) = do instrs <- stmtsToInstrs stmts @@ -2080,11 +2080,11 @@ genSwitch expr ids -- in return code -generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop (Alignment, CmmStatics) Instr) +generateJumpTableForInstr :: Instr -> Maybe (NatCmmDecl (Alignment, CmmStatics) Instr) generateJumpTableForInstr (JMP_TBL _ ids section lbl) = Just (createJumpTable ids section lbl) generateJumpTableForInstr _ = Nothing -createJumpTable :: [Maybe BlockId] -> Section -> CLabel -> GenCmmTop (Alignment, CmmStatics) h g +createJumpTable :: [Maybe BlockId] -> Section -> CLabel -> GenCmmDecl (Alignment, CmmStatics) h g createJumpTable ids section lbl = let jumpTable | opt_PIC = diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 9ac33f2598..8c12e29b1a 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- module X86.Ppr ( - pprNatCmmTop, + pprNatCmmDecl, pprBasicBlock, pprSectionHeader, pprData, @@ -50,21 +50,21 @@ import Data.Bits -- ----------------------------------------------------------------------------- -- Printing this stuff out -pprNatCmmTop :: Platform -> NatCmmTop (Alignment, CmmStatics) Instr -> Doc -pprNatCmmTop platform (CmmData section dats) = +pprNatCmmDecl :: Platform -> NatCmmDecl (Alignment, CmmStatics) Instr -> Doc +pprNatCmmDecl platform (CmmData section dats) = pprSectionHeader section $$ pprDatas platform dats -- special case for split markers: -pprNatCmmTop platform (CmmProc Nothing lbl (ListGraph [])) = pprLabel platform lbl +pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph [])) = pprLabel platform lbl -- special case for code without info table: -pprNatCmmTop platform (CmmProc Nothing lbl (ListGraph blocks)) = +pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph blocks)) = pprSectionHeader Text $$ pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock platform) blocks) $$ pprSizeDecl platform lbl -pprNatCmmTop platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = +pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) = pprSectionHeader Text $$ ( #if HAVE_SUBSECTIONS_VIA_SYMBOLS |