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