-- Cmm representations using Hoopl's Graph CmmNode e x.
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}


module GHC.Cmm (
     -- * Cmm top-level datatypes
     CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,
     CmmDecl, CmmDeclSRTs, GenCmmDecl(..),
     CmmGraph, GenCmmGraph(..),
     CmmBlock, RawCmmDecl,
     Section(..), SectionType(..),
     GenCmmStatics(..), type CmmStatics, type RawCmmStatics, CmmStatic(..),
     SectionProtection(..), sectionProtection,

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

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

     -- * Statements, expressions and types
     module GHC.Cmm.Node,
     module GHC.Cmm.Expr,
  ) where

import GHC.Prelude

import GHC.Types.Id
import GHC.Types.CostCentre
import GHC.Cmm.CLabel
import GHC.Cmm.BlockId
import GHC.Cmm.Node
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Expr
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Utils.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]
-- | Cmm group before SRT generation
type CmmGroup     = GenCmmGroup CmmStatics    CmmTopInfo               CmmGraph
-- | Cmm group with SRTs
type CmmGroupSRTs = GenCmmGroup RawCmmStatics CmmTopInfo               CmmGraph
-- | "Raw" cmm group (TODO (osa): not sure what that means)
type RawCmmGroup  = GenCmmGroup RawCmmStatics (LabelMap RawCmmStatics) 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

  deriving (forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
forall d h a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
forall d h a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
$c<$ :: forall d h a b. a -> GenCmmDecl d h b -> GenCmmDecl d h a
fmap :: forall a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
$cfmap :: forall d h a b. (a -> b) -> GenCmmDecl d h a -> GenCmmDecl d h b
Functor)

type CmmDecl     = GenCmmDecl CmmStatics    CmmTopInfo CmmGraph
type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph

type RawCmmDecl
   = GenCmmDecl
        RawCmmStatics
        (LabelMap RawCmmStatics)
        CmmGraph

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

type CmmGraph = GenCmmGraph CmmNode
data GenCmmGraph n = CmmGraph { forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> BlockId
g_entry :: BlockId, forall (n :: Extensibility -> Extensibility -> *).
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 :: forall a (n :: Extensibility -> Extensibility -> *).
GenCmmDecl a CmmTopInfo (GenCmmGraph n) -> Maybe CmmInfoTable
topInfoTable (CmmProc CmmTopInfo
infos CLabel
_ [GlobalReg]
_ GenCmmGraph n
g) = forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup (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)
_                     = 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 -> 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
        -- GHC.Cmm.Info.Build, 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
        -- GHC.Cmm.Info.Build.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
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)

data SectionProtection
  = ReadWriteSection
  | ReadOnlySection
  | WriteProtectedSection -- See Note [Relocatable Read-Only Data]
  deriving (SectionProtection -> SectionProtection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SectionProtection -> SectionProtection -> Bool
$c/= :: SectionProtection -> SectionProtection -> Bool
== :: SectionProtection -> SectionProtection -> Bool
$c== :: SectionProtection -> SectionProtection -> Bool
Eq)

-- | Should a data in this section be considered constant at runtime
sectionProtection :: Section -> SectionProtection
sectionProtection :: Section -> SectionProtection
sectionProtection (Section SectionType
t CLabel
_) = case SectionType
t of
    SectionType
Text                    -> SectionProtection
ReadOnlySection
    SectionType
ReadOnlyData            -> SectionProtection
ReadOnlySection
    SectionType
RelocatableReadOnlyData -> SectionProtection
WriteProtectedSection
    SectionType
ReadOnlyData16          -> SectionProtection
ReadOnlySection
    SectionType
CString                 -> SectionProtection
ReadOnlySection
    SectionType
Data                    -> SectionProtection
ReadWriteSection
    SectionType
UninitialisedData       -> SectionProtection
ReadWriteSection
    (OtherSection String
_)        -> SectionProtection
ReadWriteSection

{-
Note [Relocatable Read-Only Data]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Relocatable data are only read-only after relocation at the start of the
program. They should be writable from the source code until then. Failure to
do so would end up in segfaults at execution when using linkers that do not
enforce writability of those sections, such as the gold linker.
-}

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.
  | CmmFileEmbed FilePath
        -- ^ an embedded binary file

instance Outputable CmmStatic where
  ppr :: CmmStatic -> SDoc
ppr (CmmStaticLit CmmLit
lit) = String -> SDoc
text String
"CmmStaticLit" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr CmmLit
lit
  ppr (CmmUninitialised ByteOff
n) = String -> SDoc
text String
"CmmUninitialised" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr ByteOff
n
  ppr (CmmString ByteString
_) = String -> SDoc
text String
"CmmString"
  ppr (CmmFileEmbed String
fp) = String -> SDoc
text String
"CmmFileEmbed" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
fp

-- Static data before SRT generation
data GenCmmStatics (rawOnly :: Bool) where
    CmmStatics
      :: CLabel       -- Label of statics
      -> CmmInfoTable
      -> CostCentreStack
      -> [CmmLit]     -- Payload
      -> GenCmmStatics 'False

    -- | Static data, after SRTs are generated
    CmmStaticsRaw
      :: CLabel       -- Label of statics
      -> [CmmStatic]  -- The static data itself
      -> GenCmmStatics a

type CmmStatics    = GenCmmStatics 'False
type RawCmmStatics = GenCmmStatics 'True

-- -----------------------------------------------------------------------------
-- 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]
   deriving (forall a b. a -> GenBasicBlock b -> GenBasicBlock a
forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GenBasicBlock b -> GenBasicBlock a
$c<$ :: forall a b. a -> GenBasicBlock b -> GenBasicBlock a
fmap :: forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
$cfmap :: forall a b. (a -> b) -> GenBasicBlock a -> GenBasicBlock b
Functor)


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

newtype ListGraph i
   = ListGraph [GenBasicBlock i]
   deriving (forall a b. a -> ListGraph b -> ListGraph a
forall a b. (a -> b) -> ListGraph a -> ListGraph b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ListGraph b -> ListGraph a
$c<$ :: forall a b. a -> ListGraph b -> ListGraph a
fmap :: forall a b. (a -> b) -> ListGraph a -> ListGraph b
$cfmap :: forall a b. (a -> b) -> ListGraph a -> ListGraph b
Functor)

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

instance OutputableP env instr => OutputableP env (ListGraph instr) where
    pdoc :: env -> ListGraph instr -> SDoc
pdoc env
env ListGraph instr
g = forall a. Outputable a => a -> SDoc
ppr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) ListGraph instr
g)


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

instance OutputableP env instr => OutputableP env (GenBasicBlock instr) where
    pdoc :: env -> GenBasicBlock instr -> SDoc
pdoc env
env GenBasicBlock instr
block = forall a. Outputable a => a -> SDoc
ppr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall env a. OutputableP env a => env -> a -> SDoc
pdoc env
env) GenBasicBlock instr
block)

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