Replacing copyins and copyouts with data-movement instructions

[ghc-hetmet.git] / compiler / cmm / CmmExpr.hs

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index ca69178..3149fb8 100644 (file)
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -8,19 +8,18 @@ module CmmExpr
     , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
     , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
             , plusRegSet, minusRegSet, timesRegSet
-    , StackSlotMap, getSlot
-    )
-where
+    , Area(..), StackSlotMap, getSlot, mkCallArea, outgoingSlot, areaId, areaSize
+    ) where
 
+import BlockId
 import CLabel
 import FiniteMap
 import MachOp
+import Maybes
 import Monad
 import Panic
-import StackSlot
 import Unique
 import UniqSet
-import UniqSupply
 
 -----------------------------------------------------------------------------
 --             CmmExpr
@@ -37,14 +36,21 @@ 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
-  | CmmStack  StackSlot
   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
        -- Interpretation: the 2's complement representation of the value
@@ -119,19 +125,35 @@ timesRegSet      = intersectUniqSets
 --    Stack slots
 -----------------------------------------------------------------------------
 
-mkVarSlot :: Unique -> CmmReg -> StackSlot
-mkVarSlot id r = StackSlot (mkStackArea (mkBlockId id) [r] Nothing) 0
+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 CmmReg StackSlot
-getSlot :: MonadUnique m => StackSlotMap -> CmmReg -> m (StackSlotMap, StackSlot)
+type StackSlotMap = FiniteMap LocalReg CmmExpr
+getSlot :: StackSlotMap -> LocalReg -> (StackSlotMap, CmmExpr)
 getSlot map r = case lookupFM map r of
-                  Just s  -> return (map, s)
-                  Nothing -> do id <- getUniqueM
-                                let s = mkVarSlot id r
-                                return (addToFM map r s, s)
+                  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
 
 
 -----------------------------------------------------------------------------
@@ -152,12 +174,10 @@ filterRegsUsed p e =
 instance UserOfLocalRegs CmmReg where
     foldRegsUsed f z (CmmLocal reg) = f z reg
     foldRegsUsed _ z (CmmGlobal _)  = z
-    foldRegsUsed _ z (CmmStack _)  = z
 
 instance DefinerOfLocalRegs CmmReg where
     foldRegsDefd f z (CmmLocal reg) = f z reg
     foldRegsDefd _ z (CmmGlobal _)  = z
-    foldRegsDefd _ z (CmmStack _)  = z
 
 instance UserOfLocalRegs LocalReg where
     foldRegsUsed f z r = f z r
@@ -175,6 +195,7 @@ 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
@@ -196,11 +217,11 @@ 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 (CmmGlobal reg)      = globalRegRep reg
-cmmRegRep (CmmStack  _)          = panic "cmmRegRep not yet defined on stack slots"
 
 localRegRep :: LocalReg -> MachRep
 localRegRep (LocalReg _ rep _) = rep