ghc/compiler/absCSyn/HeapOffs.lhs

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