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