Commit 7a236a56 authored by simonmar's avatar simonmar

[project @ 2003-05-14 09:13:52 by simonmar]

Change the way SRTs are represented:

Previously, the SRT associated with a function or thunk would be a
sub-list of the enclosing top-level function's SRT.  But this approach
can lead to lots of duplication: if a CAF is referenced in several
different thunks, then it may appear several times in the SRT.
Let-no-escapes compound the problem, because the occurrence of a
let-no-escape-bound variable would expand to all the CAFs referred to
by the let-no-escape.

The new way is to describe the SRT associated with a function or thunk
as a (pointer+offset,bitmap) pair, where the pointer+offset points
into some SRT table (the enclosing function's SRT), and the bitmap
indicates which entries in this table are "live" for this closure.
The bitmap is stored in the 16 bits previously used for the length
field, but this rarely overflows.  When it does overflow, we store the
bitmap externally in a new "SRT descriptor".

Now the enclosing SRT can be a set, hence eliminating the duplicates.

Also, we now have one SRT per top-level function in a recursive group,
where previously we used to have one SRT for the whole group.  This
helps keep the size of SRTs down.

Bottom line: very little difference most of the time.  GHC itself got
slightly smaller.  One bad case of a module in GHC which had a huge
SRT has gone away.

While I was in the area:

  - Several parts of the back-end require bitmaps.  Functions for
    creating bitmaps are now centralised in the Bitmap module.

  - We were trying to be independent of word-size in a couple of
    places in the back end, but we've now abandoned that strategy so I
    simplified things a bit.
parent efbac413
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.51 2002/12/11 15:36:21 simonmar Exp $
% $Id: AbsCSyn.lhs,v 1.52 2003/05/14 09:13:52 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -51,7 +51,8 @@ import MachOp ( MachOp(..) )
import Unique ( Unique )
import StgSyn ( StgOp )
import TyCon ( TyCon )
import BitSet -- for liveness masks
import Bitmap ( Bitmap, mAX_SMALL_BITMAP_SIZE )
import SMRep ( StgWord, StgHalfWord )
import FastTypes
import FastString
\end{code}
......@@ -199,8 +200,15 @@ stored in a mixed type location.)
| CSRT CLabel [CLabel] -- SRT declarations: basically an array of
-- pointers to static closures.
| CBitmap Liveness -- A bitmap to be emitted if and only if
-- it is larger than a target machine word.
| CBitmap Liveness -- A "large" bitmap to be emitted
| CSRTDesc -- A "large" SRT descriptor (one that doesn't
-- fit into the half-word bitmap in the itbl).
!CLabel -- Label for this SRT descriptor
!CLabel -- Pointer to the SRT
!Int -- Offset within the SRT
!Int -- Length
!Bitmap -- Bitmap
| CClosureInfoAndCode
ClosureInfo -- Explains placement and layout of closure
......@@ -236,7 +244,7 @@ stored in a mixed type location.)
-- we add a label for the table, and expect only the 'offset/length' form
data C_SRT = NoC_SRT
| C_SRT CLabel !Int{-offset-} !Int{-length-}
| C_SRT !CLabel !Int{-offset-} !StgHalfWord{-bitmap or escape-}
needsSRT :: C_SRT -> Bool
needsSRT NoC_SRT = False
......@@ -365,10 +373,6 @@ data CAddrMode
!PrimRep -- the kind of the result
CExprMacro -- the macro to generate a value
[CAddrMode] -- and its arguments
| CBytesPerWord -- Word size, in bytes, on this platform
-- required for: half-word loads (used in fishing tags
-- out of info tables), and sizeofByteArray#.
\end{code}
Various C macros for values which are dependent on the back-end layout.
......@@ -392,6 +396,9 @@ Convenience functions:
mkIntCLit :: Int -> CAddrMode
mkIntCLit i = CLit (mkMachInt (toInteger i))
mkWordCLit :: StgWord -> CAddrMode
mkWordCLit wd = CLit (MachWord (fromIntegral wd))
mkCString :: FastString -> CAddrMode
mkCString s = CLit (MachStr s)
......@@ -449,16 +456,15 @@ vectors to indicate the state of the stack for the garbage collector.
In the compiled program, liveness bitmaps that fit inside a single
word (StgWord) are stored as a single word, while larger bitmaps are
stored as a pointer to an array of words. When we compile via C
(especially when we bootstrap via HC files), we generate identical C
code regardless of whether words are 32- or 64-bit on the target
machine, by postponing the decision of how to store each liveness
bitmap to C compilation time (or rather, C preprocessing time).
stored as a pointer to an array of words.
\begin{code}
type LivenessMask = [BitSet]
data Liveness = Liveness CLabel !Int Bitmap
data Liveness = Liveness CLabel !Int LivenessMask
maybeLargeBitmap :: Liveness -> AbstractC
maybeLargeBitmap liveness@(Liveness _ size _)
| size <= mAX_SMALL_BITMAP_SIZE = AbsCNop
| otherwise = CBitmap liveness
\end{code}
%************************************************************************
......
......@@ -38,6 +38,7 @@ import SMRep ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
import Outputable
import Panic ( panic )
import FastTypes
import Constants ( wORD_SIZE, wORD_SIZE_IN_BITS )
import Maybe ( isJust )
......@@ -419,6 +420,7 @@ flatAbsC (CSequential abcs)
flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CSRTDesc _ _ _ _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CBitmap _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt)
flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt)
......@@ -605,27 +607,24 @@ rrConflictsWithRR s1b s2b rr1 rr2 = rr rr1 rr2
-- why it needs to take into account endianness.
--
mkHalfWord_HIADDR res arg
= mkTemp IntRep `thenFlt` \ t_hw_shift ->
mkTemp WordRep `thenFlt` \ t_hw_mask1 ->
= mkTemp WordRep `thenFlt` \ t_hw_mask1 ->
mkTemp WordRep `thenFlt` \ t_hw_mask2 ->
let a_hw_shift
= CMachOpStmt t_hw_shift
MO_Nat_Shl [CBytesPerWord, CLit (mkMachInt 2)] Nothing
let
hw_shift = mkIntCLit (wORD_SIZE_IN_BITS `quot` 2)
a_hw_mask1
= CMachOpStmt t_hw_mask1
MO_Nat_Shl [CLit (mkMachWord 1), t_hw_shift] Nothing
MO_Nat_Shl [CLit (mkMachWord 1), hw_shift] Nothing
a_hw_mask2
= CMachOpStmt t_hw_mask2
MO_Nat_Sub [t_hw_mask1, CLit (mkMachWord 1)] Nothing
final
# if WORDS_BIGENDIAN
= CSequential [ a_hw_shift, a_hw_mask1, a_hw_mask2,
= CSequential [ a_hw_mask1, a_hw_mask2,
CMachOpStmt res MO_Nat_And [arg, t_hw_mask2] Nothing
]
# else
= CSequential [ a_hw_shift,
CMachOpStmt res MO_Nat_Shr [arg, t_hw_shift] Nothing
]
= CMachOpStmt res MO_Nat_Shr [arg, hw_shift] Nothing
# endif
in
returnFlt final
......@@ -726,19 +725,6 @@ translateOp_dyadic_cast1 mop res cast_arg1_to arg1 arg2 vols
(if isDefinitelyInlineMachOp mop then Nothing else Just vols)
]
getBitsPerWordMinus1 :: FlatM (AbstractC, CAddrMode)
getBitsPerWordMinus1
= mkTemps [IntRep, IntRep] `thenFlt` \ [t1,t2] ->
returnFlt (
CSequential [
CMachOpStmt t1 MO_Nat_Shl
[CBytesPerWord, CLit (mkMachInt 3)] Nothing,
CMachOpStmt t2 MO_Nat_Sub
[t1, CLit (mkMachInt 1)] Nothing
],
t2
)
-- IA64 mangler doesn't place tables next to code
tablesNextToCode :: Bool
#ifdef ia64_TARGET_ARCH
......@@ -790,15 +776,14 @@ dscCOpStmt [res_r,res_c] IntAddCOp [aa,bb] vols
c = t4 >>unsigned BITS_IN(I_)-1
-}
= mkTemps [IntRep,IntRep,IntRep,IntRep] `thenFlt` \ [t1,t2,t3,t4] ->
getBitsPerWordMinus1 `thenFlt` \ (bpw1_code,bpw1_t) ->
let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in
(returnFlt . CSequential) [
CMachOpStmt res_r MO_Nat_Add [aa,bb] Nothing,
CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing,
CMachOpStmt t2 MO_Nat_Not [t1] Nothing,
CMachOpStmt t3 MO_Nat_Xor [aa,res_r] Nothing,
CMachOpStmt t4 MO_Nat_And [t2,t3] Nothing,
bpw1_code,
CMachOpStmt res_c MO_Nat_Shr [t4, bpw1_t] Nothing
CMachOpStmt res_c MO_Nat_Shr [t4, bpw1] Nothing
]
......@@ -818,14 +803,13 @@ dscCOpStmt [res_r,res_c] IntSubCOp [aa,bb] vols
c = t3 >>unsigned BITS_IN(I_)-1
-}
= mkTemps [IntRep,IntRep,IntRep] `thenFlt` \ [t1,t2,t3] ->
getBitsPerWordMinus1 `thenFlt` \ (bpw1_code,bpw1_t) ->
let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in
(returnFlt . CSequential) [
CMachOpStmt res_r MO_Nat_Sub [aa,bb] Nothing,
CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing,
CMachOpStmt t2 MO_Nat_Xor [aa,res_r] Nothing,
CMachOpStmt t3 MO_Nat_And [t1,t2] Nothing,
bpw1_code,
CMachOpStmt res_c MO_Nat_Shr [t3, bpw1_t] Nothing
CMachOpStmt res_c MO_Nat_Shr [t3, bpw1] Nothing
]
......@@ -864,7 +848,7 @@ dscCOpStmt [res] SizeofByteArrayOp [arg] vols
= mkTemp WordRep `thenFlt` \ w ->
(returnFlt . CSequential) [
CAssign w (mkDerefOff WordRep arg fixedHdrSize),
CMachOpStmt w MO_NatU_Mul [w, CBytesPerWord] (Just vols),
CMachOpStmt w MO_NatU_Mul [w, mkIntCLit wORD_SIZE] (Just vols),
CAssign res w
]
......
......@@ -9,6 +9,7 @@ module CLabel (
mkClosureLabel,
mkSRTLabel,
mkSRTDescLabel,
mkInfoTableLabel,
mkEntryLabel,
mkSlowEntryLabel,
......@@ -151,6 +152,7 @@ data CLabel
data IdLabelInfo
= Closure -- Label for (static???) closure
| SRT -- Static reference table
| SRTDesc -- Static reference table descriptor
| InfoTbl -- Info tables for closures; always read-only
| Entry -- entry point
| Slow -- slow entry point
......@@ -223,6 +225,7 @@ data CLabelType
\begin{code}
mkClosureLabel id = IdLabel id Closure
mkSRTLabel id = IdLabel id SRT
mkSRTDescLabel id = IdLabel id SRTDesc
mkInfoTableLabel id = IdLabel id InfoTbl
mkEntryLabel id = IdLabel id Entry
mkSlowEntryLabel id = IdLabel id Slow
......@@ -320,6 +323,7 @@ let-no-escapes, which can be recursive.
-- don't bother declaring SRT & Bitmap labels, we always make sure
-- they are defined before use.
needsCDecl (IdLabel _ SRT) = False
needsCDecl (IdLabel _ SRTDesc) = False
needsCDecl (IdLabel _ Bitmap) = False
needsCDecl (IdLabel _ _) = True
needsCDecl (CaseLabel _ CaseReturnPt) = True
......@@ -446,6 +450,7 @@ internal names. <type> is one of the following:
info Info table
srt Static reference table
srtd Static reference table descriptor
entry Entry code
slow Slow entry code (if any)
ret Direct return address
......@@ -572,6 +577,7 @@ ppIdFlavor x = pp_cSEP <>
(case x of
Closure -> ptext SLIT("closure")
SRT -> ptext SLIT("srt")
SRTDesc -> ptext SLIT("srtd")
InfoTbl -> ptext SLIT("info")
Entry -> ptext SLIT("entry")
Slow -> ptext SLIT("slow")
......
......@@ -53,11 +53,9 @@ import UniqSet ( emptyUniqSet, elementOfUniqSet,
addOneToUniqSet, UniqSet
)
import StgSyn ( StgOp(..) )
import BitSet ( BitSet, intBS )
import Outputable
import FastString
import Util ( lengthExceeds )
import Constants ( wORD_SIZE )
#if __GLASGOW_HASKELL__ >= 504
import Data.Array.ST
......@@ -299,11 +297,14 @@ pprAbsC stmt@(CSRT lbl closures) c
}
pprAbsC stmt@(CBitmap liveness@(Liveness lbl size mask)) c
= pp_liveness_switch liveness semi $
hcat [ ptext SLIT("BITMAP"), lparen,
pprCLabel lbl, comma,
int size, comma,
pp_bitmap mask, rparen ]
= pprWordArray lbl (mkWordCLit (fromIntegral size) : bitmapAddrModes mask)
pprAbsC stmt@(CSRTDesc desc_lbl srt_lbl off len bitmap) c
= pprWordArray desc_lbl (
CAddr (CIndex (CLbl srt_lbl DataPtrRep) (mkIntCLit off) WordRep) :
mkWordCLit (fromIntegral len) :
bitmapAddrModes bitmap
)
pprAbsC (CSimultaneous abs_c) c
= hcat [ptext SLIT("{{"), pprAbsC abs_c c, ptext SLIT("}}")]
......@@ -460,7 +461,7 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
rep = getAmodeRep item
pprAbsC stmt@(CClosureInfoAndCode cl_info entry) _
= pprInfoTable info_lbl (mkInfoTable cl_info)
= pprWordArray info_lbl (mkInfoTable cl_info)
$$ let stuff = CCodeBlock entry_lbl entry in
pprAbsC stuff (costs stuff)
where
......@@ -477,7 +478,7 @@ pprAbsC stmt@(CClosureTbl tycon) _
) $$ ptext SLIT("};")
pprAbsC stmt@(CRetDirect uniq code srt liveness) _
= pprInfoTable info_lbl (mkRetInfoTable entry_lbl srt liveness)
= pprWordArray info_lbl (mkRetInfoTable entry_lbl srt liveness)
$$ let stuff = CCodeBlock entry_lbl code in
pprAbsC stuff (costs stuff)
where
......@@ -485,7 +486,7 @@ pprAbsC stmt@(CRetDirect uniq code srt liveness) _
entry_lbl = mkReturnPtLabel uniq
pprAbsC stmt@(CRetVector lbl amodes srt liveness) _
= pprInfoTable lbl (mkVecInfoTable amodes srt liveness)
= pprWordArray lbl (mkVecInfoTable amodes srt liveness)
pprAbsC stmt@(CModuleInitBlock plain_lbl lbl code) _
= vcat [
......@@ -504,12 +505,12 @@ Info tables... just arrays of words (the translation is done in
ClosureInfo).
\begin{code}
pprInfoTable info_lbl amodes
pprWordArray lbl amodes
= (case snd (initTE (ppr_decls_Amodes amodes)) of
Just pp -> pp
Nothing -> empty)
$$ hcat [ ppLocalness info_lbl, ptext SLIT("StgWord "),
pprCLabel info_lbl, ptext SLIT("[] = {") ]
$$ hcat [ ppLocalness lbl, ptext SLIT("StgWord "),
pprCLabel lbl, ptext SLIT("[] = {") ]
$$ hcat (punctuate comma (map (castToWord.pprAmode) amodes))
$$ ptext SLIT("};")
......@@ -1128,9 +1129,6 @@ That is, the indexing is done in units of kind1, but the resulting
amode has kind2.
\begin{code}
ppr_amode CBytesPerWord
= text "(sizeof(void*))"
ppr_amode (CVal reg_rel@(CIndex _ _ _) kind)
= case (pprRegRelative False{-no sign wanted-} reg_rel) of
(pp_reg, Nothing) -> panic "ppr_amode: CIndex"
......@@ -1213,9 +1211,6 @@ cCheckMacroText HP_CHK_L1 = SLIT("HP_CHK_L1")
cCheckMacroText HP_CHK_UNBX_TUPLE = SLIT("HP_CHK_UNBX_TUPLE")
\end{code}
\begin{code}
\end{code}
%************************************************************************
%* *
\subsection[ppr-liveness-masks]{Liveness Masks}
......@@ -1223,34 +1218,8 @@ cCheckMacroText HP_CHK_UNBX_TUPLE = SLIT("HP_CHK_UNBX_TUPLE")
%************************************************************************
\begin{code}
pp_bitmap_switch :: Int -> SDoc -> SDoc -> SDoc
pp_bitmap_switch size small large
| size <= mAX_SMALL_BITMAP_SIZE = small
| otherwise = large
-- magic numbers, must agree with BITMAP_BITS_SHIFT in InfoTables.h
mAX_SMALL_BITMAP_SIZE | wORD_SIZE == 4 = 27
| otherwise = 58
pp_liveness_switch :: Liveness -> SDoc -> SDoc -> SDoc
pp_liveness_switch (Liveness _ size _) = pp_bitmap_switch size
pp_bitset :: BitSet -> SDoc
pp_bitset s
| i < -1 = int (i + 1) <> text "-1"
| otherwise = int i
where i = intBS s
pp_bitmap :: [BitSet] -> SDoc
pp_bitmap [] = int 0
pp_bitmap ss = hcat (punctuate (ptext SLIT(" COMMA ")) (bundle ss)) where
bundle [] = []
bundle [s] = [hcat bitmap32]
where bitmap32 = [ptext SLIT("BITMAP32"), lparen,
pp_bitset s, rparen]
bundle (s1:s2:ss) = hcat bitmap64 : bundle ss
where bitmap64 = [ptext SLIT("BITMAP64"), lparen,
pp_bitset s1, comma, pp_bitset s2, rparen]
bitmapAddrModes [] = [mkWordCLit 0]
bitmapAddrModes xs = map mkWordCLit xs
\end{code}
%************************************************************************
......
--
-- (c) The University of Glasgow 2003
--
-- Functions for constructing bitmaps, which are used in various
-- places in generated code (stack frame liveness masks, function
-- argument liveness masks, SRT bitmaps).
module Bitmap (
Bitmap, mkBitmap,
intsToBitmap, intsToReverseBitmap,
mAX_SMALL_BITMAP_SIZE
) where
#include "HsVersions.h"
#include "../includes/MachDeps.h"
import SMRep
import Constants
import DATA_BITS
{-|
A bitmap represented by a sequence of 'StgWord's on the /target/
architecture. These are used for bitmaps in info tables and other
generated code which need to be emitted as sequences of StgWords.
-}
type Bitmap = [StgWord]
-- | Make a bitmap from a sequence of bits
mkBitmap :: [Bool] -> Bitmap
mkBitmap [] = []
mkBitmap stuff = chunkToBitmap chunk : mkBitmap rest
where (chunk, rest) = splitAt wORD_SIZE_IN_BITS stuff
chunkToBitmap :: [Bool] -> StgWord
chunkToBitmap chunk =
foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
-- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
-- eg. @[1,2,4], size 4 ==> 0xb@.
--
-- The list of @Int@s /must/ be already sorted.
intsToBitmap :: Int -> [Int] -> Bitmap
intsToBitmap size slots{- must be sorted -}
| size <= 0 = []
| otherwise =
(foldr (.|.) 0 (map (1 `shiftL`) these)) :
intsToBitmap (size - wORD_SIZE_IN_BITS)
(map (\x -> x - wORD_SIZE_IN_BITS) rest)
where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
-- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
-- eg. @[1,2,4], size 4 ==> 0x8@ (we leave any bits outside the size as zero,
-- just to make the bitmap easier to read).
--
-- The list of @Int@s /must/ be already sorted.
intsToReverseBitmap :: Int -> [Int] -> Bitmap
intsToReverseBitmap size slots{- must be sorted -}
| size <= 0 = []
| otherwise =
(foldr xor init (map (1 `shiftL`) these)) :
intsToBitmap (size - wORD_SIZE_IN_BITS)
(map (\x -> x - wORD_SIZE_IN_BITS) rest)
where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
init
| size >= wORD_SIZE_IN_BITS = complement 0
| otherwise = (1 `shiftL` size) - 1
{-|
Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
Some kinds of bitmap pack a size/bitmap into a single word if
possible, or fall back to an external pointer when the bitmap is too
large. This value represents the largest size of bitmap that can be
packed into a single word.
-}
mAX_SMALL_BITMAP_SIZE :: Int
mAX_SMALL_BITMAP_SIZE | wORD_SIZE == 4 = 27
| otherwise = 58
......@@ -36,7 +36,7 @@ import CgStackery ( freeStackSlots, getStackFrame )
import CLabel ( mkClosureLabel,
mkBitmapLabel, pprCLabel )
import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
import BitSet
import Bitmap
import PrimRep ( isFollowableRep, getPrimRepSize )
import Id ( Id, idPrimRep, idType )
import Type ( typePrimRep )
......@@ -443,7 +443,7 @@ with initially all bits set (up to the size of the stack frame).
buildLivenessMask
:: VirtualSpOffset -- size of the stack frame
-> VirtualSpOffset -- offset from which the bitmap should start
-> FCode LivenessMask -- mask for free/unlifted slots
-> FCode Bitmap -- mask for free/unlifted slots
buildLivenessMask size sp = do {
-- find all live stack-resident pointers
......@@ -459,24 +459,9 @@ buildLivenessMask size sp = do {
};
ASSERT(all (>=0) rel_slots)
return (listToLivenessMask size rel_slots)
return (intsToReverseBitmap size rel_slots)
}
-- make a bitmap where the slots specified are the *zeros* in the bitmap.
-- eg. [1,2,4], size 4 ==> 0x8 (we leave any bits outside the size as zero,
-- just to make the bitmap easier to read).
listToLivenessMask :: Int -> [Int] -> [BitSet]
listToLivenessMask size slots{- must be sorted -}
| size <= 0 = []
| otherwise = init `minusBS` mkBS these :
listToLivenessMask (size - 32) (map (\x -> x - 32) rest)
where (these,rest) = span (<32) slots
init
| size >= 32 = all_ones
| otherwise = mkBS [0..size-1]
all_ones = mkBS [0..31]
-- In a continuation, we want a liveness mask that starts from just after
-- the return address, which is on the stack at realSp.
......@@ -493,7 +478,7 @@ buildContLivenessMask name = do
mask <- buildLivenessMask frame_size (realSp-1)
let liveness = Liveness (mkBitmapLabel name) frame_size mask
absC (CBitmap liveness)
absC (maybeLargeBitmap liveness)
return liveness
\end{code}
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.61 2002/12/11 15:36:25 simonmar Exp $
% $Id: CgCase.lhs,v 1.62 2003/05/14 09:13:53 simonmar Exp $
%
%********************************************************
%* *
......@@ -53,7 +53,7 @@ import PrimOp ( primOpOutOfLine, PrimOp(..) )
import PrimRep ( getPrimRepSize, retPrimRepSize, PrimRep(..)
)
import TyCon ( isEnumerationTyCon, isUnboxedTupleTyCon, tyConPrimRep )
import Name ( getName )
import Name ( Name, getName )
import Unique ( Unique, Uniquable(..), newTagUnique )
import Maybes ( maybeToBool )
import Util ( only )
......@@ -389,9 +389,9 @@ cgEvalAlts :: Maybe VirtualSpOffset -- Offset of cost-centre to be restored, if
cgEvalAlts cc_slot bndr srt alts
=
let uniq = getUnique bndr in
let uniq = getUnique bndr; name = getName bndr in
buildContLivenessMask (getName bndr) `thenFC` \ liveness ->
buildContLivenessMask name `thenFC` \ liveness ->
case alts of
......@@ -427,7 +427,7 @@ cgEvalAlts cc_slot bndr srt alts
lbl = mkReturnInfoLabel uniq
in
cgUnboxedTupleAlt uniq cc_slot True alt `thenFC` \ abs_c ->
getSRTInfo srt `thenFC` \ srt_info ->
getSRTInfo name srt `thenFC` \ srt_info ->
absC (CRetDirect uniq abs_c srt_info liveness) `thenC`
returnFC (CaseAlts (CLbl lbl RetRep) Nothing False)
......@@ -450,7 +450,7 @@ cgEvalAlts cc_slot bndr srt alts
cgAlgAlts GCMayHappen (not is_alg) uniq cc_slot use_labelled_alts
alts deflt True `thenFC` \ (tagged_alt_absCs, deflt_absC) ->
mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness
mkReturnVector name tagged_alt_absCs deflt_absC srt liveness
ret_conv `thenFC` \ return_vec ->
returnFC (CaseAlts return_vec semi_tagged_stuff False)
......@@ -465,7 +465,7 @@ cgEvalAlts cc_slot bndr srt alts
getAbsC (cgPrimEvalAlts bndr tycon alts deflt) `thenFC` \ abs_c ->
-- Generate the labelled block, starting with restore-cost-centre
getSRTInfo srt `thenFC` \srt_info ->
getSRTInfo name srt `thenFC` \srt_info ->
absC (CRetDirect uniq (cc_restore `mkAbsCStmts` abs_c)
srt_info liveness) `thenC`
......@@ -810,7 +810,7 @@ Build a return vector, and return a suitable label addressing
mode for it.
\begin{code}
mkReturnVector :: Unique
mkReturnVector :: Name
-> [(ConTag, AbstractC)] -- Branch codes
-> AbstractC -- Default case
-> SRT -- continuation's SRT
......@@ -818,8 +818,8 @@ mkReturnVector :: Unique
-> CtrlReturnConvention
-> FCode CAddrMode
mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
= getSRTInfo srt `thenFC` \ srt_info ->
mkReturnVector name tagged_alt_absCs deflt_absC srt liveness ret_conv
= getSRTInfo name srt `thenFC` \ srt_info ->
let
(return_vec_amode, vtbl_body) = case ret_conv of {
......@@ -858,6 +858,7 @@ mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
returnFC return_vec_amode
-- )
where
uniq = getUnique name
vtbl_label = mkVecTblLabel uniq
ret_label = mkReturnInfoLabel uniq
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.59 2002/12/11 15:36:25 simonmar Exp $
% $Id: CgClosure.lhs,v 1.60 2003/05/14 09:13:53 simonmar Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -70,8 +70,11 @@ cgTopRhsClosure :: Id
cgTopRhsClosure id ccs binder_info srt args body lf_info
=
let
name = idName id
in
-- LAY OUT THE OBJECT
getSRTInfo srt `thenFC` \ srt_info ->
getSRTInfo name srt `thenFC` \ srt_info ->
moduleName `thenFC` \ mod_name ->
let
name = idName id
......@@ -177,10 +180,12 @@ cgRhsClosure binder cc binder_info srt fvs args body lf_info
reduced_fvs = if binder_is_a_fv
then fvs `minusList` [binder]
else fvs
name = idName binder
in
mapFCs getCAddrModeAndInfo reduced_fvs `thenFC` \ fvs_w_amodes_and_info ->
getSRTInfo srt `thenFC` \ srt_info ->
getSRTInfo name srt `thenFC` \ srt_info ->
moduleName `thenFC` \ mod_name ->
let
descr = closureDescription mod_name (idName binder)
......@@ -303,7 +308,7 @@ closureCodeBody binder_info closure_info cc all_args body
--
(case closureFunInfo closure_info of
Just (_, ArgGen slow_lbl liveness) ->
absC (CBitmap liveness) `thenC`
absC (maybeLargeBitmap liveness) `thenC`
absC (mkSlowEntryCode name slow_lbl arg_regs arg_reps) `thenC`
returnFC (mkRegSaveCode arg_regs arg_reps)
......
......@@ -66,9 +66,8 @@ import List ( partition )
cgTopRhsCon :: Id -- Name of thing bound to this RHS
-> DataCon -- Id
-> [StgArg] -- Args
-> SRT
-> FCode (Id, CgIdInfo)
cgTopRhsCon id con args srt
cgTopRhsCon id con args
= ASSERT( not (isDllConApp con args) ) -- checks for litlit args too
ASSERT( args `lengthIs` dataConRepArity con )
......@@ -81,6 +80,7 @@ cgTopRhsCon id con args srt
closure_label = mkClosureLabel name
(closure_info, amodes_w_offsets)
= layOutStaticConstr con getAmodeRep amodes
caffy = any stgArgHasCafRefs args
in
-- BUILD THE OBJECT
......@@ -89,7 +89,7 @@ cgTopRhsCon id con args srt
closure_info
dontCareCCS -- because it's static data
(map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs
(nonEmptySRT srt) -- has CAF refs
caffy -- has CAF refs
) `thenC`
-- NOTE: can't use idCafInfo instead of nonEmptySRT above,
-- because top-level constructors that were floated by
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgExpr.lhs,v 1.52 2002/12/11 15:36:26 simonmar Exp $
% $Id: CgExpr.lhs,v 1.53 2003/05/14 09:13:55 simonmar Exp $