compiler/cmm/StackSlot.hs

   1 module StackSlot
   2     ( BlockId(..), mkBlockId    -- ToDo: BlockId should be abstract, but it isn't yet
   3     , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv
   4     , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet, sizeBlockSet, mkBlockSet
   5     , StackArea, mkStackArea, outgoingSlot
   6     , StackSlot(..)) where -- StackSlot should probably be abstract
   7 -- Why is the BlockId here? To avoid recursive module problems.
   8
   9 import Monad
  10 import Outputable
  11 import Unique
  12 import UniqFM
  13 import UniqSet
  14
  15
  16 -- A stack area is represented by three pieces:
  17 -- o The BlockId of the return site.
  18 --   Maybe during the conversion to VFP offsets, this BlockId will be the entry point.
  19 -- o The size of the outgoing parameter space
  20 -- o The size of the incoming parameter space, if the function returns
  21 data StackArea = StackArea BlockId Int (Maybe Int)
  22   deriving (Eq, Ord)
  23
  24 instance Outputable StackArea where
  25   ppr (StackArea bid f a) =
  26     text "StackArea" <+> ppr bid <+> text "[" <+> ppr f <+> text "," <+> ppr a <+> text ")"
  27
  28 -- Eventually, we'll want something proper that takes arguments and formals
  29 -- and gives you back the calling convention code, as well as the stack area.
  30 --mkStackArea :: BlockId -> CmmActuals -> CmmFormals -> (StackArea, ...)
  31 -- But for now...
  32 mkStackArea :: BlockId -> [a] -> Maybe [b] -> StackArea
  33 mkStackArea k as fs = StackArea k (length as) (liftM length fs)
  34
  35 -- A stack slot is an offset from the base of a stack area.
  36 data StackSlot = StackSlot StackArea Int
  37   deriving (Eq, Ord)
  38
  39 -- Return the last slot in the outgoing parameter area.
  40 outgoingSlot :: StackArea -> StackSlot
  41 outgoingSlot a@(StackArea _ outN _) = StackSlot a outN
  42
  43 instance Outputable StackSlot where
  44   ppr (StackSlot (StackArea bid _ _) n) =
  45     text "Stack(" <+> ppr bid <+> text "," <+> ppr n <+> text ")"
  46
  47
  48 ----------------------------------------------------------------
  49 --- Block Ids, their environments, and their sets
  50
  51 {- Note [Unique BlockId]
  52 ~~~~~~~~~~~~~~~~~~~~~~~~
  53 Although a 'BlockId' is a local label, for reasons of implementation,
  54 'BlockId's must be unique within an entire compilation unit.  The reason
  55 is that each local label is mapped to an assembly-language label, and in
  56 most assembly languages allow, a label is visible throughout the enitre
  57 compilation unit in which it appears.
  58 -}
  59
  60 newtype BlockId = BlockId Unique
  61   deriving (Eq,Ord)
  62
  63 instance Uniquable BlockId where
  64   getUnique (BlockId u) = u
  65
  66 mkBlockId :: Unique -> BlockId
  67 mkBlockId uniq = BlockId uniq
  68
  69 instance Show BlockId where
  70   show (BlockId u) = show u
  71
  72 instance Outputable BlockId where
  73   ppr = ppr . getUnique
  74
  75
  76 type BlockEnv a = UniqFM {- BlockId -} a
  77 emptyBlockEnv :: BlockEnv a
  78 emptyBlockEnv = emptyUFM
  79 mkBlockEnv :: [(BlockId,a)] -> BlockEnv a
  80 mkBlockEnv = listToUFM
  81 lookupBlockEnv :: BlockEnv a -> BlockId -> Maybe a
  82 lookupBlockEnv = lookupUFM
  83 extendBlockEnv :: BlockEnv a -> BlockId -> a -> BlockEnv a
  84 extendBlockEnv = addToUFM
  85
  86 type BlockSet = UniqSet BlockId
  87 emptyBlockSet :: BlockSet
  88 emptyBlockSet = emptyUniqSet
  89 elemBlockSet :: BlockId -> BlockSet -> Bool
  90 elemBlockSet = elementOfUniqSet
  91 extendBlockSet :: BlockSet -> BlockId -> BlockSet
  92 extendBlockSet = addOneToUniqSet
  93 mkBlockSet :: [BlockId] -> BlockSet
  94 mkBlockSet = mkUniqSet
  95 sizeBlockSet :: BlockSet -> Int
  96 sizeBlockSet = sizeUniqSet
  97