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