ghc/compiler/codeGen/SMRep.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[SMRep]{Storage manager representations of closure}
   5
   6 This is here, rather than in ClosureInfo, just to keep nhc happy.
   7 Other modules should access this info through ClosureInfo.
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module SMRep (
  13         SMRep(..), SMSpecRepKind(..), SMUpdateKind(..),
  14         getSMInfoStr, getSMInitHdrStr, getSMUpdInplaceHdrStr,
  15         ltSMRepHdr,
  16         isConstantRep, isSpecRep, isStaticRep, isPhantomRep,
  17         isIntLikeRep
  18     ) where
  19
  20 IMP_Ubiq(){-uitous-}
  21
  22 import Pretty           ( text )
  23 import Util             ( panic )
  24 #if __GLASGOW_HASKELL__ >= 202
  25 import Outputable
  26 #endif
  27 \end{code}
  28
  29 %************************************************************************
  30 %*                                                                      *
  31 \subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
  32 %*                                                                      *
  33 %************************************************************************
  34
  35 Ways in which a closure may be represented by the storage manager;
  36 this list slavishly follows the storage-manager interface document.
  37
  38 \begin{code}
  39 data SMSpecRepKind
  40   = SpecRep             -- Normal Spec representation
  41
  42   | ConstantRep         -- Common me up with single global copy
  43                         -- Used for nullary constructors
  44
  45   | CharLikeRep         -- Common me up with entry from global table
  46
  47   | IntLikeRep          -- Common me up with entry from global table,
  48                         -- if the intlike field is in range.
  49
  50 data SMUpdateKind
  51   = SMNormalForm        -- Normal form, no update
  52   | SMSingleEntry       -- Single entry thunk, non-updatable
  53   | SMUpdatable         -- Shared thunk, updatable
  54
  55 data SMRep
  56   = StaticRep           -- Don't move me, Oh garbage collector!
  57                         -- Used for all statically-allocated closures.
  58         Int             -- # ptr words (useful for interpreter, debugger, etc)
  59         Int             -- # non-ptr words
  60
  61   | SpecialisedRep      -- GC routines know size etc
  62                         -- All have same _HS = SPEC_HS and no _VHS
  63         SMSpecRepKind   -- Which kind of specialised representation
  64         Int             -- # ptr words
  65         Int             -- # non-ptr words
  66         SMUpdateKind    -- Updatable?
  67
  68   | GenericRep          -- GC routines consult sizes in info tbl
  69         Int             -- # ptr words
  70         Int             -- # non-ptr words
  71         SMUpdateKind    -- Updatable?
  72
  73   | BigTupleRep         -- All ptrs, size in var-hdr field
  74                         -- Used for big tuples
  75         Int             -- # ptr words
  76
  77   | DataRep             -- All non-ptrs, size in var-hdr field
  78                         -- Used for arbitrary-precision integers, strings
  79         Int             -- # non-ptr words
  80
  81   | DynamicRep          -- Size and # ptrs in var-hdr field
  82                         -- Used by RTS for partial applications
  83
  84   | BlackHoleRep        -- for black hole closures
  85
  86   | PhantomRep          -- for "phantom" closures that only exist in registers
  87
  88   | MuTupleRep          -- All ptrs, size in var-hdr field
  89                         -- Used for mutable tuples
  90         Int             -- # ptr words
  91
  92 {- Mattson review:
  93
  94 To: simonpj@dcs.gla.ac.uk, partain@dcs.gla.ac.uk
  95 Cc: kh@dcs.gla.ac.uk, trinder@dcs.gla.ac.uk, areid@dcs.gla.ac.uk
  96 Subject: Correct me if I'm wrong...
  97 Date: Fri, 17 Feb 1995 18:09:00 +0000
  98 From: Jim Mattson <mattson@dcs.gla.ac.uk>
  99
 100 BigTupleRep == TUPLE
 101
 102     Never generated by the compiler, and only used in the RTS when
 103     mutuples don't require special attention at GC time (e.g. 2s)
 104     When it is used, it is a primitive object (never entered).
 105     May be mutable...probably should never be used in the parallel
 106     system, since we need to distinguish mutables from immutables when
 107     deciding whether to copy or move closures across processors.
 108
 109 DataRep == DATA (aka MutableByteArray & ByteArray)
 110     Never generated by the compiler, and only used in the RTS for
 111     ArrayOfData.  Always a primitive object (never entered).  May
 112     be mutable...though we don't distinguish between mutable and
 113     immutable data arrays in the sequential world, it would probably
 114     be useful in the parallel world to know when it is safe to just
 115     copy one of these.  I believe the hooks are in place for changing
 116     the InfoPtr on a MutableByteArray when it's frozen to a ByteArray
 117     if we want to do so.
 118
 119 DynamicRep == DYN
 120     Never generated by the compiler, and only used in the RTS for
 121     PAPs and the Stable Pointer table.  PAPs are non-primitive,
 122     non-updatable, normal-form objects, but the SPT is a primitive,
 123     mutable object.  At the moment, there is no SPT in the parallel
 124     world.  Presumably, it would be possible to have an SPT on each
 125     processor, and we could identify a stable pointer as a (processor,
 126     SPT-entry) pair, but would it be worth it?
 127
 128 MuTupleRep == MUTUPLE
 129     Never generated by the compiler, and only used in the RTS when
 130     mutuples *do* require special attention at GC time.
 131     When it is used, it is a primitive object (never entered).
 132     Always mutable...there is an IMMUTUPLE in the RTS, but no
 133     corresponding type in the compiler.
 134
 135 --jim
 136 -}
 137 \end{code}
 138
 139 \begin{code}
 140 isConstantRep, isSpecRep, isStaticRep, isPhantomRep, isIntLikeRep :: SMRep -> Bool
 141 isConstantRep (SpecialisedRep ConstantRep _ _ _)   = True
 142 isConstantRep other                                = False
 143
 144 isSpecRep (SpecialisedRep kind _ _ _)   = True    -- All the kinds of Spec closures
 145 isSpecRep other                         = False   -- True indicates that the _VHS is 0 !
 146
 147 isStaticRep (StaticRep _ _) = True
 148 isStaticRep _               = False
 149
 150 isPhantomRep PhantomRep = True
 151 isPhantomRep _          = False
 152
 153 isIntLikeRep (SpecialisedRep IntLikeRep _ _ _)   = True
 154 isIntLikeRep other                               = False
 155 \end{code}
 156
 157 \begin{code}
 158 instance Eq SMRep where
 159     (SpecialisedRep k1 a1 b1 _) == (SpecialisedRep k2 a2 b2 _) = (tagOf_SMSpecRepKind k1) _EQ_ (tagOf_SMSpecRepKind k2)
 160                                                                && a1 == a2 && b1 == b2
 161     (GenericRep a1 b1 _)      == (GenericRep a2 b2 _)      = a1 == a2 && b1 == b2
 162     (BigTupleRep a1)          == (BigTupleRep a2)          = a1 == a2
 163     (MuTupleRep a1)           == (MuTupleRep a2)           = a1 == a2
 164     (DataRep a1)              == (DataRep a2)              = a1 == a2
 165     a                         == b                         = (tagOf_SMRep a) _EQ_ (tagOf_SMRep b)
 166
 167 ltSMRepHdr :: SMRep -> SMRep -> Bool
 168 a `ltSMRepHdr` b = (tagOf_SMRep a) _LT_ (tagOf_SMRep b)
 169
 170 instance Ord SMRep where
 171     -- ToDo: cmp-ify?  This instance seems a bit weird (WDP 94/10)
 172     rep1 <= rep2 = rep1 < rep2 || rep1 == rep2
 173     rep1 < rep2
 174       = let tag1 = tagOf_SMRep rep1
 175             tag2 = tagOf_SMRep rep2
 176         in
 177         if      tag1 _LT_ tag2 then True
 178         else if tag1 _GT_ tag2 then False
 179         else {- tags equal -}    rep1 `lt` rep2
 180       where
 181         (SpecialisedRep k1 a1 b1 _) `lt` (SpecialisedRep k2 a2 b2 _) =
 182                 t1 _LT_ t2 || (t1 _EQ_ t2 && (a1 < a2 || (a1 == a2 && b1 < b2)))
 183                 where t1 = tagOf_SMSpecRepKind k1
 184                       t2 = tagOf_SMSpecRepKind k2
 185         (GenericRep a1 b1 _)      `lt` (GenericRep a2 b2 _)      = a1 < a2 || (a1 == a2 && b1 < b2)
 186         (BigTupleRep a1)          `lt` (BigTupleRep a2)          = a1 < a2
 187         (MuTupleRep a1)           `lt` (MuTupleRep a2)           = a1 < a2
 188         (DataRep a1)              `lt` (DataRep a2)              = a1 < a2
 189         a                         `lt` b                         = True
 190
 191 tagOf_SMSpecRepKind SpecRep     = (ILIT(1) :: FAST_INT)
 192 tagOf_SMSpecRepKind ConstantRep = ILIT(2)
 193 tagOf_SMSpecRepKind CharLikeRep = ILIT(3)
 194 tagOf_SMSpecRepKind IntLikeRep  = ILIT(4)
 195
 196 tagOf_SMRep (StaticRep _ _)          = (ILIT(1) :: FAST_INT)
 197 tagOf_SMRep (SpecialisedRep k _ _ _) = ILIT(2)
 198 tagOf_SMRep (GenericRep _ _ _)       = ILIT(3)
 199 tagOf_SMRep (BigTupleRep _)          = ILIT(4)
 200 tagOf_SMRep (DataRep _)              = ILIT(5)
 201 tagOf_SMRep DynamicRep               = ILIT(6)
 202 tagOf_SMRep BlackHoleRep             = ILIT(7)
 203 tagOf_SMRep PhantomRep               = ILIT(8)
 204 tagOf_SMRep (MuTupleRep _)           = ILIT(9)
 205
 206 instance Text SMRep where
 207     showsPrec d rep
 208       = showString (case rep of
 209            StaticRep _ _                         -> "STATIC"
 210            SpecialisedRep kind _ _ SMNormalForm  -> "SPEC_N"
 211            SpecialisedRep kind _ _ SMSingleEntry -> "SPEC_S"
 212            SpecialisedRep kind _ _ SMUpdatable   -> "SPEC_U"
 213            GenericRep _ _ SMNormalForm           -> "GEN_N"
 214            GenericRep _ _ SMSingleEntry          -> "GEN_S"
 215            GenericRep _ _ SMUpdatable            -> "GEN_U"
 216            BigTupleRep _                         -> "TUPLE"
 217            DataRep       _                       -> "DATA"
 218            DynamicRep                            -> "DYN"
 219            BlackHoleRep                          -> "BH"
 220            PhantomRep                            -> "INREGS"
 221            MuTupleRep _                          -> "MUTUPLE")
 222
 223 instance Outputable SMRep where
 224     ppr sty rep = text (show rep)
 225
 226 getSMInfoStr :: SMRep -> String
 227 getSMInfoStr (StaticRep _ _)                            = "STATIC"
 228 getSMInfoStr (SpecialisedRep ConstantRep _ _ _)         = "CONST"
 229 getSMInfoStr (SpecialisedRep CharLikeRep _ _ _)         = "CHARLIKE"
 230 getSMInfoStr (SpecialisedRep IntLikeRep _ _ _)          = "INTLIKE"
 231 getSMInfoStr (SpecialisedRep SpecRep _ _ SMNormalForm)  = "SPEC_N"
 232 getSMInfoStr (SpecialisedRep SpecRep _ _ SMSingleEntry) = "SPEC_S"
 233 getSMInfoStr (SpecialisedRep SpecRep _ _ SMUpdatable)   = "SPEC_U"
 234 getSMInfoStr (GenericRep _ _ SMNormalForm)              = "GEN_N"
 235 getSMInfoStr (GenericRep _ _ SMSingleEntry)             = "GEN_S"
 236 getSMInfoStr (GenericRep _ _ SMUpdatable)               = "GEN_U"
 237 getSMInfoStr (BigTupleRep _)                            = "TUPLE"
 238 getSMInfoStr (DataRep _ )                               = "DATA"
 239 getSMInfoStr DynamicRep                                 = "DYN"
 240 getSMInfoStr BlackHoleRep                               = panic "getSMInfoStr.BlackHole"
 241 getSMInfoStr PhantomRep                                 = "INREGS"
 242 getSMInfoStr (MuTupleRep _)                             = "MUTUPLE"
 243
 244 getSMInitHdrStr :: SMRep -> String
 245 getSMInitHdrStr (SpecialisedRep IntLikeRep _ _ _)  = "SET_INTLIKE"
 246 getSMInitHdrStr (SpecialisedRep SpecRep _ _ _)     = "SET_SPEC"
 247 getSMInitHdrStr (GenericRep _ _ _)                 = "SET_GEN"
 248 getSMInitHdrStr (BigTupleRep _)                    = "SET_TUPLE"
 249 getSMInitHdrStr (DataRep _ )                       = "SET_DATA"
 250 getSMInitHdrStr DynamicRep                         = "SET_DYN"
 251 getSMInitHdrStr BlackHoleRep                       = "SET_BH"
 252 #ifdef DEBUG
 253 getSMInitHdrStr (StaticRep _ _)                    = panic "getSMInitHdrStr.Static"
 254 getSMInitHdrStr PhantomRep                         = panic "getSMInitHdrStr.Phantom"
 255 getSMInitHdrStr (MuTupleRep _)                     = panic "getSMInitHdrStr.Mutuple"
 256 getSMInitHdrStr (SpecialisedRep ConstantRep _ _ _) = panic "getSMInitHdrStr.Constant"
 257 getSMInitHdrStr (SpecialisedRep CharLikeRep _ _ _) = panic "getSMInitHdrStr.CharLike"
 258 #endif
 259
 260 getSMUpdInplaceHdrStr :: SMRep -> String
 261 getSMUpdInplaceHdrStr (SpecialisedRep ConstantRep _ _ _) = "INPLACE_UPD"
 262 getSMUpdInplaceHdrStr (SpecialisedRep CharLikeRep _ _ _) = "INPLACE_UPD"
 263 getSMUpdInplaceHdrStr (SpecialisedRep IntLikeRep _ _ _)  = "INPLACE_UPD"
 264 getSMUpdInplaceHdrStr (SpecialisedRep SpecRep _ _ _)     = "INPLACE_UPD"
 265 #ifdef DEBUG
 266 getSMUpdInplaceHdrStr (StaticRep _ _)                    = panic "getSMUpdInplaceHdrStr.Static"
 267 getSMUpdInplaceHdrStr (GenericRep _ _ _)                 = panic "getSMUpdInplaceHdrStr.Generic"
 268 getSMUpdInplaceHdrStr (BigTupleRep _ )                   = panic "getSMUpdInplaceHdrStr.BigTuple"
 269 getSMUpdInplaceHdrStr (DataRep _ )                       = panic "getSMUpdInplaceHdrStr.Data"
 270 getSMUpdInplaceHdrStr DynamicRep                         = panic "getSMUpdInplaceHdrStr.Dynamic"
 271 getSMUpdInplaceHdrStr BlackHoleRep                       = panic "getSMUpdInplaceHdrStr.BlackHole"
 272 getSMUpdInplaceHdrStr PhantomRep                         = panic "getSMUpdInplaceHdrStr.Phantom"
 273 getSMUpdInplaceHdrStr (MuTupleRep _ )                    = panic "getSMUpdInplaceHdrStr.MuTuple"
 274 #endif
 275 \end{code}