Skip to content
GitLab
Commit 4efb0abc authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Simon Marlow
Browse files

Renaming only 

   CmmTop -> CmmDecl
   CmmPgm -> CmmGroup
parent 190d8e13
Hide whitespace changes
Inline Side-by-side
compiler/cmm/Cmm.hs
View file @ 4efb0abc
......@@ -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
......
compiler/cmm/CmmBuildInfoTables.hs
View file @ 4efb0abc
......@@ -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
......
compiler/cmm/CmmContFlowOpt.hs
View file @ 4efb0abc
......@@ -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)
......
compiler/cmm/CmmCvt.hs
View file @ 4efb0abc
......@@ -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
......
compiler/cmm/CmmInfo.hs
View file @ 4efb0abc
......@@ -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 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) }
......
compiler/cmm/CmmLint.hs
View file @ 4efb0abc
......@@ -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 ()
......
compiler/cmm/CmmOpt.hs
View file @ 4efb0abc
......@@ -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 _ : _))) =
......
compiler/cmm/CmmParse.y
View file @ 4efb0abc
......@@ -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
......
compiler/cmm/CmmPipeline.hs
View file @ 4efb0abc
......@@ -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
......
compiler/cmm/CmmProcPoint.hs
View file @ 4efb0abc
......@@ -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})
......
compiler/cmm/CmmUtils.hs
View file @ 4efb0abc
......@@ -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
......
compiler/cmm/OldCmm.hs
View file @ 4efb0abc
......@@ -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)
......
compiler/cmm/PprC.hs
View file @ 4efb0abc
......@@ -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
......
compiler/cmm/PprCmmDecl.hs
View file @ 4efb0abc
......@@ -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)
......
compiler/codeGen/CgCon.lhs
View file @ 4efb0abc
......@@ -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)
......
compiler/codeGen/CgMonad.lhs
View file @ 4efb0abc
......@@ -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