X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmExpr.hs;h=06149b490d6d353d869ced6a4e6d8fb94544a920;hb=649d5ed52989f429d10283940793a06111aa8468;hp=78ff79a20b8b7b3a5833627a8cc9126c7f95bc52;hpb=95c5ef95d4a904d3564a62859833bce539ce5ea1;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 78ff79a..06149b4 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -1,19 +1,23 @@
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
 
 module CmmExpr
     ( CmmExpr(..), cmmExprRep, maybeInvertCmmExpr
     , CmmReg(..), cmmRegRep
     , CmmLit(..), cmmLitRep
-    , LocalReg(..), localRegRep, localRegGCFollow, Kind(..)
+    , LocalReg(..), localRegRep, localRegGCFollow, GCKind(..)
     , GlobalReg(..), globalRegRep, spReg, hpReg, spLimReg, nodeReg, node
-    , UserOfLocalRegs, foldRegsUsed
+    , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
     , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
-            , plusRegSet, minusRegSet
-    )
-where
+            , plusRegSet, minusRegSet, timesRegSet
+    , Area(..), StackSlotMap, getSlot, mkCallArea, outgoingSlot, areaId, areaSize
+    ) where
 
+import BlockId
 import CLabel
+import FiniteMap
 import MachOp
+import Maybes
+import Monad
+import Panic
 import Unique
 import UniqSet
 
@@ -32,12 +36,20 @@ data CmmExpr
 	--        ** is shorthand only, meaning **
 	-- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
 	--	where rep = cmmRegRep reg
+  | CmmStackSlot Area Int
   deriving Eq
 
 data CmmReg 
   = CmmLocal  LocalReg
   | CmmGlobal GlobalReg
-  deriving( Eq )
+  deriving( Eq, Ord )
+
+-- | A stack area is either the stack slot where a variable is spilled
+-- or the stack space where function arguments and results are passed.
+data Area
+  = RegSlot  LocalReg
+  | CallArea BlockId Int Int
+  deriving (Eq, Ord)
 
 data CmmLit
   = CmmInt Integer  MachRep
@@ -63,6 +75,9 @@ data CmmLit
 instance Eq LocalReg where
   (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
 
+instance Ord LocalReg where
+  compare (LocalReg u1 _ _) (LocalReg u2 _ _) = compare u1 u2
+
 instance Uniquable LocalReg where
   getUnique (LocalReg uniq _ _) = uniq
 
@@ -79,23 +94,23 @@ maybeInvertCmmExpr _ = Nothing
 -----------------------------------------------------------------------------
 
 -- | Whether a 'LocalReg' is a GC followable pointer
-data Kind = KindPtr | KindNonPtr deriving (Eq)
+data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
 
 data LocalReg
-  = LocalReg
-      !Unique   -- ^ Identifier
-      MachRep   -- ^ Type
-      Kind      -- ^ Should the GC follow as a pointer
-
--- | Sets of local registers
+  = LocalReg !Unique MachRep GCKind
+    -- ^ Parameters:
+    --   1. Identifier
+    --   2. Type
+    --   3. Should the GC follow as a pointer
 
+--  Sets of local registers
 type RegSet              =  UniqSet LocalReg
 emptyRegSet             :: RegSet
 elemRegSet              :: LocalReg -> RegSet -> Bool
 extendRegSet            :: RegSet -> LocalReg -> RegSet
 deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
 mkRegSet                :: [LocalReg] -> RegSet
-minusRegSet, plusRegSet :: RegSet -> RegSet -> RegSet
+minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
 
 emptyRegSet      = emptyUniqSet
 elemRegSet       = elementOfUniqSet
@@ -104,6 +119,42 @@ deleteFromRegSet = delOneFromUniqSet
 mkRegSet         = mkUniqSet
 minusRegSet      = minusUniqSet
 plusRegSet       = unionUniqSets
+timesRegSet      = intersectUniqSets
+
+-----------------------------------------------------------------------------
+--    Stack slots
+-----------------------------------------------------------------------------
+
+mkVarSlot :: LocalReg -> CmmExpr
+mkVarSlot r = CmmStackSlot (RegSlot r) 0
+
+-- Usually, we either want to lookup a variable's spill slot in an environment
+-- or else allocate it and add it to the environment.
+-- For a variable, we just need a single area of the appropriate size.
+type StackSlotMap = FiniteMap LocalReg CmmExpr
+getSlot :: StackSlotMap -> LocalReg -> (StackSlotMap, CmmExpr)
+getSlot map r = case lookupFM map r of
+                  Just s  -> (map, s)
+                  Nothing -> (addToFM map r s, s) where s = mkVarSlot r
+
+-- Eventually, we'll want something proper that takes arguments and formals
+-- and gives you back the calling convention code, as well as the stack area.
+mkCallArea :: BlockId -> [a] -> Maybe [b] -> Area
+mkCallArea id as fs = CallArea id (length as) (liftM length fs `orElse` 0)
+
+-- Return the last slot in the outgoing parameter area.
+outgoingSlot :: Area -> CmmExpr
+outgoingSlot a@(RegSlot _) = CmmStackSlot a 0
+outgoingSlot a@(CallArea _ outN _) = CmmStackSlot a outN
+
+areaId :: Area -> BlockId
+areaId (RegSlot _) = panic "Register stack slots don't have IDs!"
+areaId (CallArea id _ _) = id
+
+areaSize :: Area -> Int
+areaSize (RegSlot _) = 1
+areaSize (CallArea _ outN inN) = max outN inN
+
 
 -----------------------------------------------------------------------------
 --    Register-use information for expressions and other types 
@@ -112,13 +163,31 @@ plusRegSet       = unionUniqSets
 class UserOfLocalRegs a where
   foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
 
+class DefinerOfLocalRegs a where
+  foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
+
+filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
+filterRegsUsed p e =
+    foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
+                 emptyRegSet e
+
 instance UserOfLocalRegs CmmReg where
     foldRegsUsed f z (CmmLocal reg) = f z reg
     foldRegsUsed _ z (CmmGlobal _)  = z
 
+instance DefinerOfLocalRegs CmmReg where
+    foldRegsDefd f z (CmmLocal reg) = f z reg
+    foldRegsDefd _ z (CmmGlobal _)  = z
+
 instance UserOfLocalRegs LocalReg where
     foldRegsUsed f z r = f z r
 
+instance DefinerOfLocalRegs LocalReg where
+    foldRegsDefd f z r = f z r
+
+instance UserOfLocalRegs RegSet where
+    foldRegsUsed f = foldUniqSet (flip f)
+
 instance UserOfLocalRegs CmmExpr where
   foldRegsUsed f z e = expr z e
     where expr z (CmmLit _)          = z
@@ -126,11 +195,16 @@ instance UserOfLocalRegs CmmExpr where
           expr z (CmmReg r)          = foldRegsUsed f z r
           expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
           expr z (CmmRegOff r _)     = foldRegsUsed f z r
+          expr z (CmmStackSlot _ _)  = z
 
 instance UserOfLocalRegs a => UserOfLocalRegs [a] where
   foldRegsUsed _ set [] = set
   foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
 
+instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
+  foldRegsDefd _ set [] = set
+  foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
+
 -----------------------------------------------------------------------------
 --		MachRep
 -----------------------------------------------------------------------------
@@ -143,16 +217,17 @@ cmmExprRep (CmmLoad _ rep)   = rep
 cmmExprRep (CmmReg reg)      = cmmRegRep reg
 cmmExprRep (CmmMachOp op _)  = resultRepOfMachOp op
 cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
+cmmExprRep (CmmStackSlot _ _) = wordRep
 
 cmmRegRep :: CmmReg -> MachRep
-cmmRegRep (CmmLocal  reg) 	= localRegRep reg
+cmmRegRep (CmmLocal  reg) = localRegRep reg
 cmmRegRep (CmmGlobal reg)	= globalRegRep reg
 
 localRegRep :: LocalReg -> MachRep
 localRegRep (LocalReg _ rep _) = rep
 
 
-localRegGCFollow :: LocalReg -> Kind
+localRegGCFollow :: LocalReg -> GCKind
 localRegGCFollow (LocalReg _ _ p) = p
 
 cmmLitRep :: CmmLit -> MachRep
@@ -206,7 +281,7 @@ data GlobalReg
   -- from platform to platform (see module PositionIndependentCode).
   | PicBaseReg
 
-  deriving( Eq , Show )
+  deriving( Eq, Ord, Show )
 
 -- convenient aliases
 spReg, hpReg, spLimReg, nodeReg :: CmmReg