X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=4ea7f00b6aec113e6ab24c4b3d94c31dd41e46ab;hp=c8c1f271cedcee88ebfec82e53d7f22601c3ce5c;hb=83d563cb9ede0ba792836e529b1e2929db926355;hpb=ad94d40948668032189ad22a0ad741ac1f645f50 diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index c8c1f27..4ea7f00 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -6,49 +6,48 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings --- for details - module Cmm ( - GenCmm(..), Cmm, RawCmm, - GenCmmTop(..), CmmTop, RawCmmTop, - CmmInfo(..), UpdateFrame(..), - CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag, - GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts, + GenCmm(..), Cmm, RawCmm, + GenCmmTop(..), CmmTop, RawCmmTop, + ListGraph(..), + cmmMapGraph, cmmTopMapGraph, + cmmMapGraphM, cmmTopMapGraphM, + CmmInfo(..), UpdateFrame(..), + CmmInfoTable(..), HasStaticClosure, ClosureTypeInfo(..), ConstrDescription, + ProfilingInfo(..), ClosureTypeTag, + GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts, CmmReturnInfo(..), - CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals, + CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, + HintedCmmFormal, HintedCmmFormals, HintedCmmActual, HintedCmmActuals, CmmSafety(..), - CmmCallTarget(..), - CmmStatic(..), Section(..), - CmmExpr(..), cmmExprRep, - CmmReg(..), cmmRegRep, - CmmLit(..), cmmLitRep, - LocalReg(..), localRegRep, localRegGCFollow, Kind(..), - BlockId(..), BlockEnv, - GlobalReg(..), globalRegRep, - - node, nodeReg, spReg, hpReg, spLimReg + CmmCallTarget(..), CallishMachOp(..), pprCallishMachOp, + ForeignHint(..), CmmHinted(..), + CmmStatic(..), Section(..), + module CmmExpr, ) where #include "HsVersions.h" -import MachOp +import BlockId +import CmmExpr import CLabel import ForeignCall import SMRep + import ClosureInfo -import Unique -import UniqFM +import Outputable import FastString import Data.Word + +-- A [[BlockId]] is a local label. +-- Local labels must be unique within an entire compilation unit, not +-- just a single top-level item, because local labels map one-to-one +-- with assembly-language labels. + ----------------------------------------------------------------------------- --- Cmm, CmmTop, CmmBasicBlock +-- Cmm, CmmTop, CmmBasicBlock ----------------------------------------------------------------------------- -- A file is a list of top-level chunks. These may be arbitrarily @@ -57,45 +56,48 @@ import Data.Word -- GenCmm is abstracted over -- d, the type of static data elements in CmmData -- h, the static info preceding the code of a CmmProc --- i, the contents of a basic block within 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 --- (Cmm and RawCmm below) +-- (Cmm and RawCmm below) -- (b) Native code, populated with data/instructions -- -newtype GenCmm d h i = Cmm [GenCmmTop d h i] +-- A second family of instances based on ZipCfg is work in progress. +-- +newtype GenCmm d h g = Cmm [GenCmmTop d h g] -- | 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 i +data GenCmmTop d h g = CmmProc -- A procedure h -- Extra header such as the info table CLabel -- Used to generate both info & entry labels - CmmFormals -- Argument locals live on entry (C-- procedure params) - [GenBasicBlock i] -- Code, may be empty. The first block is - -- the entry point, and should be labelled by the code gen - -- with the CLabel. The order is otherwise initially - -- unimportant, but at some point the code gen will - -- fix the order. - - -- The BlockId of the first block does not give rise - -- to a label. To jump to the first block in a Proc, - -- use the appropriate CLabel. - - -- BlockIds are only unique within a procedure + CmmFormals -- Argument locals live on entry (C-- procedure params) + -- XXX Odd that there are no kinds, but there you are ---NR + g -- Control-flow graph for the procedure's code | CmmData -- Static data Section [d] +-- | A control-flow graph represented as a list of extended basic blocks. +newtype ListGraph i = ListGraph [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 fix the order. + + -- BlockIds must be unique across an entire compilation unit, since + -- they are translated to assembly-language labels, which scope + -- across a whole compilation unit. + -- | Cmm with the info table as a data type -type Cmm = GenCmm CmmStatic CmmInfo CmmStmt -type CmmTop = GenCmmTop CmmStatic CmmInfo CmmStmt +type Cmm = GenCmm CmmStatic CmmInfo (ListGraph CmmStmt) +type CmmTop = GenCmmTop CmmStatic CmmInfo (ListGraph CmmStmt) -- | Cmm with the info tables converted to a list of 'CmmStatic' -type RawCmm = GenCmm CmmStatic [CmmStatic] CmmStmt -type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt +type RawCmm = GenCmm CmmStatic [CmmStatic] (ListGraph CmmStmt) +type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] (ListGraph CmmStmt) -- A basic block containing a single label, at the beginning. @@ -107,6 +109,9 @@ type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt data GenBasicBlock i = BasicBlock BlockId [i] type CmmBasicBlock = GenBasicBlock CmmStmt +instance UserOfLocalRegs i => UserOfLocalRegs (GenBasicBlock i) where + foldRegsUsed f set (BasicBlock _ l) = foldRegsUsed f set l + blockId :: GenBasicBlock i -> BlockId -- The branch block id is that of the first block in -- the branch, which is that branch's entry point @@ -115,7 +120,27 @@ blockId (BasicBlock blk_id _ ) = blk_id blockStmts :: GenBasicBlock i -> [i] blockStmts (BasicBlock _ stmts) = stmts + +mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i' mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs) +---------------------------------------------------------------- +-- graph maps +---------------------------------------------------------------- + +cmmMapGraph :: (g -> g') -> GenCmm d h g -> GenCmm d h g' +cmmTopMapGraph :: (g -> g') -> GenCmmTop d h g -> GenCmmTop d h g' + +cmmMapGraphM :: Monad m => (String -> g -> m g') -> GenCmm d h g -> m (GenCmm d h g') +cmmTopMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmTop d h g -> m (GenCmmTop d h g') + +cmmMapGraph f (Cmm tops) = Cmm $ map (cmmTopMapGraph f) tops +cmmTopMapGraph f (CmmProc h l args g) = CmmProc h l args (f g) +cmmTopMapGraph _ (CmmData s ds) = CmmData s ds + +cmmMapGraphM f (Cmm tops) = mapM (cmmTopMapGraphM f) tops >>= return . Cmm +cmmTopMapGraphM f (CmmProc h l args g) = + f (showSDoc $ ppr l) g >>= return . CmmProc h l args +cmmTopMapGraphM _ (CmmData s ds) = return $ CmmData s ds ----------------------------------------------------------------------------- -- Info Tables @@ -124,32 +149,39 @@ mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs) data CmmInfo = CmmInfo (Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check + -- JD: NOT USED BY NEW CODE GEN (Maybe UpdateFrame) -- Update frame CmmInfoTable -- Info table -- Info table as a haskell data type data CmmInfoTable = CmmInfoTable + HasStaticClosure ProfilingInfo ClosureTypeTag -- Int ClosureTypeInfo | CmmNonInfoTable -- Procedure doesn't need an info table +type HasStaticClosure = Bool + -- 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 + | FunInfo ClosureLayout C_SRT FunArity ArgDescr SlowEntry + | ThunkInfo ClosureLayout C_SRT | ThunkSelectorInfo SelectorOffset C_SRT | ContInfo - [Maybe LocalReg] -- Forced stack parameters + [Maybe LocalReg] -- Stack layout: Just x, an item x + -- Nothing: a 1-word gap + -- Start of list is the *young* end C_SRT data CmmReturnInfo = CmmMayReturn | CmmNeverReturns + deriving ( Eq ) -- TODO: These types may need refinement data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc @@ -157,10 +189,9 @@ type ClosureTypeTag = StgHalfWord type ClosureLayout = (StgHalfWord, StgHalfWord) -- ptrs, nptrs type ConstrTag = StgHalfWord type ConstrDescription = CmmLit -type FunType = StgHalfWord type FunArity = StgHalfWord type SlowEntry = CmmLit - -- ^We would like this to be a CLabel but + -- We would like this to be a CLabel but -- for now the parser sets this to zero on an INFO_TABLE_FUN. type SelectorOffset = StgWord @@ -178,19 +209,19 @@ data UpdateFrame = -- control to a new function. ----------------------------------------------------------------------------- -data CmmStmt +data CmmStmt -- Old-style = CmmNop | CmmComment FastString | CmmAssign CmmReg CmmExpr -- Assign to register | CmmStore CmmExpr CmmExpr -- Assign to memory location. Size is - -- given by cmmExprRep of the rhs. + -- given by cmmExprType of the rhs. | CmmCall -- A call (forign, native or primitive), with CmmCallTarget - CmmHintFormals -- zero or more results - CmmActuals -- zero or more arguments + HintedCmmFormals -- zero or more results + HintedCmmActuals -- zero or more arguments CmmSafety -- whether to build a continuation CmmReturnInfo @@ -205,17 +236,61 @@ data CmmStmt -- Undefined outside range, and when there's a Nothing | CmmJump CmmExpr -- Jump to another C-- function, - CmmActuals -- with these parameters. + HintedCmmActuals -- with these parameters. (parameters never used) | CmmReturn -- Return from a native C-- function, - CmmActuals -- with these return values. - -type CmmActual = CmmExpr -type CmmActuals = [(CmmActual,MachHint)] -type CmmFormal = LocalReg -type CmmHintFormals = [(CmmFormal,MachHint)] -type CmmFormals = [CmmFormal] -data CmmSafety = CmmUnsafe | CmmSafe C_SRT + HintedCmmActuals -- with these return values. (parameters never used) + +type CmmActual = CmmExpr +type CmmFormal = LocalReg +type CmmActuals = [CmmActual] +type CmmFormals = [CmmFormal] + +data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: ForeignHint } + deriving( Eq ) + +type HintedCmmActuals = [HintedCmmActual] +type HintedCmmFormals = [HintedCmmFormal] +type HintedCmmFormal = CmmHinted CmmFormal +type HintedCmmActual = CmmHinted CmmActual + +data CmmSafety = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible + +-- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals' +instance UserOfLocalRegs CmmStmt where + foldRegsUsed f (set::b) s = stmt s set + where + stmt :: CmmStmt -> b -> b + stmt (CmmNop) = id + stmt (CmmComment {}) = id + stmt (CmmAssign _ e) = gen e + stmt (CmmStore e1 e2) = gen e1 . gen e2 + stmt (CmmCall target _ es _ _) = gen target . gen es + stmt (CmmBranch _) = id + stmt (CmmCondBranch e _) = gen e + stmt (CmmSwitch e _) = gen e + stmt (CmmJump e es) = gen e . gen es + stmt (CmmReturn es) = gen es + + gen :: UserOfLocalRegs a => a -> b -> b + gen a set = foldRegsUsed f set a + +instance UserOfLocalRegs CmmCallTarget where + foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e + foldRegsUsed _ set (CmmPrim {}) = set + +instance UserOfSlots CmmCallTarget where + foldSlotsUsed f set (CmmCallee e _) = foldSlotsUsed f set e + foldSlotsUsed _ set (CmmPrim {}) = set + +instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where + foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a) + +instance UserOfSlots a => UserOfSlots (CmmHinted a) where + foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a) + +instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where + foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a) {- Discussion @@ -225,6 +300,10 @@ 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. +[N.B. This problem will go away when we make the transition to the +'zipper' form of control-flow graph, in which both targets of a +conditional jump are explicit. ---NR] + One possible way to fix this would be: data CmmStat = @@ -268,104 +347,54 @@ data CmmCallTarget | CmmPrim -- Call a "primitive" (eg. sin, cos) CallishMachOp -- These might be implemented as inline -- code by the backend. - ------------------------------------------------------------------------------ --- CmmExpr --- An expression. Expressions have no side effects. ------------------------------------------------------------------------------ - -data CmmExpr - = CmmLit CmmLit -- Literal - | CmmLoad CmmExpr MachRep -- Read memory location - | CmmReg CmmReg -- Contents of register - | CmmMachOp MachOp [CmmExpr] -- Machine operation (+, -, *, etc.) - | CmmRegOff CmmReg Int - -- CmmRegOff reg i - -- ** is shorthand only, meaning ** - -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep))) - -- where rep = cmmRegRep reg deriving Eq -data CmmReg - = CmmLocal LocalReg - | CmmGlobal GlobalReg - deriving( Eq ) --- | Whether a 'LocalReg' is a GC followable pointer -data Kind = KindPtr | KindNonPtr deriving (Eq) - -data LocalReg - = LocalReg - !Unique -- ^ Identifier - MachRep -- ^ Type - Kind -- ^ Should the GC follow as a pointer - -data CmmLit - = CmmInt Integer MachRep - -- Interpretation: the 2's complement representation of the value - -- is truncated to the specified size. This is easier than trying - -- to keep the value within range, because we don't know whether - -- it will be used as a signed or unsigned value (the MachRep doesn't - -- distinguish between signed & unsigned). - | CmmFloat Rational MachRep - | CmmLabel CLabel -- Address of label - | CmmLabelOff CLabel Int -- Address of label + byte offset +data ForeignHint + = NoHint | AddrHint | SignedHint + deriving( Eq ) + -- Used to give extra per-argument or per-result + -- information needed by foreign calling conventions + + +-- CallishMachOps tend to be implemented by foreign calls in some backends, +-- so we separate them out. In Cmm, these can only occur in a +-- statement position, in contrast to an ordinary MachOp which can occur +-- anywhere in an expression. +data CallishMachOp + = MO_F64_Pwr + | MO_F64_Sin + | MO_F64_Cos + | MO_F64_Tan + | MO_F64_Sinh + | MO_F64_Cosh + | MO_F64_Tanh + | MO_F64_Asin + | MO_F64_Acos + | MO_F64_Atan + | MO_F64_Log + | MO_F64_Exp + | MO_F64_Sqrt + | MO_F32_Pwr + | MO_F32_Sin + | MO_F32_Cos + | MO_F32_Tan + | MO_F32_Sinh + | MO_F32_Cosh + | MO_F32_Tanh + | MO_F32_Asin + | MO_F32_Acos + | MO_F32_Atan + | MO_F32_Log + | MO_F32_Exp + | MO_F32_Sqrt + | MO_WriteBarrier + | MO_Touch -- Keep variables live (when using interior pointers) + deriving (Eq, Show) + +pprCallishMachOp :: CallishMachOp -> SDoc +pprCallishMachOp mo = text (show mo) - -- Due to limitations in the C backend, the following - -- MUST ONLY be used inside the info table indicated by label2 - -- (label2 must be the info label), and label1 must be an - -- SRT, a slow entrypoint or a large bitmap (see the Mangler) - -- Don't use it at all unless tablesNextToCode. - -- It is also used inside the NCG during when generating - -- position-independent code. - | CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset - deriving Eq - -instance Eq LocalReg where - (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2 - -instance Uniquable LocalReg where - getUnique (LocalReg uniq _ _) = uniq - ------------------------------------------------------------------------------ --- MachRep ------------------------------------------------------------------------------ -cmmExprRep :: CmmExpr -> MachRep -cmmExprRep (CmmLit lit) = cmmLitRep lit -cmmExprRep (CmmLoad _ rep) = rep -cmmExprRep (CmmReg reg) = cmmRegRep reg -cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op -cmmExprRep (CmmRegOff reg _) = cmmRegRep reg - -cmmRegRep :: CmmReg -> MachRep -cmmRegRep (CmmLocal reg) = localRegRep reg -cmmRegRep (CmmGlobal reg) = globalRegRep reg - -localRegRep :: LocalReg -> MachRep -localRegRep (LocalReg _ rep _) = rep - -localRegGCFollow (LocalReg _ _ p) = p - -cmmLitRep :: CmmLit -> MachRep -cmmLitRep (CmmInt _ rep) = rep -cmmLitRep (CmmFloat _ rep) = rep -cmmLitRep (CmmLabel _) = wordRep -cmmLitRep (CmmLabelOff _ _) = wordRep -cmmLitRep (CmmLabelDiffOff _ _ _) = wordRep - ------------------------------------------------------------------------------ --- A local label. - --- Local labels must be unique within a single compilation unit. - -newtype BlockId = BlockId Unique - deriving (Eq,Ord) - -instance Uniquable BlockId where - getUnique (BlockId u) = u - -type BlockEnv a = UniqFM {- BlockId -} a - ----------------------------------------------------------------------------- -- Static Data ----------------------------------------------------------------------------- @@ -391,69 +420,3 @@ data CmmStatic | CmmString [Word8] -- string of 8-bit values only, not zero terminated. ------------------------------------------------------------------------------ --- Global STG registers ------------------------------------------------------------------------------ - -data GlobalReg - -- Argument and return registers - = VanillaReg -- pointers, unboxed ints and chars - {-# UNPACK #-} !Int -- its number - - | FloatReg -- single-precision floating-point registers - {-# UNPACK #-} !Int -- its number - - | DoubleReg -- double-precision floating-point registers - {-# UNPACK #-} !Int -- its number - - | LongReg -- long int registers (64-bit, really) - {-# UNPACK #-} !Int -- its number - - -- STG registers - | Sp -- Stack ptr; points to last occupied stack location. - | SpLim -- Stack limit - | Hp -- Heap ptr; points to last occupied heap location. - | HpLim -- Heap limit register - | CurrentTSO -- pointer to current thread's TSO - | CurrentNursery -- pointer to allocation area - | HpAlloc -- allocation count for heap check failure - - -- We keep the address of some commonly-called - -- functions in the register table, to keep code - -- size down: - | GCEnter1 -- stg_gc_enter_1 - | GCFun -- stg_gc_fun - - -- Base offset for the register table, used for accessing registers - -- which do not have real registers assigned to them. This register - -- will only appear after we have expanded GlobalReg into memory accesses - -- (where necessary) in the native code generator. - | BaseReg - - -- Base Register for PIC (position-independent code) calculations - -- Only used inside the native code generator. It's exact meaning differs - -- from platform to platform (see module PositionIndependentCode). - | PicBaseReg - - deriving( Eq -#ifdef DEBUG - , Show -#endif - ) - --- convenient aliases -spReg, hpReg, spLimReg, nodeReg :: CmmReg -spReg = CmmGlobal Sp -hpReg = CmmGlobal Hp -spLimReg = CmmGlobal SpLim -nodeReg = CmmGlobal node - -node :: GlobalReg -node = VanillaReg 1 - -globalRegRep :: GlobalReg -> MachRep -globalRegRep (VanillaReg _) = wordRep -globalRegRep (FloatReg _) = F32 -globalRegRep (DoubleReg _) = F64 -globalRegRep (LongReg _) = I64 -globalRegRep _ = wordRep