Commit 030787e5 authored by ken's avatar ken

[project @ 2001-07-24 05:04:58 by ken]

Removed 32-bit dependencies in the generation and handling of
liveness mask bitmaps.  We now support both 32-bit and 64-bit
machines with identical .hc files.  Support for >64-bit machines
would be easy to add.  Note that old .hc files are incompatible
with the changes made to ghc/include/InfoMacros.h!
parent 1146fac5
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.36 2001/05/22 13:43:14 simonpj Exp $
% $Id: AbsCSyn.lhs,v 1.37 2001/07/24 05:04:58 ken Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -177,7 +177,8 @@ stored in a mixed type location.)
| CSRT CLabel [CLabel] -- SRT declarations: basically an array of
-- pointers to static closures.
| CBitmap CLabel LivenessMask -- A larger-than-32-bits bitmap.
| CBitmap CLabel LivenessMask -- A bitmap to be emitted if and only if
-- it is larger than a target machine word.
| CClosureInfoAndCode
ClosureInfo -- Explains placement and layout of closure
......@@ -412,11 +413,18 @@ We represent liveness bitmaps as a BitSet (whose internal
representation really is a bitmap). These are pinned onto case return
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).
\begin{code}
type LivenessMask = [BitSet]
data Liveness = LvSmall BitSet
| LvLarge CLabel
data Liveness = Liveness CLabel LivenessMask
\end{code}
%************************************************************************
......
......@@ -54,7 +54,7 @@ import UniqSet ( emptyUniqSet, elementOfUniqSet,
addOneToUniqSet, UniqSet
)
import StgSyn ( SRT(..), StgOp(..) )
import BitSet ( intBS )
import BitSet ( BitSet, intBS )
import Outputable
import GlaExts
import Util ( nOfThem )
......@@ -258,14 +258,11 @@ pprAbsC stmt@(CSRT lbl closures) c
}
pprAbsC stmt@(CBitmap lbl mask) c
= vcat [
hcat [ ptext SLIT("BITMAP"), lparen,
pprCLabel lbl, comma,
int (length mask),
rparen ],
hcat (punctuate comma (map (int.intBS) mask)),
ptext SLIT("}};")
]
= pp_bitmap_switch mask semi $
hcat [ ptext SLIT("BITMAP"), lparen,
pprCLabel lbl, comma,
int (length mask), comma,
pp_bitmap mask, rparen ]
pprAbsC (CSimultaneous abs_c) c
= hcat [ptext SLIT("{{"), pprAbsC abs_c c, ptext SLIT("}}")]
......@@ -520,7 +517,7 @@ pprAbsC stmt@(CRetDirect uniq code srt liveness) _
pprCLabel entry_lbl, comma,
pp_liveness liveness, comma, -- bitmap
pp_srt_info srt, -- SRT
ptext type_str, comma, -- closure type
closure_type, comma, -- closure type
ppLocalness info_lbl, comma, -- info table storage class
ppLocalnessMacro True{-include dyn-} entry_lbl, comma, -- entry pt storage class
int 0, comma,
......@@ -529,15 +526,15 @@ pprAbsC stmt@(CRetDirect uniq code srt liveness) _
pp_code
]
where
info_lbl = mkReturnInfoLabel uniq
entry_lbl = mkReturnPtLabel uniq
info_lbl = mkReturnInfoLabel uniq
entry_lbl = mkReturnPtLabel uniq
pp_code = let stuff = CCodeBlock entry_lbl code in
pprAbsC stuff (costs stuff)
pp_code = let stuff = CCodeBlock entry_lbl code in
pprAbsC stuff (costs stuff)
type_str = case liveness of
LvSmall _ -> SLIT("RET_SMALL")
LvLarge _ -> SLIT("RET_BIG")
closure_type = pp_liveness_switch liveness
(ptext SLIT("RET_SMALL"))
(ptext SLIT("RET_BIG"))
pprAbsC stmt@(CRetVector lbl amodes srt liveness) _
= case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
......@@ -549,7 +546,7 @@ pprAbsC stmt@(CRetVector lbl amodes srt liveness) _
pprCLabel lbl, comma,
pp_liveness liveness, comma, -- bitmap liveness mask
pp_srt_info srt, -- SRT
ptext type_str, comma,
closure_type, comma,
ppLocalness lbl, comma
],
nest 2 (sep (punctuate comma (map ppr_item amodes))),
......@@ -561,9 +558,9 @@ pprAbsC stmt@(CRetVector lbl amodes srt liveness) _
ppr_item item = (<>) (text "(F_) ") (ppr_amode item)
size = length amodes
type_str = case liveness of
LvSmall _ -> SLIT("RET_VEC_SMALL")
LvLarge _ -> SLIT("RET_VEC_BIG")
closure_type = pp_liveness_switch liveness
(ptext SLIT("RET_VEC_SMALL"))
(ptext SLIT("RET_VEC_BIG"))
pprAbsC stmt@(CModuleInitBlock lbl code) _
......@@ -1187,15 +1184,37 @@ cCheckMacroText HP_CHK_GEN = SLIT("HP_CHK_GEN")
%************************************************************************
\begin{code}
pp_bitmap_switch :: [BitSet] -> SDoc -> SDoc -> SDoc
pp_bitmap_switch ([ ]) small large = small
pp_bitmap_switch ([_ ]) small large = small
pp_bitmap_switch ([_,_]) small large = hcat
[ptext SLIT("BITMAP_SWITCH64"), lparen, small, comma, large, rparen]
pp_bitmap_switch (_ ) small large = large
pp_liveness_switch :: Liveness -> SDoc -> SDoc -> SDoc
pp_liveness_switch (Liveness lbl mask) = pp_bitmap_switch mask
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 delayed_comma (bundle ss)) where
delayed_comma = hcat [space, ptext SLIT("COMMA"), space]
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]
pp_liveness :: Liveness -> SDoc
pp_liveness lv =
case lv of
LvLarge lbl -> char '&' <> pprCLabel lbl
LvSmall mask -- Avoid gcc bug when printing minInt
| bitmap_int == minInt -> int (bitmap_int+1) <> text "-1"
| otherwise -> int bitmap_int
where
bitmap_int = intBS mask
pp_liveness (Liveness lbl mask)
= pp_bitmap_switch mask (pp_bitmap mask) (char '&' <> pprCLabel lbl)
\end{code}
%************************************************************************
......
......@@ -425,8 +425,6 @@ rebindToStack name offset
%* *
%************************************************************************
ToDo: remove the dependency on 32-bit words.
There are four kinds of things on the stack:
- pointer variables (bound in the environment)
......@@ -499,11 +497,9 @@ listToLivenessMask slots =
where (this,rest) = span (<32) slots
livenessToAbsC :: Unique -> LivenessMask -> FCode Liveness
livenessToAbsC uniq [] = returnFC (LvSmall emptyBS)
livenessToAbsC uniq [one] = returnFC (LvSmall one)
livenessToAbsC uniq many =
absC (CBitmap lbl many) `thenC`
returnFC (LvLarge lbl)
livenessToAbsC uniq mask =
absC (CBitmap lbl mask) `thenC`
returnFC (Liveness lbl mask)
where lbl = mkBitmapLabel uniq
\end{code}
......
......@@ -34,7 +34,8 @@ import Maybes ( maybeToBool )
import StgSyn ( StgOp(..) )
import PrimOp ( primOpNeedsWrapper, PrimOp(..) )
import PrimRep ( isFloatingRep, PrimRep(..) )
import StixInfo ( genCodeInfoTable, genBitmapInfoTable )
import StixInfo ( genCodeInfoTable, genBitmapInfoTable,
livenessIsSmall, bitmapToIntegers )
import StixMacro ( macroCode, checkCode )
import StixPrim ( primCode, foreignCallCode, amodeToStix, amodeToStix' )
import Outputable ( pprPanic, ppr )
......@@ -43,7 +44,6 @@ import Util ( naturalMergeSortLe )
import Panic ( panic )
import TyCon ( tyConDataCons )
import DataCon ( dataConWrapId )
import BitSet ( intBS )
import Name ( NamedThing(..) )
import CmdLineOpts ( opt_Static, opt_EnsureSplittableC )
import Outputable ( assertPanic )
......@@ -106,9 +106,7 @@ Here we handle top-level things, like @CCodeBlock@s and
where
lbl_info = mkReturnInfoLabel uniq
lbl_ret = mkReturnPtLabel uniq
closure_type = case liveness of
LvSmall _ -> rET_SMALL
LvLarge _ -> rET_BIG
closure_type = if livenessIsSmall liveness then rET_SMALL else rET_BIG
gentopcode stmt@(CClosureInfoAndCode cl_info slow Nothing _)
......@@ -151,11 +149,13 @@ Here we handle top-level things, like @CCodeBlock@s and
= StCLbl label
gentopcode stmt@(CBitmap lbl mask)
= returnUs [ StSegment TextSegment
, StLabel lbl
, StData WordRep (StInt (toInteger (length mask)) :
map (StInt . toInteger . intBS) mask)
]
= returnUs $ case bitmapToIntegers mask of
mask'@(_:_:_) ->
[ StSegment TextSegment
, StLabel lbl
, StData WordRep (map StInt (toInteger (length mask') : mask'))
]
_ -> []
gentopcode stmt@(CClosureTbl tycon)
= returnUs [ StSegment TextSegment
......@@ -200,9 +200,7 @@ Here we handle top-level things, like @CCodeBlock@s and
returnUs (\xs -> vectbl : itbl xs)
where
vectbl = StData PtrRep (reverse (map a2stix amodes))
closure_type = case liveness of
LvSmall _ -> rET_VEC_SMALL
LvLarge _ -> rET_VEC_BIG
closure_type = if livenessIsSmall liveness then rET_VEC_SMALL else rET_VEC_BIG
\end{code}
......
......@@ -3,10 +3,17 @@
%
\begin{code}
module StixInfo ( genCodeInfoTable, genBitmapInfoTable ) where
module StixInfo (
genCodeInfoTable, genBitmapInfoTable,
bitmapToIntegers, bitmapIsSmall, livenessIsSmall
) where
#include "HsVersions.h"
#include "../includes/config.h"
#include "NCG.h"
import AbsCSyn ( AbstractC(..), Liveness(..) )
import CLabel ( CLabel )
......@@ -20,7 +27,7 @@ import PrimRep ( PrimRep(..) )
import SMRep ( getSMRepClosureTypeInt )
import Stix -- all of it
import UniqSupply ( returnUs, UniqSM )
import BitSet ( intBS )
import BitSet ( BitSet, intBS )
import Maybes ( maybeToBool )
import Bits
......@@ -122,8 +129,11 @@ genBitmapInfoTable liveness srt closure_type include_srt
]
layout_info = case liveness of
LvSmall mask -> StInt (toInteger (intBS mask))
LvLarge lbl -> StCLbl lbl
Liveness lbl mask ->
case bitmapToIntegers mask of
[ ] -> StInt 0
[i] -> StInt i
_ -> StCLbl lbl
type_info :: Word32
#ifdef WORDS_BIGENDIAN
......@@ -140,4 +150,28 @@ genBitmapInfoTable liveness srt closure_type include_srt
(lbl, SRT off len) ->
(StIndex DataPtrRep (StCLbl lbl)
(StInt (toInteger off)), len)
bitmapToIntegers :: [BitSet] -> [Integer]
bitmapToIntegers = bundle . map (toInteger . intBS)
where
#if BYTES_PER_WORD == 4
bundle = id
#else
bundle [] = []
bundle is = case splitAt (BYTES_PER_WORD/4) is of
(these, those) ->
( foldr1 (\x y -> x + 4294967296 * y)
[x `mod` 4294967296 | x <- these]
: bundle those
)
#endif
bitmapIsSmall :: [BitSet] -> Bool
bitmapIsSmall bitmap
= case bitmapToIntegers bitmap of
_:_:_ -> False
_ -> True
livenessIsSmall :: Liveness -> Bool
livenessIsSmall (Liveness _ mask) = bitmapIsSmall mask
\end{code}
/* ----------------------------------------------------------------------------
* $Id: InfoMacros.h,v 1.15 2001/07/23 23:14:58 ken Exp $
* $Id: InfoMacros.h,v 1.16 2001/07/24 05:04:58 ken Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -617,8 +617,19 @@ typedef vec_info_8 StgPolyInfoTable;
#define SRT(lbl) \
static const StgSRT lbl = {
#define BITMAP(lbl,size) \
static const StgLargeBitmap lbl = { size, {
#define BITMAP(lbl,size,contents) \
static const StgLargeBitmap lbl = { size, { contents } };
#if SIZEOF_VOID_P == 8
#define BITMAP_SWITCH64(small, large) small
#define BITMAP64(first, second) \
(((StgWord32)(first)) | ((StgWord)(StgWord32)(second) << 32))
#else
#define BITMAP_SWITCH64(small, large) large
#define BITMAP64(first, second) first, second
#endif
#define BITMAP32(x) ((StgWord32)(x))
#define COMMA ,
/* DLL_SRT_ENTRY is used on the Win32 side when filling initialising
an entry in an SRT table with a reference to a closure that's
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.104 2001/07/23 17:23:19 simonmar Exp $
* $Id: GC.c,v 1.105 2001/07/24 05:04:58 ken Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -3049,7 +3049,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
{
StgPtr q;
const StgInfoTable* info;
StgWord32 bitmap;
StgWord bitmap;
//IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end));
......@@ -3196,7 +3196,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
scavenge_srt(info);
continue;
// large bitmap (> 32 entries)
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
case RET_VEC_BIG:
{
......@@ -3209,7 +3209,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
for (i=0; i<large_bitmap->size; i++) {
bitmap = large_bitmap->bitmap[i];
q = p + sizeof(W_) * 8;
q = p + BITS_IN(W_);
while (bitmap != 0) {
if ((bitmap & 1) == 0) {
(StgClosure *)*p = evacuate((StgClosure *)*p);
......
/* -----------------------------------------------------------------------------
* $Id: Sanity.c,v 1.28 2001/07/23 17:23:19 simonmar Exp $
* $Id: Sanity.c,v 1.29 2001/07/24 05:04:59 ken Exp $
*
* (c) The GHC Team, 1998-2001
*
......@@ -59,7 +59,7 @@
static StgOffset checkStackClosure ( StgClosure* c );
static StgOffset checkStackObject ( StgPtr sp );
static StgOffset checkSmallBitmap ( StgPtr payload, StgWord32 bitmap );
static StgOffset checkSmallBitmap ( StgPtr payload, StgWord bitmap );
static StgOffset checkLargeBitmap ( StgPtr payload, StgLargeBitmap* );
static void checkClosureShallow ( StgClosure* p );
......@@ -68,7 +68,7 @@ static void checkClosureShallow ( StgClosure* p );
-------------------------------------------------------------------------- */
static StgOffset
checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
checkSmallBitmap( StgPtr payload, StgWord bitmap )
{
StgOffset i;
......@@ -84,12 +84,12 @@ checkSmallBitmap( StgPtr payload, StgWord32 bitmap )
static StgOffset
checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap )
{
StgWord32 bmp;
StgWord bmp;
StgOffset i;
i = 0;
for (bmp=0; bmp<large_bitmap->size; bmp++) {
StgWord32 bitmap = large_bitmap->bitmap[bmp];
StgWord bitmap = large_bitmap->bitmap[bmp];
for(; bitmap != 0; ++i, bitmap >>= 1 ) {
if ((bitmap & 1) == 0) {
checkClosure((StgClosure *)payload[i]);
......
/*
Time-stamp: <Wed Mar 21 2001 16:32:47 Stardate: [-30]6363.44 hwloidl>
$Id: Pack.c,v 1.7 2001/05/28 07:13:54 sof Exp $
$Id: Pack.c,v 1.8 2001/07/24 05:04:59 ken Exp $
Graph packing and unpacking code for sending it to another processor
and retrieving the original graph structure from the packet.
......@@ -1339,7 +1339,7 @@ PackPAP(StgPAP *pap) {
nat n, i, j, pack_start;
StgPtr p, q;
const StgInfoTable* info;
StgWord32 bitmap;
StgWord bitmap;
/* debugging only */
StgPtr end;
nat size, ptrs, nonptrs, vhs;
......@@ -1615,7 +1615,7 @@ PackPAP(StgPAP *pap) {
for (j=0; j<large_bitmap->size; j++) {
bitmap = large_bitmap->bitmap[j];
q = p + sizeof(W_) * 8;
q = p + BITS_IN(W_);
while (bitmap != 0) {
if ((bitmap & 1) == 0) {
Pack((StgWord)(ARGTAG_MAX+1));
......@@ -2873,7 +2873,7 @@ UnpackPAP(StgWord ***bufptrP, StgClosure *graph)
nat n, i, j, packed_size = 0;
StgPtr p, q, end, payload_start, p_FMs;
const StgInfoTable* info;
StgWord32 bitmap;
StgWord bitmap;
StgWord **bufptr = *bufptrP;
#if defined(DEBUG)
nat FMs_in_PAP=0;
......@@ -3092,7 +3092,7 @@ UnpackPAP(StgWord ***bufptrP, StgClosure *graph)
for (j=0; j<large_bitmap->size; j++) {
bitmap = large_bitmap->bitmap[j];
q = p + sizeof(W_) * 8;
q = p + BITS_IN(W_);
while (bitmap != 0) {
if ((bitmap & 1) == 0) {
*p++ = (StgWord)UnpackFetchMe(&bufptr, (StgClosure**)&p_FMs);
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment