From 030787e51b95d3320d2b9032c119c32f7549a31a Mon Sep 17 00:00:00 2001 From: ken Date: Tue, 24 Jul 2001 05:04:59 +0000 Subject: [PATCH] [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! --- ghc/compiler/absCSyn/AbsCSyn.lhs | 16 +++++-- ghc/compiler/absCSyn/PprAbsC.lhs | 77 ++++++++++++++++++++------------ ghc/compiler/codeGen/CgBindery.lhs | 10 ++--- ghc/compiler/nativeGen/AbsCStixGen.lhs | 24 +++++----- ghc/compiler/nativeGen/StixInfo.lhs | 42 +++++++++++++++-- ghc/includes/InfoMacros.h | 17 +++++-- ghc/rts/GC.c | 8 ++-- ghc/rts/Sanity.c | 10 ++--- ghc/rts/parallel/Pack.c | 10 ++--- 9 files changed, 140 insertions(+), 74 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 8d0a0ff..6863c3d 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (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} %************************************************************************ diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 82922d4..6f3282a 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -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} %************************************************************************ diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs index 7727c99..2773bf1 100644 --- a/ghc/compiler/codeGen/CgBindery.lhs +++ b/ghc/compiler/codeGen/CgBindery.lhs @@ -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} diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs index dcaba25..f62c174 100644 --- a/ghc/compiler/nativeGen/AbsCStixGen.lhs +++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs @@ -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} diff --git a/ghc/compiler/nativeGen/StixInfo.lhs b/ghc/compiler/nativeGen/StixInfo.lhs index bb26435..fa1c07d 100644 --- a/ghc/compiler/nativeGen/StixInfo.lhs +++ b/ghc/compiler/nativeGen/StixInfo.lhs @@ -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} diff --git a/ghc/includes/InfoMacros.h b/ghc/includes/InfoMacros.h index 6ae87f1..7773763 100644 --- a/ghc/includes/InfoMacros.h +++ b/ghc/includes/InfoMacros.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 79c8ef5..6cf7e2a 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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; isize; 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); diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index af0a38d..4150916 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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; bmpsize; 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]); diff --git a/ghc/rts/parallel/Pack.c b/ghc/rts/parallel/Pack.c index 80a2fae..75e12e0 100644 --- a/ghc/rts/parallel/Pack.c +++ b/ghc/rts/parallel/Pack.c @@ -1,6 +1,6 @@ /* Time-stamp: - $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; jsize; 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; jsize; 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); -- 1.7.10.4