ghc/compiler/codeGen/SMRep.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   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 -- UNUSED, equivSMRepHdr
  16     ) where
  17
  18 import Outputable
  19 import Pretty
  20 import Util
  21 \end{code}
  22
  23 %************************************************************************
  24 %*                                                                      *
  25 \subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
  26 %*                                                                      *
  27 %************************************************************************
  28
  29 Ways in which a closure may be represented by the storage manager;
  30 this list slavishly follows the storage-manager interface document.
  31
  32 \begin{code}
  33 data SMSpecRepKind
  34   = SpecRep             -- Normal Spec representation
  35
  36   | ConstantRep         -- Common me up with single global copy
  37                         -- Used for nullary constructors
  38
  39   | CharLikeRep         -- Common me up with entry from global table
  40
  41   | IntLikeRep          -- Common me up with entry from global table,
  42                         -- if the intlike field is in range.
  43
  44 data SMUpdateKind
  45   = SMNormalForm        -- Normal form, no update
  46   | SMSingleEntry       -- Single entry thunk, non-updatable
  47   | SMUpdatable         -- Shared thunk, updatable
  48
  49 data SMRep
  50   = StaticRep           -- Don't move me, Oh garbage collector!
  51                         -- Used for all statically-allocated closures.
  52         Int             -- # ptr words (useful for interpreter, debugger, etc)
  53         Int             -- # non-ptr words
  54
  55   | SpecialisedRep      -- GC routines know size etc
  56                         -- All have same _HS = SPEC_HS and no _VHS
  57         SMSpecRepKind   -- Which kind of specialised representation
  58         Int             -- # ptr words
  59         Int             -- # non-ptr words
  60         SMUpdateKind    -- Updatable?
  61
  62   | GenericRep          -- GC routines consult sizes in info tbl
  63         Int             -- # ptr words
  64         Int             -- # non-ptr words
  65         SMUpdateKind    -- Updatable?
  66
  67   | BigTupleRep         -- All ptrs, size in var-hdr field
  68                         -- Used for big tuples
  69         Int             -- # ptr words
  70
  71   | DataRep             -- All non-ptrs, size in var-hdr field
  72                         -- Used for arbitrary-precision integers, strings
  73         Int             -- # non-ptr words
  74
  75   | DynamicRep          -- Size and # ptrs in var-hdr field
  76                         -- Used by RTS for partial applications
  77
  78   | BlackHoleRep        -- for black hole closures
  79
  80   | PhantomRep          -- for "phantom" closures that only exist in registers
  81
  82   | MuTupleRep          -- All ptrs, size in var-hdr field
  83                         -- Used for mutable tuples
  84         Int             -- # ptr words
  85
  86 instance Eq SMRep where
  87     (SpecialisedRep k1 a1 b1 _) == (SpecialisedRep k2 a2 b2 _) = (tagOf_SMSpecRepKind k1) _EQ_ (tagOf_SMSpecRepKind k2)
  88                                                                && a1 == a2 && b1 == b2
  89     (GenericRep a1 b1 _)      == (GenericRep a2 b2 _)      = a1 == a2 && b1 == b2
  90     (BigTupleRep a1)          == (BigTupleRep a2)          = a1 == a2
  91     (MuTupleRep a1)           == (MuTupleRep a2)           = a1 == a2
  92     (DataRep a1)              == (DataRep a2)              = a1 == a2
  93     a                         == b                         = (tagOf_SMRep a) _EQ_ (tagOf_SMRep b)
  94
  95 {- UNUSED:
  96 equivSMRepHdr :: SMRep -> SMRep -> Bool
  97 a `equivSMRepHdr` b = (tagOf_SMRep a) _EQ_ (tagOf_SMRep b)
  98 -}
  99
 100 ltSMRepHdr :: SMRep -> SMRep -> Bool
 101 a `ltSMRepHdr` b = (tagOf_SMRep a) _LT_ (tagOf_SMRep b)
 102
 103 instance Ord SMRep where
 104     -- ToDo: cmp-ify?  This instance seems a bit weird (WDP 94/10)
 105     rep1 <= rep2 = rep1 < rep2 || rep1 == rep2
 106     rep1 < rep2
 107       = let tag1 = tagOf_SMRep rep1
 108             tag2 = tagOf_SMRep rep2
 109         in
 110         if      tag1 _LT_ tag2 then True
 111         else if tag1 _GT_ tag2 then False
 112         else {- tags equal -}    rep1 `lt` rep2
 113       where
 114         (SpecialisedRep k1 a1 b1 _) `lt` (SpecialisedRep k2 a2 b2 _) =
 115                 t1 _LT_ t2 || (t1 _EQ_ t2 && (a1 < a2 || (a1 == a2 && b1 < b2)))
 116                 where t1 = tagOf_SMSpecRepKind k1
 117                       t2 = tagOf_SMSpecRepKind k2
 118         (GenericRep a1 b1 _)      `lt` (GenericRep a2 b2 _)      = a1 < a2 || (a1 == a2 && b1 < b2)
 119         (BigTupleRep a1)          `lt` (BigTupleRep a2)          = a1 < a2
 120         (MuTupleRep a1)           `lt` (MuTupleRep a2)           = a1 < a2
 121         (DataRep a1)              `lt` (DataRep a2)              = a1 < a2
 122         a                         `lt` b                         = True
 123
 124 tagOf_SMSpecRepKind SpecRep     = (ILIT(1) :: FAST_INT)
 125 tagOf_SMSpecRepKind ConstantRep = ILIT(2)
 126 tagOf_SMSpecRepKind CharLikeRep = ILIT(3)
 127 tagOf_SMSpecRepKind IntLikeRep  = ILIT(4)
 128
 129 tagOf_SMRep (StaticRep _ _)          = (ILIT(1) :: FAST_INT)
 130 tagOf_SMRep (SpecialisedRep k _ _ _) = ILIT(2)
 131 tagOf_SMRep (GenericRep _ _ _)       = ILIT(3)
 132 tagOf_SMRep (BigTupleRep _)          = ILIT(4)
 133 tagOf_SMRep (DataRep _)              = ILIT(5)
 134 tagOf_SMRep DynamicRep               = ILIT(6)
 135 tagOf_SMRep BlackHoleRep             = ILIT(7)
 136 tagOf_SMRep PhantomRep               = ILIT(8)
 137 tagOf_SMRep (MuTupleRep _)           = ILIT(9)
 138
 139 instance Text SMRep where
 140     showsPrec d rep rest
 141       = (case rep of
 142            StaticRep _ _                         -> "STATIC"
 143            SpecialisedRep kind _ _ SMNormalForm  -> "SPEC_N"
 144            SpecialisedRep kind _ _ SMSingleEntry -> "SPEC_S"
 145            SpecialisedRep kind _ _ SMUpdatable   -> "SPEC_U"
 146            GenericRep _ _ SMNormalForm           -> "GEN_N"
 147            GenericRep _ _ SMSingleEntry          -> "GEN_S"
 148            GenericRep _ _ SMUpdatable            -> "GEN_U"
 149            BigTupleRep _                 -> "TUPLE"
 150            DataRep       _               -> "DATA"
 151            DynamicRep                    -> "DYN"
 152            BlackHoleRep                  -> "BH"
 153            PhantomRep                    -> "INREGS"
 154            MuTupleRep _                  -> "MUTUPLE") ++ rest
 155
 156 instance Outputable SMRep where
 157     ppr sty rep = ppStr (show rep)
 158
 159 getSMInfoStr :: SMRep -> String
 160 getSMInfoStr (StaticRep _ _)                            = "STATIC"
 161 getSMInfoStr (SpecialisedRep ConstantRep _ _ _)         = "CONST"
 162 getSMInfoStr (SpecialisedRep CharLikeRep _ _ _)         = "CHARLIKE"
 163 getSMInfoStr (SpecialisedRep IntLikeRep _ _ _)          = "INTLIKE"
 164 getSMInfoStr (SpecialisedRep SpecRep _ _ SMNormalForm)  = "SPEC_N"
 165 getSMInfoStr (SpecialisedRep SpecRep _ _ SMSingleEntry) = "SPEC_S"
 166 getSMInfoStr (SpecialisedRep SpecRep _ _ SMUpdatable)   = "SPEC_U"
 167 getSMInfoStr (GenericRep _ _ SMNormalForm)              = "GEN_N"
 168 getSMInfoStr (GenericRep _ _ SMSingleEntry)             = "GEN_S"
 169 getSMInfoStr (GenericRep _ _ SMUpdatable)               = "GEN_U"
 170 getSMInfoStr (BigTupleRep _)                            = "TUPLE"
 171 getSMInfoStr (DataRep _ )                               = "DATA"
 172 getSMInfoStr DynamicRep                                 = "DYN"
 173 getSMInfoStr BlackHoleRep                               = panic "getSMInfoStr.BlackHole"
 174 getSMInfoStr PhantomRep                                 = "INREGS"
 175 getSMInfoStr (MuTupleRep _)                             = "MUTUPLE"
 176
 177 getSMInitHdrStr :: SMRep -> String
 178 getSMInitHdrStr (SpecialisedRep IntLikeRep _ _ _)  = "SET_INTLIKE"
 179 getSMInitHdrStr (SpecialisedRep SpecRep _ _ _)     = "SET_SPEC"
 180 getSMInitHdrStr (GenericRep _ _ _)                 = "SET_GEN"
 181 getSMInitHdrStr (BigTupleRep _)                    = "SET_TUPLE"
 182 getSMInitHdrStr (DataRep _ )                       = "SET_DATA"
 183 getSMInitHdrStr DynamicRep                         = "SET_DYN"
 184 getSMInitHdrStr BlackHoleRep                       = "SET_BH"
 185 #ifdef DEBUG
 186 getSMInitHdrStr (StaticRep _ _)                    = panic "getSMInitHdrStr.Static"
 187 getSMInitHdrStr PhantomRep                         = panic "getSMInitHdrStr.Phantom"
 188 getSMInitHdrStr (MuTupleRep _)                     = panic "getSMInitHdrStr.Mutuple"
 189 getSMInitHdrStr (SpecialisedRep ConstantRep _ _ _) = panic "getSMInitHdrStr.Constant"
 190 getSMInitHdrStr (SpecialisedRep CharLikeRep _ _ _) = panic "getSMInitHdrStr.CharLike"
 191 #endif
 192
 193 getSMUpdInplaceHdrStr :: SMRep -> String
 194 getSMUpdInplaceHdrStr (SpecialisedRep ConstantRep _ _ _) = "INPLACE_UPD"
 195 getSMUpdInplaceHdrStr (SpecialisedRep CharLikeRep _ _ _) = "INPLACE_UPD"
 196 getSMUpdInplaceHdrStr (SpecialisedRep IntLikeRep _ _ _)  = "INPLACE_UPD"
 197 getSMUpdInplaceHdrStr (SpecialisedRep SpecRep _ _ _)     = "INPLACE_UPD"
 198 #ifdef DEBUG
 199 getSMUpdInplaceHdrStr (StaticRep _ _)                    = panic "getSMUpdInplaceHdrStr.Static"
 200 getSMUpdInplaceHdrStr (GenericRep _ _ _)                 = panic "getSMUpdInplaceHdrStr.Generic"
 201 getSMUpdInplaceHdrStr (BigTupleRep _ )                   = panic "getSMUpdInplaceHdrStr.BigTuple"
 202 getSMUpdInplaceHdrStr (DataRep _ )                       = panic "getSMUpdInplaceHdrStr.Data"
 203 getSMUpdInplaceHdrStr DynamicRep                         = panic "getSMUpdInplaceHdrStr.Dynamic"
 204 getSMUpdInplaceHdrStr BlackHoleRep                       = panic "getSMUpdInplaceHdrStr.BlackHole"
 205 getSMUpdInplaceHdrStr PhantomRep                         = panic "getSMUpdInplaceHdrStr.Phantom"
 206 getSMUpdInplaceHdrStr (MuTupleRep _ )                    = panic "getSMUpdInplaceHdrStr.MuTuple"
 207 #endif
 208 \end{code}