-- Cmm representations using Hoopl's Graph CmmNode e x.
{-# LANGUAGE GADTs #-}

module Cmm (
     -- * Cmm top-level datatypes
     CmmProgram, CmmGroup, GenCmmGroup,
     CmmDecl, GenCmmDecl(..),
     CmmGraph, GenCmmGraph(..),
     CmmBlock,
     RawCmmDecl, RawCmmGroup,
     Section(..), SectionType(..), CmmStatics(..), CmmStatic(..),
     isSecConstant,

     -- ** Blocks containing lists
     GenBasicBlock(..), blockId,
     ListGraph(..), pprBBlock,

     -- * Info Tables
     CmmTopInfo(..), CmmStackInfo(..), CmmInfoTable(..), topInfoTable,
     ClosureTypeInfo(..),
     ProfilingInfo(..), ConstrDescription,

     -- * Statements, expressions and types
     module CmmNode,
     module CmmExpr,
  ) where

import GhcPrelude

import Id
import CostCentre
import CLabel
import BlockId
import CmmNode
import SMRep
import CmmExpr
import Hoopl.Block
import Hoopl.Collections
import Hoopl.Graph
import Hoopl.Label
import Outputable
import Data.ByteString (ByteString)

-----------------------------------------------------------------------------
--  Cmm, GenCmm
-----------------------------------------------------------------------------

-- A CmmProgram is a list of CmmGroups
-- A CmmGroup is a list of top-level declarations

-- When object-splitting is on, each group is compiled into a separate
-- .o file. So typically we put closely related stuff in a CmmGroup.
-- Section-splitting follows suit and makes one .text subsection for each
-- CmmGroup.

type CmmProgram = [CmmGroup]

type GenCmmGroup d h g = [GenCmmDecl d h g]
type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
type RawCmmGroup = GenCmmGroup CmmStatics (LabelMap CmmStatics) 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
--
-- We expect there to be two main instances of this type:
--   (a) C--, i.e. populated with various C-- constructs
--   (b) Native code, populated with data/instructions

-- | A top-level chunk, abstracted over the type of the contents of
-- the basic blocks (Cmm or instructions are the likely instantiations).
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 CmmProcs.
     g                 -- Control-flow graph for the procedure's code

  | CmmData     -- Static data
        Section
        d

type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph

type RawCmmDecl
   = GenCmmDecl
        CmmStatics
        (LabelMap CmmStatics)
        CmmGraph

-----------------------------------------------------------------------------
--     Graphs
-----------------------------------------------------------------------------

type CmmGraph = GenCmmGraph CmmNode
data GenCmmGraph n = CmmGraph { GenCmmGraph n -> BlockId
g_entry :: BlockId, GenCmmGraph n -> Graph n C C
g_graph :: Graph n C C }
type CmmBlock = Block CmmNode C C

-----------------------------------------------------------------------------
--     Info Tables
-----------------------------------------------------------------------------

-- | CmmTopInfo is attached to each CmmDecl (see defn of CmmGroup), and contains
-- the extra info (beyond the executable code) that belongs to that CmmDecl.
data CmmTopInfo   = TopInfo { CmmTopInfo -> LabelMap CmmInfoTable
info_tbls  :: LabelMap CmmInfoTable
                            , CmmTopInfo -> CmmStackInfo
stack_info :: CmmStackInfo }

topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable :: GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable (CmmProc CmmTopInfo
infos CLabel
_ [GlobalReg]
_ GenCmmGraph n
g) = KeyOf LabelMap -> LabelMap CmmInfoTable -> Maybe CmmInfoTable
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (GenCmmGraph n -> BlockId
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry GenCmmGraph n
g) (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
infos)
topInfoTable GenCmmDecl a CmmTopInfo (GenCmmGraph n)
_                     = Maybe CmmInfoTable
forall a. Maybe a
Nothing

data CmmStackInfo
   = StackInfo {
       CmmStackInfo -> ByteOff
arg_space :: ByteOff,
               -- number of bytes of arguments on the stack on entry to the
               -- the proc.  This is filled in by GHC.StgToCmm.codeGen, and
               -- used by the stack allocator later.
       CmmStackInfo -> Maybe ByteOff
updfr_space :: Maybe ByteOff,
               -- XXX: this never contains anything useful, but it should.
               -- See comment in CmmLayoutStack.
       CmmStackInfo -> Bool
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
  = CmmInfoTable {
      CmmInfoTable -> CLabel
cit_lbl  :: CLabel, -- Info table label
      CmmInfoTable -> SMRep
cit_rep  :: SMRep,
      CmmInfoTable -> ProfilingInfo
cit_prof :: ProfilingInfo,
      CmmInfoTable -> Maybe CLabel
cit_srt  :: Maybe CLabel,   -- empty, or a closure address
      CmmInfoTable -> Maybe (Id, CostCentreStack)
cit_clo  :: Maybe (Id, CostCentreStack)
        -- Just (id,ccs) <=> build a static closure later
        -- Nothing <=> don't build a static closure
        --
        -- Static closures for FUNs and THUNKs are *not* generated by
        -- the code generator, because we might want to add SRT
        -- entries to them later (for FUNs at least; THUNKs are
        -- treated the same for consistency). See Note [SRTs] in
        -- CmmBuildInfoTables, in particular the [FUN] optimisation.
        --
        -- This is strictly speaking not a part of the info table that
        -- will be finally generated, but it's the only convenient
        -- place to convey this information from the code generator to
        -- where we build the static closures in
        -- CmmBuildInfoTables.doSRTs.
    }

data ProfilingInfo
  = NoProfilingInfo
  | ProfilingInfo ByteString ByteString -- closure_type, closure_desc

-----------------------------------------------------------------------------
--              Static Data
-----------------------------------------------------------------------------

data SectionType
  = Text
  | Data
  | ReadOnlyData
  | RelocatableReadOnlyData
  | UninitialisedData
  | ReadOnlyData16      -- .rodata.cst16 on x86_64, 16-byte aligned
  | CString
  | OtherSection String
  deriving (ByteOff -> SectionType -> ShowS
[SectionType] -> ShowS
SectionType -> String
(ByteOff -> SectionType -> ShowS)
-> (SectionType -> String)
-> ([SectionType] -> ShowS)
-> Show SectionType
forall a.
(ByteOff -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SectionType] -> ShowS
$cshowList :: [SectionType] -> ShowS
show :: SectionType -> String
$cshow :: SectionType -> String
showsPrec :: ByteOff -> SectionType -> ShowS
$cshowsPrec :: ByteOff -> SectionType -> ShowS
Show)

-- | Should a data in this section be considered constant
isSecConstant :: Section -> Bool
isSecConstant :: Section -> Bool
isSecConstant (Section SectionType
t CLabel
_) = case SectionType
t of
    SectionType
Text                    -> Bool
True
    SectionType
ReadOnlyData            -> Bool
True
    SectionType
RelocatableReadOnlyData -> Bool
True
    SectionType
ReadOnlyData16          -> Bool
True
    SectionType
CString                 -> Bool
True
    SectionType
Data                    -> Bool
False
    SectionType
UninitialisedData       -> Bool
False
    (OtherSection String
_)        -> Bool
False

data Section = Section SectionType CLabel

data CmmStatic
  = CmmStaticLit CmmLit
        -- a literal value, size given by cmmLitRep of the literal.
  | CmmUninitialised Int
        -- uninitialised data, N bytes long
  | CmmString ByteString
        -- string of 8-bit values only, not zero terminated.

data CmmStatics
   = Statics
       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 :: GenBasicBlock i -> BlockId
blockId (BasicBlock BlockId
blk_id [i]
_ ) = BlockId
blk_id

newtype ListGraph i = ListGraph [GenBasicBlock i]

instance Outputable instr => Outputable (ListGraph instr) where
    ppr :: ListGraph instr -> SDoc
ppr (ListGraph [GenBasicBlock instr]
blocks) = [SDoc] -> SDoc
vcat ((GenBasicBlock instr -> SDoc) -> [GenBasicBlock instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock instr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenBasicBlock instr]
blocks)

instance Outputable instr => Outputable (GenBasicBlock instr) where
    ppr :: GenBasicBlock instr -> SDoc
ppr = GenBasicBlock instr -> SDoc
forall instr. Outputable instr => GenBasicBlock instr -> SDoc
pprBBlock

pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock :: GenBasicBlock stmt -> SDoc
pprBBlock (BasicBlock BlockId
ident [stmt]
stmts) =
    SDoc -> ByteOff -> SDoc -> SDoc
hang (BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
ident SDoc -> SDoc -> SDoc
<> SDoc
colon) ByteOff
4 ([SDoc] -> SDoc
vcat ((stmt -> SDoc) -> [stmt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map stmt -> SDoc
forall a. Outputable a => a -> SDoc
ppr [stmt]
stmts))