ghc/compiler/absCSyn/HeapOffs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[HeapOffs]{Abstract C: heap offsets}
   5
   6 Part of ``Abstract C.''  Heap offsets---main point: they are {\em
   7 symbolic}---are sufficiently turgid that they get their own module.
   8
   9 INTERNAL MODULE: should be accessed via @AbsCSyn.hi@.
  10
  11 \begin{code}
  12 #include "HsVersions.h"
  13
  14 module HeapOffs (
  15 #ifndef DPH
  16         HeapOffset,
  17 #else
  18         HeapOffset(..), -- DPH needs to do a little peaking inside this thing.
  19 #endif {- Data Parallel Haskell -}
  20
  21         zeroOff, intOff, fixedHdrSize, totHdrSize, varHdrSize,
  22         maxOff, addOff, subOff,
  23         isZeroOff, possiblyEqualHeapOffset,
  24
  25         pprHeapOffset,
  26
  27         intOffsetIntoGoods,
  28
  29 #if ! OMIT_NATIVE_CODEGEN
  30         hpRelToInt,
  31 #endif
  32
  33         VirtualHeapOffset(..), HpRelOffset(..),
  34         VirtualSpAOffset(..), VirtualSpBOffset(..),
  35         SpARelOffset(..), SpBRelOffset(..)
  36     ) where
  37
  38 import ClosureInfo      -- esp. about SMReps
  39 import SMRep
  40 #if ! OMIT_NATIVE_CODEGEN
  41 import MachDesc
  42 #endif
  43 import Maybes           ( catMaybes, Maybe(..) )
  44 import Outputable
  45 import Unpretty         -- ********** NOTE **********
  46 import Util
  47 \end{code}
  48
  49 %************************************************************************
  50 %*                                                                      *
  51 \subsection[Offsets-Heap-and-others]{Offsets, Heap and otherwise}
  52 %*                                                                      *
  53 %************************************************************************
  54
  55 \begin{code}
  56 {-
  57     < fixed-hdr-size> < var-hdr-size  >
  58     ---------------------------------------------------------------------
  59     |info|    |      |   |  |  |   |  | ptrs... | nonptrs ... | slop.... |
  60     ---------------------------------------------------------------------
  61     <------------- header ------------>
  62
  63     * Node, the ptr to the closure, pts at its info-ptr field
  64 -}
  65 data HeapOffset
  66   = MkHeapOffset
  67
  68         FAST_INT        -- this many words...
  69
  70         FAST_INT        -- PLUS: this many FixedHdrSizes
  71
  72         [SMRep__Int]    -- PLUS: for each elem in this list:
  73                         --      "Int" VarHdrSizes for rep "SMRep"
  74                         -- *sorted* by SMRep
  75                         -- We never have any SpecReps in here, because their
  76                         --      VarHdrSize is zero
  77
  78         [SMRep__Int]    -- PLUS: for each elem in this list:
  79                         --      "Int" TotHdrSizes for rep "SMRep"
  80                         -- *sorted* by SMRep
  81                         -- We never have any SpecReps in here, because
  82                         --      their TotHdrSize is just FixedHdrSize
  83
  84   | MaxHeapOffset HeapOffset HeapOffset
  85   | SubHeapOffset HeapOffset HeapOffset
  86   | AddHeapOffset HeapOffset HeapOffset
  87   | ZeroHeapOffset
  88
  89   deriving () -- but: see `eqOff` below
  90
  91 #if defined(__GLASGOW_HASKELL__)
  92 data SMRep__Int = SMRI_ SMRep Int#
  93 #define SMRI(a,b) (SMRI_ a b)
  94 #else
  95 type SMRep__Int = (SMRep, Int)
  96 #define SMRI(a,b) (a, b)
  97 #endif
  98
  99 type VirtualHeapOffset  = HeapOffset
 100 type VirtualSpAOffset   = Int
 101 type VirtualSpBOffset   = Int
 102
 103 type HpRelOffset        = HeapOffset
 104 type SpARelOffset       = Int
 105 type SpBRelOffset       = Int
 106 \end{code}
 107
 108 Interface fns for HeapOffsets:
 109 \begin{code}
 110 zeroOff = ZeroHeapOffset
 111
 112 intOff IBOX(n) = MkHeapOffset n ILIT(0) [] []
 113
 114 fixedHdrSize = MkHeapOffset ILIT(0) ILIT(1) [] []
 115
 116 totHdrSize sm_rep
 117   = if isSpecRep sm_rep -- Tot hdr size for a spec rep is just FixedHdrSize
 118     then MkHeapOffset ILIT(0) ILIT(1) [] []
 119     else MkHeapOffset ILIT(0) ILIT(0) [] [SMRI(sm_rep, ILIT(1))]
 120
 121 varHdrSize sm_rep
 122   = if isSpecRep sm_rep
 123     then zeroOff
 124     else MkHeapOffset ILIT(0) ILIT(0) [SMRI(sm_rep, ILIT(1))] []
 125 \end{code}
 126
 127 %************************************************************************
 128 %*                                                                      *
 129 \subsubsection[Heap-offset-arithmetic]{Heap offset arithmetic}
 130 %*                                                                      *
 131 %************************************************************************
 132
 133 \begin{code}
 134 -- For maxOff we do our best when we have something simple to deal with
 135 maxOff ZeroHeapOffset off2 = off2
 136 maxOff off1 ZeroHeapOffset = off1
 137 maxOff off1@(MkHeapOffset int_offs1 fixhdr_offs1 varhdr_offs1 tothdr_offs1)
 138        off2@(MkHeapOffset int_offs2 fixhdr_offs2 varhdr_offs2 tothdr_offs2)
 139   = if (int_offs1 _LE_ int_offs2) &&
 140        (real_fixed1 _LE_ real_fixed2) &&
 141        (all negative_or_zero difference_of_real_varhdrs)
 142     then
 143          off2
 144     else
 145     if (int_offs2 _LE_ int_offs1) &&
 146        (real_fixed2 _LE_ real_fixed1) &&
 147        (all positive_or_zero difference_of_real_varhdrs)
 148     then
 149          off1
 150     else
 151          MaxHeapOffset off1 off2
 152   where
 153     -- Normalise, by realising that each tot-hdr is really a
 154     -- var-hdr plus a fixed-hdr
 155     n_tothdr1    = total_of tothdr_offs1
 156     real_fixed1  = fixhdr_offs1 _ADD_ n_tothdr1
 157     real_varhdr1 = add_HdrSizes varhdr_offs1 tothdr_offs1
 158
 159     n_tothdr2    = total_of tothdr_offs2
 160     real_fixed2  = fixhdr_offs2 _ADD_ n_tothdr2
 161     real_varhdr2 = add_HdrSizes varhdr_offs2 tothdr_offs2
 162
 163     -- Take the difference of the normalised var-hdrs
 164     difference_of_real_varhdrs
 165       = add_HdrSizes real_varhdr1 (map negate_HdrSize real_varhdr2)
 166       where
 167         negate_HdrSize :: SMRep__Int -> SMRep__Int
 168         negate_HdrSize SMRI(rep,n) = SMRI(rep, (_NEG_ n))
 169
 170     positive_or_zero SMRI(rep,n) = n _GE_ ILIT(0)
 171     negative_or_zero SMRI(rep,n) = n _LE_ ILIT(0)
 172
 173     total_of []                 = ILIT(0)
 174     total_of (SMRI(rep,n):offs) = n _ADD_ total_of offs
 175
 176 maxOff other_off1 other_off2 = MaxHeapOffset other_off1 other_off2
 177
 178 ------------------------------------------------------------------
 179
 180 subOff off1 ZeroHeapOffset = off1
 181 subOff off1
 182        (MkHeapOffset int_offs2 fxdhdr_offs2 varhdr_offs2 tothdr_offs2)
 183   = addOff off1
 184           (MkHeapOffset (_NEG_ int_offs2)
 185                         (_NEG_ fxdhdr_offs2)
 186                         (map negate_HdrSize varhdr_offs2)
 187                         (map negate_HdrSize tothdr_offs2))
 188   where
 189     negate_HdrSize :: SMRep__Int -> SMRep__Int
 190     negate_HdrSize SMRI(rep,n) = SMRI(rep,(_NEG_ n))
 191
 192 subOff other_off1 other_off2 = SubHeapOffset other_off1 other_off2
 193
 194 ------------------------------------------------------------------
 195
 196 addOff ZeroHeapOffset off2 = off2
 197 addOff off1 ZeroHeapOffset = off1
 198 addOff (MkHeapOffset int_offs1 fxdhdr_offs1 varhdr_offs1 tothdr_offs1)
 199        (MkHeapOffset int_offs2 fxdhdr_offs2 varhdr_offs2 tothdr_offs2)
 200   = MkHeapOffset
 201         (int_offs1    _ADD_ int_offs2)
 202         (fxdhdr_offs1 _ADD_ fxdhdr_offs2)
 203         (add_HdrSizes varhdr_offs1 varhdr_offs2)
 204         (add_HdrSizes tothdr_offs1 tothdr_offs2)
 205
 206 addOff other_off1 other_off2 = AddHeapOffset other_off1 other_off2
 207
 208 ------------------------------------------------------------------
 209 -- not exported:
 210 --
 211 add_HdrSizes :: [SMRep__Int] -> [SMRep__Int] -> [SMRep__Int]
 212
 213 add_HdrSizes [] offs2 = offs2
 214 add_HdrSizes offs1 [] = offs1
 215 add_HdrSizes as@(off1@(SMRI(rep1,n1)) : offs1) bs@(off2@(SMRI(rep2,n2)) : offs2)
 216   = if rep1 `ltSMRepHdr` rep2 then
 217              off1 : (add_HdrSizes offs1 bs)
 218     else
 219     if rep2 `ltSMRepHdr` rep1 then
 220              off2 : (add_HdrSizes as offs2)
 221     else
 222     let
 223         n1_plus_n2 = n1 _ADD_ n2
 224     in
 225     -- So they are the same rep
 226     if n1_plus_n2 _EQ_ ILIT(0) then
 227         add_HdrSizes offs1 offs2
 228     else
 229         (SMRI(rep1, n1_plus_n2)) : (add_HdrSizes offs1 offs2)
 230 \end{code}
 231
 232 \begin{code}
 233 isZeroOff :: HeapOffset -> Bool
 234 isZeroOff ZeroHeapOffset = True
 235 isZeroOff (MaxHeapOffset off1 off2) = isZeroOff off1 && isZeroOff off2
 236
 237 isZeroOff (AddHeapOffset off1 off2) = isZeroOff off1 && isZeroOff off2
 238         -- This assumes that AddHeapOffset only has positive arguments
 239
 240 isZeroOff (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
 241   = int_offs _EQ_ ILIT(0) && fxdhdr_offs _EQ_ ILIT(0) &&
 242     null varhdr_offs && null tothdr_offs
 243
 244 isZeroOff (SubHeapOffset off1 off2) = panic "Can't say if a SubHeapOffset is zero"
 245 \end{code}
 246
 247 @possiblyEqualHeapOffset@ tells if two heap offsets might be equal.
 248 It has to be conservative, but the situation in which it is used
 249 (@doSimultaneously@) makes it likely to give a good answer.
 250
 251 \begin{code}
 252 possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
 253 possiblyEqualHeapOffset o1 o2
 254  = case (o1 `subOff` o2) of
 255
 256         SubHeapOffset _ _ -> True                       -- Very conservative
 257
 258         diff              -> not (isZeroOff diff)       -- Won't be any SubHeapOffsets in diff
 259                                                         -- NB: this claim depends on the use of
 260                                                         -- heap offsets, so this defn might need
 261                                                         -- to be elaborated.
 262
 263 \end{code}
 264
 265 %************************************************************************
 266 %*                                                                      *
 267 \subsection[HeapOffs-printing]{Printing heap offsets}
 268 %*                                                                      *
 269 %************************************************************************
 270
 271 IMPORTANT: @pprHeapOffset@ and @pprHeapOffsetPieces@ guarantee to
 272 print either a single value, or a parenthesised value.  No need for
 273 the caller to parenthesise.
 274
 275 \begin{code}
 276 pprHeapOffset :: PprStyle -> HeapOffset -> Unpretty
 277
 278 pprHeapOffset sty ZeroHeapOffset = uppChar '0'
 279
 280 pprHeapOffset sty (MaxHeapOffset off1 off2)
 281   = uppBesides [uppPStr SLIT("STG_MAX"), uppLparen,
 282                 pprHeapOffset sty off1, uppComma, pprHeapOffset sty off2,
 283                uppRparen]
 284 pprHeapOffset sty (AddHeapOffset off1 off2)
 285   = uppBesides [uppLparen, pprHeapOffset sty off1, uppChar '+',
 286                         pprHeapOffset sty off2, uppRparen]
 287 pprHeapOffset sty (SubHeapOffset off1 off2)
 288   = uppBesides [uppLparen, pprHeapOffset sty off1, uppChar '-',
 289                         pprHeapOffset sty off2, uppRparen]
 290
 291 pprHeapOffset sty (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
 292   = pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
 293 \end{code}
 294
 295 \begin{code}
 296 pprHeapOffsetPieces :: PprStyle
 297                     -> FAST_INT         -- Words
 298                     -> FAST_INT         -- Fixed hdrs
 299                     -> [SMRep__Int]     -- Var hdrs
 300                     -> [SMRep__Int]     -- Tot hdrs
 301                     -> Unpretty
 302
 303 pprHeapOffsetPieces sty n ILIT(0) [] [] = uppInt IBOX(n) -- Deals with zero case too
 304
 305 pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
 306   = let pp_int_offs =
 307             if int_offs _EQ_ ILIT(0)
 308             then Nothing
 309             else Just (uppInt IBOX(int_offs))
 310
 311         pp_fxdhdr_offs =
 312             if fxdhdr_offs _EQ_ ILIT(0) then
 313                 Nothing
 314             else if fxdhdr_offs _EQ_ ILIT(1) then
 315                 Just (uppPStr SLIT("_FHS"))
 316             else
 317                 Just (uppBesides [uppStr "(_FHS*", uppInt IBOX(fxdhdr_offs), uppChar ')'])
 318
 319         pp_varhdr_offs = pp_hdrs (uppPStr SLIT("_VHS")) varhdr_offs
 320
 321         pp_tothdr_offs = pp_hdrs (uppPStr SLIT("_HS")) tothdr_offs
 322     in
 323     case (catMaybes [pp_tothdr_offs, pp_varhdr_offs, pp_fxdhdr_offs, pp_int_offs]) of
 324         []   -> uppChar '0'
 325         [pp] -> pp      -- Each blob is parenthesised if necessary
 326         pps  -> uppBesides [ uppLparen, uppIntersperse (uppChar '+') pps, uppRparen ]
 327   where
 328     pp_hdrs hdr_pp [] = Nothing
 329     pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just (uppBeside (uppStr (show rep)) hdr_pp)
 330     pp_hdrs hdr_pp hdrs = Just (uppBesides [ uppLparen,
 331                                             uppInterleave (uppChar '+')
 332                                                 (map (pp_hdr hdr_pp) hdrs),
 333                                             uppRparen ])
 334
 335     pp_hdr :: Unpretty -> SMRep__Int -> Unpretty
 336     pp_hdr pp_str (SMRI(rep, n))
 337       = if n _EQ_ ILIT(1) then
 338           uppBeside (uppStr (show rep)) pp_str
 339         else
 340           uppBesides [uppInt IBOX(n), uppChar '*', uppStr (show rep), pp_str]
 341 \end{code}
 342
 343 %************************************************************************
 344 %*                                                                      *
 345 \subsection[HeapOffs-conversion]{Converting heap offsets to words}
 346 %*                                                                      *
 347 %************************************************************************
 348
 349 @intOffsetIntoGoods@ and @hpRelToInt@ convert HeapOffsets into Ints.
 350
 351 @intOffsetIntoGoods@ {\em tries} to convert a HeapOffset in a SPEC
 352 closure into an Int, returning the (0-origin) index from the beginning
 353 of the ``goods'' in the closure.  [SPECs don't have VHSs, by
 354 definition, so the index is merely ignoring the FHS].
 355
 356 @hpRelToInt@ is for the native code-generator(s); it is courtesy of
 357 Jon Hill and the DAP code generator.  We've just abstracted away some
 358 of the implementation-dependent bits.
 359
 360 \begin{code}
 361 intOffsetIntoGoods :: HeapOffset -> Maybe Int
 362
 363 intOffsetIntoGoods (MkHeapOffset n ILIT(1){-FHS-} [{-no VHSs-}] [{-no totHSs-}])
 364   = Just IBOX(n)
 365 intOffsetIntoGoods anything_else = Nothing
 366 \end{code}
 367
 368 \begin{code}
 369 #if ! OMIT_NATIVE_CODEGEN
 370
 371 hpRelToInt :: Target -> HeapOffset -> Int
 372
 373 hpRelToInt target (MaxHeapOffset left right)
 374   = (hpRelToInt target left) `max` (hpRelToInt target right)
 375
 376 hpRelToInt target (SubHeapOffset left right)
 377   = (hpRelToInt target left) - (hpRelToInt target right)
 378
 379 hpRelToInt target (AddHeapOffset left right)
 380   = (hpRelToInt target left) + (hpRelToInt target right)
 381
 382 hpRelToInt target ZeroHeapOffset = 0
 383
 384 hpRelToInt target (MkHeapOffset base fhs vhs ths)
 385   = let
 386         vhs_pieces, ths_pieces :: [Int]
 387         fhs_off, vhs_off, ths_off :: Int
 388
 389         vhs_pieces = map (\ (SMRI(r, n)) -> vhs_size r * IBOX(n)) vhs
 390         ths_pieces = map (\ (SMRI(r, n)) -> (fhs_size + vhs_size r) * IBOX(n)) ths
 391
 392         fhs_off = fhs_size * IBOX(fhs)
 393         vhs_off = sum vhs_pieces
 394         ths_off = sum ths_pieces
 395     in
 396     IBOX(base) + fhs_off + vhs_off + ths_off
 397   where
 398     fhs_size   = (fixedHeaderSize target) :: Int
 399     vhs_size r = (varHeaderSize target r) :: Int
 400
 401 #endif
 402 \end{code}