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