X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmExpr.hs;h=3149fb8ea8b6bcdc058ff098198e6bb7d422bc8f;hp=ca69178129a4d09740f7d8b173220132a4835956;hb=0d80489c9b9f2421f65d8dd86c1e50c6bb429715;hpb=724a9e83f9498382e3580d26a7dd7cd6b108408c diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs index ca69178..3149fb8 100644 --- 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