Fold testsuite.git into ghc.git (re #8545)
[ghc.git] / compiler / cmm / Cmm.hs
index 315e582..fadce0b 100644 (file)
@@ -1,6 +1,5 @@
 -- Cmm representations using Hoopl's Graph CmmNode e x.
 {-# LANGUAGE GADTs #-}
-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 
 module Cmm (
      -- * Cmm top-level datatypes
@@ -8,13 +7,18 @@ module Cmm (
      CmmDecl, GenCmmDecl(..),
      CmmGraph, GenCmmGraph(..),
      CmmBlock,
+     RawCmmDecl, RawCmmGroup,
      Section(..), CmmStatics(..), CmmStatic(..),
 
+     -- ** Blocks containing lists
+     GenBasicBlock(..), blockId,
+     ListGraph(..), pprBBlock,
+
      -- * Cmm graphs
      CmmReplGraph, GenCmmReplGraph, CmmFwdRewrite, CmmBwdRewrite,
    
      -- * Info Tables
-     CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..),
+     CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
      ClosureTypeInfo(..), 
      C_SRT(..), needsSRT,
      ProfilingInfo(..), ConstrDescription, 
@@ -31,6 +35,7 @@ import SMRep
 import CmmExpr
 import UniqSupply
 import Compiler.Hoopl
+import Outputable
 
 import Data.Word        ( Word8 )
 
@@ -50,6 +55,7 @@ type CmmProgram = [CmmGroup]
 
 type GenCmmGroup d h g = [GenCmmDecl d h g]
 type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
+type RawCmmGroup = GenCmmGroup CmmStatics (BlockEnv CmmStatics) CmmGraph
 
 -----------------------------------------------------------------------------
 --  CmmDecl, GenCmmDecl
@@ -62,7 +68,6 @@ type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
 --
 -- We expect there to be two main instances of this type:
 --   (a) C--, i.e. populated with various C-- constructs
---       (Cmm and RawCmm in OldCmm.hs)
 --   (b) Native code, populated with data/instructions
 
 -- | A top-level chunk, abstracted over the type of the contents of
@@ -71,6 +76,14 @@ data GenCmmDecl d h g
   = CmmProc     -- A procedure
      h                 -- Extra header such as the info table
      CLabel            -- Entry label
+     [GlobalReg]       -- Registers live on entry. Note that the set of live
+                       -- registers will be correct in generated C-- code, but
+                       -- not in hand-written C-- code. However,
+                       -- splitAtProcPoints calculates correct liveness
+                       -- information for CmmProc's. Right now only the LLVM
+                       -- back-end relies on correct liveness information and
+                       -- for that back-end we always call splitAtProcPoints, so
+                       -- all is good.
      g                 -- Control-flow graph for the procedure's code
 
   | CmmData     -- Static data
@@ -79,6 +92,12 @@ data GenCmmDecl d h g
 
 type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
 
+type RawCmmDecl
+   = GenCmmDecl
+        CmmStatics
+        (BlockEnv CmmStatics)
+        CmmGraph
+
 -----------------------------------------------------------------------------
 --     Graphs
 -----------------------------------------------------------------------------
@@ -96,17 +115,28 @@ type CmmBwdRewrite f = BwdRewrite UniqSM CmmNode f
 --     Info Tables
 -----------------------------------------------------------------------------
 
-data CmmTopInfo   = TopInfo { info_tbl :: CmmInfoTable
+data CmmTopInfo   = TopInfo { info_tbls  :: BlockEnv CmmInfoTable
                             , stack_info :: CmmStackInfo }
 
+topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
+topInfoTable (CmmProc infos _ _ g) = mapLookup (g_entry g) (info_tbls infos)
+topInfoTable _                     = Nothing
+
 data CmmStackInfo
    = StackInfo {
        arg_space :: ByteOff,
                -- number of bytes of arguments on the stack on entry to the
                -- the proc.  This is filled in by StgCmm.codeGen, and used
                -- by the stack allocator later.
-       updfr_space :: Maybe ByteOff     -- XXX: comment?
-   }
+       updfr_space :: Maybe ByteOff,
+               -- XXX: this never contains anything useful, but it should.
+               -- See comment in CmmLayoutStack.
+       do_layout :: Bool
+               -- Do automatic stack layout for this proc.  This is
+               -- True for all code generated by the code generator,
+               -- but is occasionally False for hand-written Cmm where
+               -- we want to do the stack manipulation manually.
+  }
 
 -- | Info table as a haskell data type
 data CmmInfoTable
@@ -116,7 +146,6 @@ data CmmInfoTable
       cit_prof :: ProfilingInfo,
       cit_srt  :: C_SRT
     }
-  | CmmNonInfoTable   -- Procedure doesn't need an info table
 
 data ProfilingInfo
   = NoProfilingInfo
@@ -159,3 +188,28 @@ data CmmStatics
        CLabel      -- Label of statics
        [CmmStatic] -- The static data itself
 
+-- -----------------------------------------------------------------------------
+-- Basic blocks consisting of lists
+
+-- These are used by the LLVM and NCG backends, when populating Cmm
+-- with lists of instructions.
+
+data GenBasicBlock i = BasicBlock BlockId [i]
+
+-- | The branch block id is that of the first block in
+-- the branch, which is that branch's entry point
+blockId :: GenBasicBlock i -> BlockId
+blockId (BasicBlock blk_id _ ) = blk_id
+
+newtype ListGraph i = ListGraph [GenBasicBlock i]
+
+instance Outputable instr => Outputable (ListGraph instr) where
+    ppr (ListGraph blocks) = vcat (map ppr blocks)
+
+instance Outputable instr => Outputable (GenBasicBlock instr) where
+    ppr = pprBBlock
+
+pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
+pprBBlock (BasicBlock ident stmts) =
+    hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
+