Commit b3f53081 authored by simonmar's avatar simonmar
Browse files

[project @ 2003-03-24 14:46:53 by simonmar]

Fix some bugs in compacting GC.

Bug 1: When threading the fields of an AP or PAP, we were grabbing the
info table of the function without unthreading it first.

Bug 2: eval_thunk_selector() might accidentally find itself in
to-space when going through indirections in a compacted generation.
We must check for this case and bale out if necessary.

Bug 3: This is somewhat more nasty.  When we have an AP or PAP that
points to a BCO, the layout info for the AP/PAP is in the BCO's
instruction array, which is two objects deep from the AP/PAP itself.
The trouble is, during compacting GC, we can only safely look one
object deep from the current object, because pointers from objects any
deeper might have been already updated to point to their final
destinations.

The solution is to put the arity and bitmap info for a BCO into the
BCO object itself.  This means BCOs become variable-length, which is a
slight annoyance, but it also means that looking up the arity/bitmap
is quicker.  There is a slight reduction in complexity in the byte
code generator due to not having to stuff the bitmap at the front of
the instruction stream.
parent 82387309
......@@ -37,6 +37,7 @@ import Control.Monad.ST ( ST, runST )
import GHC.Word ( Word(..) )
import Data.Array.MArray
import Data.Array.Unboxed ( listArray )
import Data.Array.Base ( STUArray, UArray(..), unsafeWrite )
import Data.Array.ST ( castSTUArray )
import Foreign ( Word16, free )
......@@ -65,6 +66,7 @@ data UnlinkedBCO
unlinkedBCOName :: Name,
unlinkedBCOArity :: Int,
unlinkedBCOInstrs :: ByteArray#, -- insns
unlinkedBCOBitmap :: ByteArray#, -- bitmap
unlinkedBCOLits :: (SizedSeq (Either Word FastString)), -- literals
-- Either literal words or a pointer to a asciiz
-- string, denoting a label whose *address* should
......@@ -84,7 +86,7 @@ bcoFreeNames :: UnlinkedBCO -> NameSet
bcoFreeNames bco
= bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco]
where
bco_refs (UnlinkedBCO _ _ _ _ ptrs itbls)
bco_refs (UnlinkedBCO _ _ _ _ _ ptrs itbls)
= unionManyNameSets (
mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] :
mkNameSet (ssElts itbls) :
......@@ -92,7 +94,7 @@ bcoFreeNames bco
)
instance Outputable UnlinkedBCO where
ppr (UnlinkedBCO nm arity insns lits ptrs itbls)
ppr (UnlinkedBCO nm arity insns bitmap lits ptrs itbls)
= sep [text "BCO", ppr nm, text "with",
int (sizeSS lits), text "lits",
int (sizeSS ptrs), text "ptrs",
......@@ -148,11 +150,13 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
insns_arr
| n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
| otherwise = runST (mkInstrArray arity bitmap
bsize n_insns asm_insns)
| otherwise = mkInstrArray n_insns asm_insns
insns_barr = case insns_arr of UArray _lo _hi barr -> barr
let ul_bco = UnlinkedBCO nm arity insns_barr final_lits
bitmap_arr = mkBitmapArray bsize bitmap
bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits
final_ptrs final_itbls
-- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
......@@ -165,25 +169,13 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
free ptr
mkBitmapArray :: Int -> [StgWord] -> UArray Int StgWord
mkBitmapArray bsize bitmap
= listArray (0, 1 + length bitmap) (fromIntegral bsize : bitmap)
mkInstrArray :: Int -> [StgWord] -> Int -> Int -> [Word16]
-> ST s (UArray Int Word16)
mkInstrArray arity bitmap bsize n_insns asm_insns = do
(arr :: STUArray s Int Word16) <- newArray_ (0, n_insns + bco_info_w16s)
zipWithM (unsafeWrite arr) [bco_info_w16s ..]
(fromIntegral n_insns : asm_insns)
(arr' :: STUArray s Int StgWord) <- castSTUArray arr
writeArray arr' 0 (fromIntegral arity)
writeArray arr' 1 (fromIntegral bsize)
zipWithM (writeArray arr') [2..] bitmap
arr <- castSTUArray arr'
unsafeFreeze arr
where
-- The BCO info (arity, bitmap) goes at the beginning of
-- the instruction stream. See Closures.h for details.
bco_info_w16s = (1 {- for the arity -} +
1 {- for the bitmap size -} +
length bitmap) * (wORD_SIZE `quot` 2)
mkInstrArray :: Int -> [Word16] -> UArray Int Word16
mkInstrArray n_insns asm_insns
= listArray (0, 1 + n_insns) (fromIntegral n_insns : asm_insns)
-- instrs nonptrs ptrs itbls
type AsmState = (SizedSeq Word16,
......
......@@ -39,7 +39,7 @@ import Control.Exception ( throwDyn )
import Control.Monad ( zipWithM )
import Control.Monad.ST ( stToIO )
import GHC.Exts ( BCO#, newBCO#, unsafeCoerce#,
import GHC.Exts ( BCO#, newBCO#, unsafeCoerce#, Int#,
ByteArray#, Array#, addrToHValue#, mkApUpd0# )
import GHC.Arr ( Array(..) )
......@@ -103,7 +103,7 @@ linkBCO ie ce ul_bco
linkBCO' :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO BCO
linkBCO' ie ce (UnlinkedBCO nm arity insns_barr literalsSS ptrsSS itblsSS)
linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS itblsSS)
-- Raises an IO exception on failure
= do let literals = ssElts literalsSS
ptrs = ssElts ptrsSS
......@@ -129,7 +129,9 @@ linkBCO' ie ce (UnlinkedBCO nm arity insns_barr literalsSS ptrsSS itblsSS)
:: UArray Int Word
literals_barr = case literals_arr of UArray lo hi barr -> barr
newBCO insns_barr literals_barr ptrs_parr itbls_barr
(I# arity#) = arity
newBCO insns_barr literals_barr ptrs_parr itbls_barr arity# bitmap
-- we recursively link any sub-BCOs while making the ptrs array
......@@ -170,9 +172,11 @@ writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
data BCO = BCO BCO#
newBCO :: ByteArray# -> ByteArray# -> Array# a -> ByteArray# -> IO BCO
newBCO a b c d
= IO (\s -> case newBCO# a b c d s of (# s1, bco #) -> (# s1, BCO bco #))
newBCO :: ByteArray# -> ByteArray# -> Array# a
-> ByteArray# -> Int# -> ByteArray# -> IO BCO
newBCO instrs lits ptrs itbls arity bitmap
= IO $ \s -> case newBCO# instrs lits ptrs itbls arity bitmap s of
(# s1, bco #) -> (# s1, BCO bco #)
lookupLiteral :: Either Word FastString -> IO Word
......
-----------------------------------------------------------------------
-- $Id: primops.txt.pp,v 1.25 2003/02/21 05:34:14 sof Exp $
-- $Id: primops.txt.pp,v 1.26 2003/03/24 14:46:53 simonmar Exp $
--
-- Primitive Operations
--
......@@ -1657,7 +1657,7 @@ primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
out_of_line = True
primop NewBCOOp "newBCO#" GenPrimOp
ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> State# s -> (# State# s, BCO# #)
ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> Int# -> ByteArr# -> State# s -> (# State# s, BCO# #)
with
has_side_effects = True
out_of_line = True
......
/* ----------------------------------------------------------------------------
* $Id: Closures.h,v 1.32 2002/12/11 15:36:37 simonmar Exp $
* $Id: Closures.h,v 1.33 2003/03/24 14:46:53 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -204,32 +204,34 @@ typedef struct _StgDeadWeak { /* Weak v */
* A BCO represents either a function or a stack frame. In each case,
* it needs a bitmap to describe to the garbage collector the
* pointerhood of its arguments/free variables respectively, and in
* the case of a function it also needs an arity. These pieces of
* information are stored at the beginning of the instruction array.
* the case of a function it also needs an arity. These are stored
* directly in the BCO, rather than in the instrs array, for two
* reasons:
* (a) speed: we need to get at the bitmap info quickly when
* the GC is examining APs and PAPs that point to this BCO
* (b) a subtle interaction with the compacting GC. In compacting
* GC, the info that describes the size/layout of a closure
* cannot be in an object more than one level of indirection
* away from the current object, because of the order in
* which pointers are updated to point to their new locations.
*/
typedef struct {
StgHeader header;
StgArrWords *instrs; /* a pointer to an ArrWords */
StgArrWords *literals; /* a pointer to an ArrWords */
StgMutArrPtrs *ptrs; /* a pointer to a MutArrPtrs */
StgArrWords *itbls; /* a pointer to an ArrWords */
StgArrWords *instrs; // a pointer to an ArrWords
StgArrWords *literals; // a pointer to an ArrWords
StgMutArrPtrs *ptrs; // a pointer to a MutArrPtrs
StgArrWords *itbls; // a pointer to an ArrWords
StgHalfWord arity; // arity of this BCO
StgHalfWord size; // size of this BCO (in words)
StgWord bitmap[FLEXIBLE_ARRAY]; // an StgLargeBitmap
} StgBCO;
typedef struct {
StgWord arity;
StgWord bitmap[FLEXIBLE_ARRAY]; // really an StgLargeBitmap
} StgBCOInfo;
#define BCO_INFO(bco) ((StgBCOInfo *)(((StgBCO *)(bco))->instrs->payload))
#define BCO_ARITY(bco) (BCO_INFO(bco)->arity)
#define BCO_BITMAP(bco) ((StgLargeBitmap *)BCO_INFO(bco)->bitmap)
#define BCO_BITMAP(bco) ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap)
#define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size)
#define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap)
#define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \
/ BITS_IN(StgWord))
#define BCO_INSTRS(bco) ((StgWord16 *)(BCO_BITMAP_BITS(bco) + \
BCO_BITMAP_SIZEW(bco)))
/* Dynamic stack frames - these have a liveness mask in the object
* itself, rather than in the info table. Useful for generic heap
......
......@@ -36,7 +36,7 @@
ProjectName = The Glorious Glasgow Haskell Compilation System
ProjectNameShort = ghc
ProjectVersion = 5.05
ProjectVersion = 5.05.20030323
ProjectVersionInt = 505
ProjectPatchLevel = 0
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.148 2003/03/19 18:41:18 sof Exp $
* $Id: GC.c,v 1.149 2003/03/24 14:46:53 simonmar Exp $
*
* (c) The GHC Team 1998-2003
*
......@@ -1752,9 +1752,11 @@ loop:
case WEAK:
case FOREIGN:
case STABLE_NAME:
case BCO:
return copy(q,sizeW_fromITBL(info),stp);
case BCO:
return copy(q,bco_sizeW((StgBCO *)q),stp);
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
case SE_BLACKHOLE:
......@@ -2000,6 +2002,11 @@ eval_thunk_selector( nat field, StgSelector * p )
selector_loop:
if (Bdescr((StgPtr)selectee)->flags & BF_EVACUATED) {
SET_INFO(p, info_ptr);
return NULL;
}
info = get_itbl(selectee);
switch (info->type) {
case CONSTR:
......@@ -2438,7 +2445,6 @@ scavenge(step *stp)
case WEAK:
case FOREIGN:
case STABLE_NAME:
case BCO:
{
StgPtr end;
......@@ -2450,6 +2456,16 @@ scavenge(step *stp)
break;
}
case BCO: {
StgBCO *bco = (StgBCO *)p;
(StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs);
(StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals);
(StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs);
(StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls);
p += bco_sizeW(bco);
break;
}
case IND_PERM:
if (stp->gen->no != 0) {
#ifdef PROFILING
......@@ -2767,7 +2783,6 @@ linear_scan:
case WEAK:
case FOREIGN:
case STABLE_NAME:
case BCO:
{
StgPtr end;
......@@ -2778,6 +2793,15 @@ linear_scan:
break;
}
case BCO: {
StgBCO *bco = (StgBCO *)p;
(StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs);
(StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals);
(StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs);
(StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls);
break;
}
case IND_PERM:
// don't need to do anything here: the only possible case
// is that we're in a 1-space compacting collector, with
......
/* -----------------------------------------------------------------------------
* $Id: GCCompact.c,v 1.13 2002/12/11 15:36:42 simonmar Exp $
* $Id: GCCompact.c,v 1.14 2003/03/24 14:46:54 simonmar Exp $
*
* (c) The GHC Team 2001
*
......@@ -19,6 +19,13 @@
#include "StablePriv.h"
#include "Apply.h"
// Turn off inlining when debugging - it obfuscates things
#ifdef DEBUG
#define INLINE
#else
#define INLINE inline
#endif
/* -----------------------------------------------------------------------------
Threading / unthreading pointers.
......@@ -41,7 +48,7 @@
except for the info pointer.
-------------------------------------------------------------------------- */
static inline void
static INLINE void
thread( StgPtr p )
{
StgPtr q = (StgPtr)*p;
......@@ -64,7 +71,7 @@ thread( StgPtr p )
}
}
static inline void
static INLINE void
unthread( StgPtr p, StgPtr free )
{
StgPtr q = (StgPtr)*p, r;
......@@ -78,7 +85,7 @@ unthread( StgPtr p, StgPtr free )
*p = (StgWord)q;
}
static inline StgInfoTable *
static INLINE StgInfoTable *
get_threaded_info( StgPtr p )
{
StgPtr q = (P_)GET_INFO((StgClosure *)p);
......@@ -93,7 +100,7 @@ get_threaded_info( StgPtr p )
// A word-aligned memmove will be faster for small objects than libc's or gcc's.
// Remember, the two regions *might* overlap, but: to <= from.
static inline void
static INLINE void
move(StgPtr to, StgPtr from, nat size)
{
for(; size > 0; --size) {
......@@ -101,7 +108,7 @@ move(StgPtr to, StgPtr from, nat size)
}
}
static inline nat
static INLINE nat
obj_sizeW( StgClosure *p, StgInfoTable *info )
{
switch (info->type) {
......@@ -136,6 +143,8 @@ obj_sizeW( StgClosure *p, StgInfoTable *info )
return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
case TSO:
return tso_sizeW((StgTSO *)p);
case BCO:
return bco_sizeW((StgBCO *)p);
default:
return sizeW_fromITBL(info);
}
......@@ -175,7 +184,7 @@ thread_static( StgClosure* p )
}
}
static inline void
static INLINE void
thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
{
nat i, b;
......@@ -198,7 +207,7 @@ thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
}
}
static inline StgPtr
static INLINE StgPtr
thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
{
StgPtr p;
......@@ -331,7 +340,8 @@ thread_stack(StgPtr p, StgPtr stack_end)
StgRetFun *ret_fun = (StgRetFun *)p;
StgFunInfoTable *fun_info;
fun_info = get_fun_itbl(ret_fun->fun); // *before* threading it!
fun_info = itbl_to_fun_itbl(get_threaded_info(ret_fun->fun));
// *before* threading it!
thread((StgPtr)&ret_fun->fun);
p = thread_arg_block(fun_info, ret_fun->payload);
continue;
......@@ -344,15 +354,14 @@ thread_stack(StgPtr p, StgPtr stack_end)
}
}
static inline StgPtr
static INLINE StgPtr
thread_PAP (StgPAP *pap)
{
StgPtr p;
StgWord bitmap, size;
StgFunInfoTable *fun_info;
thread((StgPtr)&pap->fun);
fun_info = get_fun_itbl(pap->fun);
fun_info = itbl_to_fun_itbl(get_threaded_info(pap->fun));
ASSERT(fun_info->i.type != PAP);
p = (StgPtr)pap->payload;
......@@ -384,10 +393,12 @@ thread_PAP (StgPAP *pap)
}
break;
}
thread((StgPtr)&pap->fun);
return p;
}
static inline StgPtr
static INLINE StgPtr
thread_AP_STACK (StgAP_STACK *ap)
{
thread((StgPtr)&ap->fun);
......@@ -468,7 +479,7 @@ update_fwd_large( bdescr *bd )
}
}
static inline StgPtr
static INLINE StgPtr
thread_obj (StgInfoTable *info, StgPtr p)
{
switch (info->type) {
......@@ -504,12 +515,20 @@ thread_obj (StgInfoTable *info, StgPtr p)
thread((StgPtr)&((StgClosure *)p)->payload[1]);
return p + sizeofW(StgHeader) + 2;
case BCO: {
StgBCO *bco = (StgBCO *)p;
thread((StgPtr)&bco->instrs);
thread((StgPtr)&bco->literals);
thread((StgPtr)&bco->ptrs);
thread((StgPtr)&bco->itbls);
return p + bco_sizeW(bco);
}
case FUN:
case THUNK:
case CONSTR:
case FOREIGN:
case STABLE_NAME:
case BCO:
case IND_PERM:
case MUT_VAR:
case MUT_CONS:
......
......@@ -274,7 +274,7 @@ eval_obj:
break;
case BCO:
ASSERT(BCO_ARITY(obj) > 0);
ASSERT(((StgBCO *)obj)->arity > 0);
break;
case AP: /* Copied from stg_AP_entry. */
......@@ -576,7 +576,7 @@ do_apply:
nat arity, i;
Sp++;
arity = BCO_ARITY(obj);
arity = ((StgBCO *)obj)->arity;
ASSERT(arity > 0);
if (arity < n) {
// n must be greater than 1, and the only kinds of
......@@ -718,7 +718,7 @@ run_BCO:
{
register int bciPtr = 1; /* instruction pointer */
register StgBCO* bco = (StgBCO*)obj;
register StgWord16* instrs = (StgWord16*)(BCO_INSTRS(bco));
register StgWord16* instrs = (StgWord16*)(bco->instrs->payload);
register StgWord* literals = (StgWord*)(&bco->literals->payload[0]);
register StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
register StgInfoTable** itbls = (StgInfoTable**)
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.hc,v 1.105 2003/02/22 04:51:51 sof Exp $
* $Id: PrimOps.hc,v 1.106 2003/03/24 14:46:54 simonmar Exp $
*
* (c) The GHC Team, 1998-2002
*
......@@ -1525,20 +1525,36 @@ FN_(newBCOzh_fast)
R2.p = literals
R3.p = ptrs
R4.p = itbls
R5.i = arity
R6.p = bitmap array
*/
StgBCO *bco;
nat size;
StgArrWords *bitmap_arr;
FB_
HP_CHK_GEN_TICKY(sizeofW(StgBCO),R1_PTR|R2_PTR|R3_PTR|R4_PTR, newBCOzh_fast);
TICK_ALLOC_PRIM(sizeofW(StgHeader), sizeofW(StgBCO)-sizeofW(StgHeader), 0);
CCS_ALLOC(CCCS,sizeofW(StgBCO)); /* ccs prof */
bco = (StgBCO *) (Hp + 1 - sizeofW(StgBCO));
bitmap_arr = (StgArrWords *)R6.cl;
size = sizeofW(StgBCO) + bitmap_arr->words;
HP_CHK_GEN_TICKY(size,R1_PTR|R2_PTR|R3_PTR|R4_PTR|R6_PTR, newBCOzh_fast);
TICK_ALLOC_PRIM(size, size-sizeofW(StgHeader), 0);
CCS_ALLOC(CCCS,size); /* ccs prof */
bco = (StgBCO *) (Hp + 1 - size);
SET_HDR(bco, (const StgInfoTable *)&stg_BCO_info, CCCS);
bco->instrs = (StgArrWords*)R1.cl;
bco->literals = (StgArrWords*)R2.cl;
bco->ptrs = (StgMutArrPtrs*)R3.cl;
bco->itbls = (StgArrWords*)R4.cl;
bco->arity = R5.w;
bco->size = size;
// Copy the arity/bitmap info into the BCO
{
int i;
for (i = 0; i < bitmap_arr->words; i++) {
bco->bitmap[i] = bitmap_arr->payload[i];
}
}
TICK_RET_UNBOXED_TUP(1);
RET_P(bco);
......@@ -1555,7 +1571,7 @@ FN_(mkApUpd0zh_fast)
// This function is *only* used to wrap zero-arity BCOs in an
// updatable wrapper (see ByteCodeLink.lhs). An AP thunk is always
// saturated and always points directly to a FUN or BCO.
ASSERT(get_itbl(R1.cl)->type == BCO && BCO_ARITY(R1.p) == 0);
ASSERT(get_itbl(R1.cl)->type == BCO && ((StgBCO *)R1.p)->arity == 0);
HP_CHK_GEN_TICKY(PAP_sizeW(0), R1_PTR, mkApUpd0zh_fast);
TICK_ALLOC_PRIM(sizeofW(StgHeader), PAP_sizeW(0)-sizeofW(StgHeader), 0);
......
/* -----------------------------------------------------------------------------
* $Id: ProfHeap.c,v 1.44 2003/03/18 14:36:56 simonmar Exp $
* $Id: ProfHeap.c,v 1.45 2003/03/24 14:46:55 simonmar Exp $
*
* (c) The GHC Team, 1998-2003
*
......@@ -861,6 +861,10 @@ heapCensusChain( Census *census, bdescr *bd )
break;
case BCO:
prim = rtsTrue;
size = bco_sizeW((StgBCO *)p);
break;
case MVAR:
case WEAK:
case FOREIGN:
......
/* -----------------------------------------------------------------------------
* $Id: Sanity.c,v 1.31 2002/12/11 15:36:48 simonmar Exp $
* $Id: Sanity.c,v 1.32 2003/03/24 14:46:56 simonmar Exp $
*
* (c) The GHC Team, 1998-2001
*
......@@ -272,7 +272,6 @@ checkClosure( StgClosure* p )
case BLACKHOLE:
case CAF_BLACKHOLE:
case FOREIGN:
case BCO:
case STABLE_NAME:
case MUT_VAR:
case MUT_CONS:
......@@ -290,6 +289,15 @@ checkClosure( StgClosure* p )
return sizeW_fromITBL(info);
}
case BCO: {
StgBCO *bco = (StgBCO *)p;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->instrs));
ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->literals));
ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->ptrs));
ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->itbls));
return bco_sizeW(bco);
}
case IND_STATIC: /* (1, 0) closure */
ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgIndStatic*)p)->indirectee));
return sizeW_fromITBL(info);
......
/* -----------------------------------------------------------------------------
* $Id: Storage.h,v 1.48 2003/03/21 16:18:39 sof Exp $
* $Id: Storage.h,v 1.49 2003/03/24 14:46:57 simonmar Exp $
*
* (c) The GHC Team, 1998-2002
*
......@@ -398,6 +398,9 @@ static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
static __inline__ StgWord tso_sizeW ( StgTSO *tso )
{ return TSO_STRUCT_SIZEW + tso->stack_size; }
static __inline__ StgWord bco_sizeW ( StgBCO *bco )
{ return bco->size; }
/* -----------------------------------------------------------------------------
Sizes of stack frames
-------------------------------------------------------------------------- */
......
......@@ -310,7 +310,7 @@ genApply args =
-- else:
text "case BCO:",
nest 4 (vcat [
text "arity = BCO_ARITY((StgBCO *)R1.p);",
text "arity = ((StgBCO *)R1.p)->arity;",
text "ASSERT(arity > 0);",
genMkPAP "BUILD_PAP" "stg_BCO_entry"
True{-stack apply-} False{-not a PAP-}
......
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