X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=903853489f14972a0b16d31f1223f85047946455;hp=13961c15d3557899cb627123f7234599d6666e3f;hb=1f46671fe24c7155ee64091b71b77dd66909e7a0;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 13961c1..9038534 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -2,35 +2,40 @@ -- -- Cmm data types -- --- (c) The University of Glasgow 2004 +-- (c) The University of Glasgow 2004-2006 -- ----------------------------------------------------------------------------- module Cmm ( - GenCmm(..), Cmm, - GenCmmTop(..), CmmTop, + GenCmm(..), Cmm, RawCmm, + GenCmmTop(..), CmmTop, RawCmmTop, + CmmInfo(..), ClosureTypeInfo(..), ProfilingInfo(..), GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, - CmmStmt(..), + CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals, CmmCallTarget(..), CmmStatic(..), Section(..), CmmExpr(..), cmmExprRep, CmmReg(..), cmmRegRep, CmmLit(..), cmmLitRep, - LocalReg(..), localRegRep, - BlockId(..), + LocalReg(..), localRegRep, localRegGCFollow, Kind(..), + BlockId(..), BlockEnv, GlobalReg(..), globalRegRep, - node, nodeReg, spReg, hpReg, + node, nodeReg, spReg, hpReg, spLimReg ) where #include "HsVersions.h" import MachOp -import CLabel ( CLabel ) -import ForeignCall ( CCallConv ) -import Unique ( Unique, Uniquable(..) ) -import FastString ( FastString ) -import DATA_WORD ( Word8 ) +import CLabel +import ForeignCall +import SMRep +import ClosureInfo +import Unique +import UniqFM +import FastString + +import Data.Word ----------------------------------------------------------------------------- -- Cmm, CmmTop, CmmBasicBlock @@ -46,17 +51,21 @@ import DATA_WORD ( Word8 ) -- (a) Plain C--, i.e. populated with CmmLit and CmmExpr respectively, -- (b) Native code, populated with instructions -- -newtype GenCmm d i = Cmm [GenCmmTop d i] +newtype GenCmm d h i = Cmm [GenCmmTop d h i] + +-- | Cmm with the info table as a data type +type Cmm = GenCmm CmmStatic CmmInfo CmmStmt -type Cmm = GenCmm CmmStatic CmmStmt +-- | Cmm with the info tables converted to a list of 'CmmStatic' +type RawCmm = GenCmm CmmStatic [CmmStatic] CmmStmt -- 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 i +data GenCmmTop d h i = CmmProc - [d] -- Info table, may be empty + h -- Extra header such as the info table CLabel -- Used to generate both info & entry labels - [LocalReg] -- Argument locals live on entry (C-- procedure params) + CmmFormals -- Argument locals live on entry (C-- procedure params) [GenBasicBlock i] -- Code, may be empty. The first block is -- the entry point. The order is otherwise initially -- unimportant, but at some point the code gen will @@ -69,7 +78,8 @@ data GenCmmTop d i -- some static data. | CmmData Section [d] -- constant values only -type CmmTop = GenCmmTop CmmStatic CmmStmt +type CmmTop = GenCmmTop CmmStatic CmmInfo CmmStmt +type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt -- A basic block containing a single label, at the beginning. -- The list of basic blocks in a top-level code block may be re-ordered. @@ -93,6 +103,43 @@ blockId (BasicBlock blk_id _ ) = blk_id blockStmts :: GenBasicBlock i -> [i] blockStmts (BasicBlock _ stmts) = stmts +----------------------------------------------------------------------------- +-- Info Tables +----------------------------------------------------------------------------- + +-- Info table as a haskell data type +data CmmInfo + = CmmInfo + ProfilingInfo + (Maybe BlockId) -- GC target + ClosureTypeTag -- Int + ClosureTypeInfo + | CmmNonInfo -- Procedure doesn't need an info table + (Maybe BlockId) -- But we still need a GC target for it + +-- TODO: The GC target shouldn't really be part of CmmInfo +-- as it doesn't appear in the resulting info table. +-- It should be factored out. + +data ClosureTypeInfo + = ConstrInfo ClosureLayout ConstrTag ConstrDescription + | FunInfo ClosureLayout C_SRT FunType FunArity ArgDescr SlowEntry + | ThunkInfo ClosureLayout C_SRT + | ThunkSelectorInfo SelectorOffset C_SRT + | ContInfo + [Maybe LocalReg] -- Forced stack parameters + C_SRT + +-- TODO: These types may need refinement +data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc +type ClosureTypeTag = StgHalfWord +type ClosureLayout = (StgHalfWord, StgHalfWord) -- pts, nptrs +type ConstrTag = StgHalfWord +type ConstrDescription = CmmLit +type FunType = StgHalfWord +type FunArity = StgHalfWord +type SlowEntry = CLabel +type SelectorOffset = StgWord ----------------------------------------------------------------------------- -- CmmStmt @@ -112,12 +159,9 @@ data CmmStmt | CmmCall -- A foreign call, with CmmCallTarget - [(CmmReg,MachHint)] -- zero or more results - [(CmmExpr,MachHint)] -- zero or more arguments - (Maybe [GlobalReg]) -- Global regs that may need to be saved - -- if they will be clobbered by the call. - -- Nothing <=> save *all* globals that - -- might be clobbered. + CmmHintFormals -- zero or more results + CmmActuals -- zero or more arguments + C_SRT -- SRT for the continuation of the call | CmmBranch BlockId -- branch to another BB in this fn @@ -129,8 +173,53 @@ data CmmStmt -- one -> second block etc -- Undefined outside range, and when there's a Nothing - | CmmJump CmmExpr [LocalReg] -- Jump to another function, with these - -- parameters. + | CmmJump CmmExpr -- Jump to another function, + CmmActuals -- with these parameters. + + | CmmReturn -- Return from a function, + CmmActuals -- with these return values. + +type CmmActual = CmmExpr +type CmmActuals = [(CmmActual,MachHint)] +type CmmFormal = LocalReg +type CmmHintFormals = [(CmmFormal,MachHint)] +type CmmFormals = [CmmFormal] + +{- +Discussion +~~~~~~~~~~ + +One possible problem with the above type is that the only way to do a +non-local conditional jump is to encode it as a branch to a block that +contains a single jump. This leads to inefficient code in the back end. + +One possible way to fix this would be: + +data CmmStat = + ... + | CmmJump CmmBranchDest + | CmmCondJump CmmExpr CmmBranchDest + ... + +data CmmBranchDest + = Local BlockId + | NonLocal CmmExpr [LocalReg] + +In favour: + ++ one fewer constructors in CmmStmt ++ allows both cond branch and switch to jump to non-local destinations + +Against: + +- not strictly necessary: can already encode as branch+jump +- not always possible to implement any better in the back end +- could do the optimisation in the back end (but then plat-specific?) +- C-- doesn't have it +- back-end optimisation might be more general (jump shortcutting) + +So we'll stick with the way it is, and add the optimisation to the NCG. +-} ----------------------------------------------------------------------------- -- CmmCallTarget @@ -163,6 +252,7 @@ data CmmExpr -- ** is shorthand only, meaning ** -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep))) -- where rep = cmmRegRep reg + deriving Eq cmmExprRep :: CmmExpr -> MachRep cmmExprRep (CmmLit lit) = cmmLitRep lit @@ -180,17 +270,25 @@ cmmRegRep :: CmmReg -> MachRep cmmRegRep (CmmLocal reg) = localRegRep reg cmmRegRep (CmmGlobal reg) = globalRegRep reg +-- | Whether a 'LocalReg' is a GC followable pointer +data Kind = KindPtr | KindNonPtr deriving (Eq) + data LocalReg - = LocalReg !Unique MachRep + = LocalReg + !Unique -- ^ Identifier + MachRep -- ^ Type + Kind -- ^ Should the GC follow as a pointer instance Eq LocalReg where - (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2 + (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2 instance Uniquable LocalReg where - getUnique (LocalReg uniq _) = uniq + getUnique (LocalReg uniq _ _) = uniq localRegRep :: LocalReg -> MachRep -localRegRep (LocalReg _ rep) = rep +localRegRep (LocalReg _ rep _) = rep + +localRegGCFollow (LocalReg _ _ p) = p data CmmLit = CmmInt Integer MachRep @@ -211,6 +309,7 @@ data CmmLit -- It is also used inside the NCG during when generating -- position-independent code. | CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset + deriving Eq cmmLitRep :: CmmLit -> MachRep cmmLitRep (CmmInt _ rep) = rep @@ -230,6 +329,8 @@ newtype BlockId = BlockId Unique instance Uniquable BlockId where getUnique (BlockId u) = u +type BlockEnv a = UniqFM {- BlockId -} a + ----------------------------------------------------------------------------- -- Static Data ----------------------------------------------------------------------------- @@ -306,9 +407,10 @@ data GlobalReg ) -- convenient aliases -spReg, hpReg, nodeReg :: CmmReg +spReg, hpReg, spLimReg, nodeReg :: CmmReg spReg = CmmGlobal Sp hpReg = CmmGlobal Hp +spLimReg = CmmGlobal SpLim nodeReg = CmmGlobal node node :: GlobalReg