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