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

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 1769a01..06149b4 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -5,14 +5,19 @@ module CmmExpr
     , CmmLit(..), cmmLitRep
     , LocalReg(..), localRegRep, localRegGCFollow, GCKind(..)
     , GlobalReg(..), globalRegRep, spReg, hpReg, spLimReg, nodeReg, node
-    , UserOfLocalRegs, foldRegsUsed, filterRegsUsed
+    , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
     , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
             , plusRegSet, minusRegSet, timesRegSet
-    )
-where
+    , 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
 
@@ -31,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
@@ -62,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
 
@@ -81,13 +97,13 @@ maybeInvertCmmExpr _ = Nothing
 data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
 
 data LocalReg
-  = LocalReg
-      !Unique   -- ^ Identifier
-      MachRep   -- ^ Type
-      GCKind      -- ^ 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
@@ -106,12 +122,50 @@ 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 
 -----------------------------------------------------------------------------
 
 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)
@@ -121,9 +175,16 @@ 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)
 
@@ -134,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
 -----------------------------------------------------------------------------
@@ -151,9 +217,10 @@ 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
@@ -214,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