%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[HeapOffs]{Abstract C: heap offsets}
#include "HsVersions.h"
module HeapOffs (
-#ifndef DPH
HeapOffset,
-#else
- HeapOffset(..), -- DPH needs to do a little peaking inside this thing.
-#endif {- Data Parallel Haskell -}
zeroOff, intOff, fixedHdrSize, totHdrSize, varHdrSize,
maxOff, addOff, subOff,
intOffsetIntoGoods,
#if ! OMIT_NATIVE_CODEGEN
- hpRelToInt,
+ hpRelToInt,
#endif
- VirtualHeapOffset(..), HpRelOffset(..),
- VirtualSpAOffset(..), VirtualSpBOffset(..),
- SpARelOffset(..), SpBRelOffset(..)
- ) where
+ SYN_IE(VirtualHeapOffset), SYN_IE(HpRelOffset),
+ SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset),
+ SYN_IE(SpARelOffset), SYN_IE(SpBRelOffset)
+ ) where
-import ClosureInfo -- esp. about SMReps
-import SMRep
+IMP_Ubiq(){-uitous-}
#if ! OMIT_NATIVE_CODEGEN
-import MachDesc
+# if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+IMPORT_DELOOPER(AbsCLoop) ( fixedHdrSizeInWords, varHdrSizeInWords )
+# else
+import {-# SOURCE #-} MachMisc
+# endif
#endif
-import Maybes ( catMaybes, Maybe(..) )
-import Outputable
-import Unpretty -- ********** NOTE **********
-import Util
+
+import Maybes ( catMaybes )
+import SMRep
+import Pretty -- ********** NOTE **********
+import Util ( panic )
+import Outputable ( PprStyle )
\end{code}
%************************************************************************
* Node, the ptr to the closure, pts at its info-ptr field
-}
data HeapOffset
- = MkHeapOffset
+ = MkHeapOffset
FAST_INT -- this many words...
deriving () -- but: see `eqOff` below
-#if defined(__GLASGOW_HASKELL__)
data SMRep__Int = SMRI_ SMRep Int#
#define SMRI(a,b) (SMRI_ a b)
-#else
-type SMRep__Int = (SMRep, Int)
-#define SMRI(a,b) (a, b)
-#endif
type VirtualHeapOffset = HeapOffset
type VirtualSpAOffset = Int
fixedHdrSize = MkHeapOffset ILIT(0) ILIT(1) [] []
-totHdrSize sm_rep
+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))]
else
MaxHeapOffset off1 off2
where
- -- Normalise, by realising that each tot-hdr is really a
+ -- 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
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
+ else
if rep2 `ltSMRepHdr` rep1 then
off2 : (add_HdrSizes as offs2)
else
the caller to parenthesise.
\begin{code}
-pprHeapOffset :: PprStyle -> HeapOffset -> Unpretty
+pprHeapOffset :: PprStyle -> HeapOffset -> Doc
-pprHeapOffset sty ZeroHeapOffset = uppChar '0'
+pprHeapOffset sty ZeroHeapOffset = char '0'
pprHeapOffset sty (MaxHeapOffset off1 off2)
- = uppBesides [uppPStr SLIT("STG_MAX"), uppLparen,
- pprHeapOffset sty off1, uppComma, pprHeapOffset sty off2,
- uppRparen]
+ = (<>) (ptext SLIT("STG_MAX"))
+ (parens (hcat [pprHeapOffset sty off1, comma, pprHeapOffset sty off2]))
+
pprHeapOffset sty (AddHeapOffset off1 off2)
- = uppBesides [uppLparen, pprHeapOffset sty off1, uppChar '+',
- pprHeapOffset sty off2, uppRparen]
+ = parens (hcat [pprHeapOffset sty off1, char '+',
+ pprHeapOffset sty off2])
pprHeapOffset sty (SubHeapOffset off1 off2)
- = uppBesides [uppLparen, pprHeapOffset sty off1, uppChar '-',
- pprHeapOffset sty off2, uppRparen]
+ = parens (hcat [pprHeapOffset sty off1, char '-',
+ pprHeapOffset sty off2])
pprHeapOffset sty (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
= pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
\end{code}
\begin{code}
-pprHeapOffsetPieces :: PprStyle
+pprHeapOffsetPieces :: PprStyle
-> FAST_INT -- Words
-> FAST_INT -- Fixed hdrs
-> [SMRep__Int] -- Var hdrs
-> [SMRep__Int] -- Tot hdrs
- -> Unpretty
+ -> Doc
-pprHeapOffsetPieces sty n ILIT(0) [] [] = uppInt IBOX(n) -- Deals with zero case too
+pprHeapOffsetPieces sty n ILIT(0) [] [] = int IBOX(n) -- Deals with zero case too
pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
= let pp_int_offs =
if int_offs _EQ_ ILIT(0)
then Nothing
- else Just (uppInt IBOX(int_offs))
+ 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 (uppPStr SLIT("_FHS"))
+ Just (ptext SLIT("_FHS"))
else
- Just (uppBesides [uppStr "(_FHS*", uppInt IBOX(fxdhdr_offs), uppChar ')'])
+ Just (hcat [char '(', ptext SLIT("_FHS*"), int IBOX(fxdhdr_offs), char ')'])
- pp_varhdr_offs = pp_hdrs (uppPStr SLIT("_VHS")) varhdr_offs
+ pp_varhdr_offs = pp_hdrs (ptext SLIT("_VHS")) varhdr_offs
- pp_tothdr_offs = pp_hdrs (uppPStr SLIT("_HS")) tothdr_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
- [] -> uppChar '0'
+ [] -> char '0'
[pp] -> pp -- Each blob is parenthesised if necessary
- pps -> uppBesides [ uppLparen, uppIntersperse (uppChar '+') pps, uppRparen ]
+ pps -> parens (hcat (punctuate (char '+') pps))
where
pp_hdrs hdr_pp [] = Nothing
- pp_hdrs hdr_pp [SMRI(rep, n)] | n _EQ_ ILIT(1) = Just (uppBeside (uppStr (show rep)) hdr_pp)
- pp_hdrs hdr_pp hdrs = Just (uppBesides [ uppLparen,
- uppInterleave (uppChar '+')
- (map (pp_hdr hdr_pp) hdrs),
- uppRparen ])
+ 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 :: Unpretty -> SMRep__Int -> Unpretty
+ pp_hdr :: Doc -> SMRep__Int -> Doc
pp_hdr pp_str (SMRI(rep, n))
= if n _EQ_ ILIT(1) then
- uppBeside (uppStr (show rep)) pp_str
- else
- uppBesides [uppInt IBOX(n), uppChar '*', uppStr (show rep), pp_str]
+ (<>) (text (show rep)) pp_str
+ else
+ hcat [int IBOX(n), char '*', text (show rep), pp_str]
\end{code}
%************************************************************************
\begin{code}
#if ! OMIT_NATIVE_CODEGEN
-hpRelToInt :: Target -> HeapOffset -> Int
+hpRelToInt :: HeapOffset -> Int
-hpRelToInt target (MaxHeapOffset left right)
- = (hpRelToInt target left) `max` (hpRelToInt target right)
+hpRelToInt ZeroHeapOffset = 0
-hpRelToInt target (SubHeapOffset left right)
- = (hpRelToInt target left) - (hpRelToInt target right)
+hpRelToInt (MaxHeapOffset left right)
+ = hpRelToInt left `max` hpRelToInt right
-hpRelToInt target (AddHeapOffset left right)
- = (hpRelToInt target left) + (hpRelToInt target right)
+hpRelToInt (SubHeapOffset left right)
+ = hpRelToInt left - hpRelToInt right
-hpRelToInt target ZeroHeapOffset = 0
+hpRelToInt (AddHeapOffset left right)
+ = hpRelToInt left + hpRelToInt right
-hpRelToInt target (MkHeapOffset base fhs vhs ths)
+hpRelToInt (MkHeapOffset base fhs vhs ths)
= let
vhs_pieces, ths_pieces :: [Int]
fhs_off, vhs_off, ths_off :: Int
in
IBOX(base) + fhs_off + vhs_off + ths_off
where
- fhs_size = (fixedHeaderSize target) :: Int
- vhs_size r = (varHeaderSize target r) :: Int
+ fhs_size = fixedHdrSizeInWords
+ vhs_size r = varHdrSizeInWords r
#endif
\end{code}
projects / ghc-hetmet.git / blobdiff