Skip to content
Snippets Groups Projects
Commit 1be6e009 authored by Simon Marlow's avatar Simon Marlow
Browse files

[project @ 1998-04-10 10:49:39 by simonm]

New Run-Time System Support, includes:

	- New code generator
	- Modifications to the mangler
	- Unboxed Tuple support
	- Various other minor changes.
parent dd04ed71
No related merge requests found
%
% (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}
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment