+++ /dev/null
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-\section[HeapOffs]{Abstract C: heap offsets}
-
-Part of ``Abstract C.'' Heap offsets---main point: they are {\em
-symbolic}---are sufficiently turgid that they get their own module.
-
-INTERNAL MODULE: should be accessed via @AbsCSyn.hi@.
-
-\begin{code}
-module HeapOffs (
- HeapOffset,
-
- zeroOff, intOff, fixedHdrSize, totHdrSize, varHdrSize,
- maxOff, addOff, subOff,
- isZeroOff, possiblyEqualHeapOffset,
-
- pprHeapOffset,
-
- intOffsetIntoGoods,
-
-#if ! OMIT_NATIVE_CODEGEN
- hpRelToInt,
-#endif
-
- VirtualHeapOffset, HpRelOffset,
- VirtualSpAOffset, VirtualSpBOffset,
- SpARelOffset, SpBRelOffset
- ) where
-
-#include "HsVersions.h"
-
-#if ! OMIT_NATIVE_CODEGEN
-import {-# SOURCE #-} MachMisc
-#endif
-
-import Maybes ( catMaybes )
-import SMRep
-import Util ( panic )
-import Outputable
-import GlaExts ( Int(..), Int#, (+#), negateInt#, (<=#), (>=#), (==#) )
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Offsets-Heap-and-others]{Offsets, Heap and otherwise}
-%* *
-%************************************************************************
-
-\begin{code}
-{-
- < fixed-hdr-size> < var-hdr-size >
- ---------------------------------------------------------------------
- |info| | | | | | | | ptrs... | nonptrs ... | slop.... |
- ---------------------------------------------------------------------
- <------------- header ------------>
-
- * Node, the ptr to the closure, pts at its info-ptr field
--}
-data HeapOffset
- = MkHeapOffset
-
- FAST_INT -- this many words...
-
- FAST_INT -- PLUS: this many FixedHdrSizes
-
- [SMRep__Int] -- PLUS: for each elem in this list:
- -- "Int" VarHdrSizes for rep "SMRep"
- -- *sorted* by SMRep
- -- We never have any SpecReps in here, because their
- -- VarHdrSize is zero
-
- [SMRep__Int] -- PLUS: for each elem in this list:
- -- "Int" TotHdrSizes for rep "SMRep"
- -- *sorted* by SMRep
- -- We never have any SpecReps in here, because
- -- their TotHdrSize is just FixedHdrSize
-
- | MaxHeapOffset HeapOffset HeapOffset
- | SubHeapOffset HeapOffset HeapOffset
- | AddHeapOffset HeapOffset HeapOffset
- | ZeroHeapOffset
-
- deriving () -- but: see `eqOff` below
-
-data SMRep__Int = SMRI_ SMRep Int#
-#define SMRI(a,b) (SMRI_ a b)
-
-type VirtualHeapOffset = HeapOffset
-type VirtualSpAOffset = Int
-type VirtualSpBOffset = Int
-
-type HpRelOffset = HeapOffset
-type SpARelOffset = Int
-type SpBRelOffset = Int
-\end{code}
-
-Interface fns for HeapOffsets:
-\begin{code}
-zeroOff = ZeroHeapOffset
-
-intOff IBOX(n) = MkHeapOffset n ILIT(0) [] []
-
-fixedHdrSize = MkHeapOffset ILIT(0) ILIT(1) [] []
-
-totHdrSize sm_rep
- = if isSpecRep sm_rep -- Tot hdr size for a spec rep is just FixedHdrSize
- then MkHeapOffset ILIT(0) ILIT(1) [] []
- else MkHeapOffset ILIT(0) ILIT(0) [] [SMRI(sm_rep, ILIT(1))]
-
-varHdrSize sm_rep
- = if isSpecRep sm_rep
- then zeroOff
- else MkHeapOffset ILIT(0) ILIT(0) [SMRI(sm_rep, ILIT(1))] []
-\end{code}
-
-%************************************************************************
-%* *
-\subsubsection[Heap-offset-arithmetic]{Heap offset arithmetic}
-%* *
-%************************************************************************
-
-\begin{code}
--- For maxOff we do our best when we have something simple to deal with
-maxOff ZeroHeapOffset off2 = off2
-maxOff off1 ZeroHeapOffset = off1
-maxOff off1@(MkHeapOffset int_offs1 fixhdr_offs1 varhdr_offs1 tothdr_offs1)
- off2@(MkHeapOffset int_offs2 fixhdr_offs2 varhdr_offs2 tothdr_offs2)
- = if (int_offs1 _LE_ int_offs2) &&
- (real_fixed1 _LE_ real_fixed2) &&
- (all negative_or_zero difference_of_real_varhdrs)
- then
- off2
- else
- if (int_offs2 _LE_ int_offs1) &&
- (real_fixed2 _LE_ real_fixed1) &&
- (all positive_or_zero difference_of_real_varhdrs)
- then
- off1
- else
- MaxHeapOffset off1 off2
- where
- -- Normalise, by realising that each tot-hdr is really a
- -- var-hdr plus a fixed-hdr
- n_tothdr1 = total_of tothdr_offs1
- real_fixed1 = fixhdr_offs1 _ADD_ n_tothdr1
- real_varhdr1 = add_HdrSizes varhdr_offs1 tothdr_offs1
-
- n_tothdr2 = total_of tothdr_offs2
- real_fixed2 = fixhdr_offs2 _ADD_ n_tothdr2
- real_varhdr2 = add_HdrSizes varhdr_offs2 tothdr_offs2
-
- -- Take the difference of the normalised var-hdrs
- difference_of_real_varhdrs
- = add_HdrSizes real_varhdr1 (map negate_HdrSize real_varhdr2)
- where
- negate_HdrSize :: SMRep__Int -> SMRep__Int
- negate_HdrSize SMRI(rep,n) = SMRI(rep, (_NEG_ n))
-
- positive_or_zero SMRI(rep,n) = n _GE_ ILIT(0)
- negative_or_zero SMRI(rep,n) = n _LE_ ILIT(0)
-
- total_of [] = ILIT(0)
- total_of (SMRI(rep,n):offs) = n _ADD_ total_of offs
-
-maxOff other_off1 other_off2 = MaxHeapOffset other_off1 other_off2
-
-------------------------------------------------------------------
-
-subOff off1 ZeroHeapOffset = off1
-subOff off1
- (MkHeapOffset int_offs2 fxdhdr_offs2 varhdr_offs2 tothdr_offs2)
- = addOff off1
- (MkHeapOffset (_NEG_ int_offs2)
- (_NEG_ fxdhdr_offs2)
- (map negate_HdrSize varhdr_offs2)
- (map negate_HdrSize tothdr_offs2))
- where
- negate_HdrSize :: SMRep__Int -> SMRep__Int
- negate_HdrSize SMRI(rep,n) = SMRI(rep,(_NEG_ n))
-
-subOff other_off1 other_off2 = SubHeapOffset other_off1 other_off2
-
-------------------------------------------------------------------
-
-addOff ZeroHeapOffset off2 = off2
-addOff off1 ZeroHeapOffset = off1
-addOff (MkHeapOffset int_offs1 fxdhdr_offs1 varhdr_offs1 tothdr_offs1)
- (MkHeapOffset int_offs2 fxdhdr_offs2 varhdr_offs2 tothdr_offs2)
- = MkHeapOffset
- (int_offs1 _ADD_ int_offs2)
- (fxdhdr_offs1 _ADD_ fxdhdr_offs2)
- (add_HdrSizes varhdr_offs1 varhdr_offs2)
- (add_HdrSizes tothdr_offs1 tothdr_offs2)
-
-addOff other_off1 other_off2 = AddHeapOffset other_off1 other_off2
-
-------------------------------------------------------------------
--- not exported:
---
-add_HdrSizes :: [SMRep__Int] -> [SMRep__Int] -> [SMRep__Int]
-
-add_HdrSizes [] offs2 = offs2
-add_HdrSizes offs1 [] = offs1
-add_HdrSizes as@(off1@(SMRI(rep1,n1)) : offs1) bs@(off2@(SMRI(rep2,n2)) : offs2)
- = if rep1 `ltSMRepHdr` rep2 then
- off1 : (add_HdrSizes offs1 bs)
- else
- if rep2 `ltSMRepHdr` rep1 then
- off2 : (add_HdrSizes as offs2)
- else
- let
- n1_plus_n2 = n1 _ADD_ n2
- in
- -- So they are the same rep
- if n1_plus_n2 _EQ_ ILIT(0) then
- add_HdrSizes offs1 offs2
- else
- (SMRI(rep1, n1_plus_n2)) : (add_HdrSizes offs1 offs2)
-\end{code}
-
-\begin{code}
-isZeroOff :: HeapOffset -> Bool
-isZeroOff ZeroHeapOffset = True
-isZeroOff (MaxHeapOffset off1 off2) = isZeroOff off1 && isZeroOff off2
-
-isZeroOff (AddHeapOffset off1 off2) = isZeroOff off1 && isZeroOff off2
- -- This assumes that AddHeapOffset only has positive arguments
-
-isZeroOff (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
- = int_offs _EQ_ ILIT(0) && fxdhdr_offs _EQ_ ILIT(0) &&
- null varhdr_offs && null tothdr_offs
-
-isZeroOff (SubHeapOffset off1 off2) = panic "Can't say if a SubHeapOffset is zero"
-\end{code}
-
-@possiblyEqualHeapOffset@ tells if two heap offsets might be equal.
-It has to be conservative, but the situation in which it is used
-(@doSimultaneously@) makes it likely to give a good answer.
-
-\begin{code}
-possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
-possiblyEqualHeapOffset o1 o2
- = case (o1 `subOff` o2) of
-
- SubHeapOffset _ _ -> True -- Very conservative
-
- diff -> not (isZeroOff diff) -- Won't be any SubHeapOffsets in diff
- -- NB: this claim depends on the use of
- -- heap offsets, so this defn might need
- -- to be elaborated.
-
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[HeapOffs-printing]{Printing heap offsets}
-%* *
-%************************************************************************
-
-IMPORTANT: @pprHeapOffset@ and @pprHeapOffsetPieces@ guarantee to
-print either a single value, or a parenthesised value. No need for
-the caller to parenthesise.
-
-\begin{code}
-pprHeapOffset :: HeapOffset -> SDoc
-
-pprHeapOffset ZeroHeapOffset = char '0'
-
-pprHeapOffset (MaxHeapOffset off1 off2)
- = (<>) (ptext SLIT("STG_MAX"))
- (parens (hcat [pprHeapOffset off1, comma, pprHeapOffset off2]))
-
-pprHeapOffset (AddHeapOffset off1 off2)
- = parens (hcat [pprHeapOffset off1, char '+',
- pprHeapOffset off2])
-pprHeapOffset (SubHeapOffset off1 off2)
- = parens (hcat [pprHeapOffset off1, char '-',
- pprHeapOffset off2])
-
-pprHeapOffset (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
- = pprHeapOffsetPieces int_offs fxdhdr_offs varhdr_offs tothdr_offs
-\end{code}
-
-\begin{code}
-pprHeapOffsetPieces :: FAST_INT -- Words
- -> FAST_INT -- Fixed hdrs
- -> [SMRep__Int] -- Var hdrs
- -> [SMRep__Int] -- Tot hdrs
- -> SDoc
-
-pprHeapOffsetPieces n ILIT(0) [] [] = int IBOX(n) -- Deals with zero case too
-
-pprHeapOffsetPieces int_offs fxdhdr_offs varhdr_offs tothdr_offs
- = let pp_int_offs =
- if int_offs _EQ_ ILIT(0)
- then Nothing
- else Just (int IBOX(int_offs))
-
- pp_fxdhdr_offs =
- if fxdhdr_offs _EQ_ ILIT(0) then
- Nothing
- else if fxdhdr_offs _EQ_ ILIT(1) then
- Just (ptext SLIT("_FHS"))
- else
- Just (hcat [char '(', ptext SLIT("_FHS*"), int IBOX(fxdhdr_offs), char ')'])
-
- pp_varhdr_offs = pp_hdrs (ptext SLIT("_VHS")) varhdr_offs
-
- pp_tothdr_offs = pp_hdrs (ptext SLIT("_HS")) tothdr_offs
- in
- case (catMaybes [pp_tothdr_offs, pp_varhdr_offs, pp_fxdhdr_offs, pp_int_offs]) of
- [] -> char '0'
- [pp] -> pp -- Each blob is parenthesised if necessary
- pps -> parens (hcat (punctuate (char '+') pps))
- where
- pp_hdrs hdr_pp [] = Nothing
- pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just ((<>) (text (show rep)) hdr_pp)
- pp_hdrs hdr_pp hdrs = Just (parens (hsep (punctuate (char '+')
- (map (pp_hdr hdr_pp) hdrs))))
-
- pp_hdr :: SDoc -> SMRep__Int -> SDoc
- pp_hdr pp_str (SMRI(rep, n))
- = if n _EQ_ ILIT(1) then
- (<>) (text (show rep)) pp_str
- else
- hcat [int IBOX(n), char '*', text (show rep), pp_str]
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[HeapOffs-conversion]{Converting heap offsets to words}
-%* *
-%************************************************************************
-
-@intOffsetIntoGoods@ and @hpRelToInt@ convert HeapOffsets into Ints.
-
-@intOffsetIntoGoods@ {\em tries} to convert a HeapOffset in a SPEC
-closure into an Int, returning the (0-origin) index from the beginning
-of the ``goods'' in the closure. [SPECs don't have VHSs, by
-definition, so the index is merely ignoring the FHS].
-
-@hpRelToInt@ is for the native code-generator(s); it is courtesy of
-Jon Hill and the DAP code generator. We've just abstracted away some
-of the implementation-dependent bits.
-
-\begin{code}
-intOffsetIntoGoods :: HeapOffset -> Maybe Int
-
-intOffsetIntoGoods (MkHeapOffset n ILIT(1){-FHS-} [{-no VHSs-}] [{-no totHSs-}])
- = Just IBOX(n)
-intOffsetIntoGoods anything_else = Nothing
-\end{code}
-
-\begin{code}
-#if ! OMIT_NATIVE_CODEGEN
-
-hpRelToInt :: HeapOffset -> Int
-
-hpRelToInt ZeroHeapOffset = 0
-
-hpRelToInt (MaxHeapOffset left right)
- = hpRelToInt left `max` hpRelToInt right
-
-hpRelToInt (SubHeapOffset left right)
- = hpRelToInt left - hpRelToInt right
-
-hpRelToInt (AddHeapOffset left right)
- = hpRelToInt left + hpRelToInt right
-
-hpRelToInt (MkHeapOffset base fhs vhs ths)
- = let
- vhs_pieces, ths_pieces :: [Int]
- fhs_off, vhs_off, ths_off :: Int
-
- vhs_pieces = map (\ (SMRI(r, n)) -> vhs_size r * IBOX(n)) vhs
- ths_pieces = map (\ (SMRI(r, n)) -> (fhs_size + vhs_size r) * IBOX(n)) ths
-
- fhs_off = fhs_size * IBOX(fhs)
- vhs_off = sum vhs_pieces
- ths_off = sum ths_pieces
- in
- IBOX(base) + fhs_off + vhs_off + ths_off
- where
- fhs_size = fixedHdrSizeInWords
- vhs_size r = varHdrSizeInWords r
-
-#endif
-\end{code}
projects / ghc-hetmet.git / commitdiff