From 45936dbd56b8bb846e14d8f38ef8153ec91a3457 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 11 Dec 2000 12:37:00 +0000 Subject: [PATCH] [project @ 2000-12-11 12:36:59 by simonmar] - update representation of BCOs - add setHeapSize for use from within GHC --- ghc/includes/ClosureMacros.h | 20 +----------------- ghc/includes/Closures.h | 10 ++++----- ghc/rts/GC.c | 48 ++++-------------------------------------- ghc/rts/ProfHeap.c | 6 ++---- ghc/rts/Sanity.c | 14 ++++-------- ghc/rts/Sanity.h | 3 ++- ghc/rts/StgMiscClosures.hc | 4 ++-- ghc/rts/Storage.c | 16 +++++++++++++- ghc/rts/Storage.h | 11 ++++++---- 9 files changed, 41 insertions(+), 91 deletions(-) diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h index 41d3fd8..0f276d5 100644 --- a/ghc/includes/ClosureMacros.h +++ b/ghc/includes/ClosureMacros.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: ClosureMacros.h,v 1.29 2000/12/04 12:31:20 simonmar Exp $ + * $Id: ClosureMacros.h,v 1.30 2000/12/11 12:36:59 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -192,22 +192,4 @@ static __inline__ StgFunPtr get_entry(const StgInfoTable *itbl) { /* constructors don't have SRTs */ #define GET_TAG(info) (INFO_PTR_TO_STRUCT(info)->srt_len) -/* ----------------------------------------------------------------------------- - BCOs. - -------------------------------------------------------------------------- */ - -#define bcoConstPtr( bco, i ) (*stgCast(StgPtr*, ((bco)->payload+(i)))) -#define bcoConstCPtr( bco, i ) (*stgCast(StgClosurePtr*,((bco)->payload+(i)))) -#define bcoConstInfoPtr( bco, i )(*stgCast(StgInfoTable**,((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstInt( bco, i ) (*stgCast(StgInt*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstInt64( bco, i ) (PK_Int64(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstWord( bco, i ) (*stgCast(StgWord*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstAddr( bco, i ) (*stgCast(StgAddr*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstChar( bco, i ) (*stgCast(StgChar*, ((bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstFloat( bco, i ) (PK_FLT(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i))) -#define bcoConstDouble( bco, i ) (PK_DBL(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i))) -#define bcoInstr( bco, i ) (stgCast(StgWord8*, ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[i]) -static __inline__ StgInt bcoInstr16 ( StgBCO* bco, unsigned int i ) -{ StgInt x = (bcoInstr(bco,i) << 8) + bcoInstr(bco,i+1); return x; } - #endif /* CLOSUREMACROS_H */ diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h index 77d0725..a94e23a 100644 --- a/ghc/includes/Closures.h +++ b/ghc/includes/Closures.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: Closures.h,v 1.19 2000/11/07 17:05:47 simonmar Exp $ + * $Id: Closures.h,v 1.20 2000/12/11 12:36:59 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -176,11 +176,9 @@ typedef struct { typedef struct { StgHeader header; - StgWord n_ptrs; - StgWord n_words; - StgWord n_instrs; - StgWord stgexpr; - StgClosure *payload[0]; + StgPtr literals; /* a pointer to an ArrWords */ + StgPtr instrs; /* a pointer to an ArrWords */ + StgPtr ptrs; /* a pointer to a MutArrPtrs */ } StgBCO; typedef struct { diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index a732d6d..72338c0 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.90 2000/12/04 12:31:20 simonmar Exp $ + * $Id: GC.c,v 1.91 2000/12/11 12:36:59 simonmar Exp $ * * (c) The GHC Team 1998-1999 * @@ -1015,10 +1015,6 @@ isAlive(StgClosure *p) /* alive! */ return ((StgEvacuated *)p)->evacuee; - case BCO: - size = bco_sizeW((StgBCO*)p); - goto large; - case ARR_WORDS: size = arr_words_sizeW((StgArrWords *)p); goto large; @@ -1342,20 +1338,6 @@ loop: switch (info -> type) { - case BCO: - { - nat size = bco_sizeW((StgBCO*)q); - - if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - evacuate_large((P_)q, rtsFalse); - to = q; - } else { - /* just copy the block */ - to = copy(q,size,step); - } - return to; - } - case MUT_VAR: ASSERT(q->header.info != &stg_MUT_CONS_info); case MVAR: @@ -1415,6 +1397,7 @@ loop: case WEAK: case FOREIGN: case STABLE_NAME: + case BCO: return copy(q,sizeW_fromITBL(info),step); case CAF_BLACKHOLE: @@ -1897,17 +1880,6 @@ scavenge(step *step) switch (info -> type) { - case BCO: - { - StgBCO* bco = (StgBCO *)p; - nat i; - for (i = 0; i < bco->n_ptrs; i++) { - bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i)); - } - p += bco_sizeW(bco); - break; - } - case MVAR: /* treat MVars specially, because we don't want to evacuate the * mut_link field in the middle of the closure. @@ -1980,6 +1952,7 @@ scavenge(step *step) case WEAK: case FOREIGN: case STABLE_NAME: + case BCO: { StgPtr end; @@ -3038,18 +3011,6 @@ scavenge_large(step *step) continue; } - case BCO: - { - StgBCO* bco = (StgBCO *)p; - nat i; - evac_gen = saved_evac_gen; - for (i = 0; i < bco->n_ptrs; i++) { - bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i)); - } - evac_gen = 0; - continue; - } - case TSO: scavengeTSO((StgTSO *)p); continue; @@ -3585,8 +3546,7 @@ maybeLarge(StgClosure *closure) return (info->type == MUT_ARR_PTRS || info->type == MUT_ARR_PTRS_FROZEN || info->type == TSO || - info->type == ARR_WORDS || - info->type == BCO); + info->type == ARR_WORDS); } diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c index 4deb31f..acd7778 100644 --- a/ghc/rts/ProfHeap.c +++ b/ghc/rts/ProfHeap.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: ProfHeap.c,v 1.19 2000/12/04 12:31:21 simonmar Exp $ + * $Id: ProfHeap.c,v 1.20 2000/12/11 12:36:59 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -491,9 +491,6 @@ heapCensus(void) info = get_itbl((StgClosure *)p); switch (info->type) { - case BCO: - size = bco_sizeW((StgBCO *)p); - break; case CONSTR: if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info @@ -503,6 +500,7 @@ heapCensus(void) } /* else, fall through... */ + case BCO: case FUN: case THUNK: case IND_PERM: diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 6cf9bc4..cf0a8fd 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Sanity.c,v 1.23 2000/12/04 12:31:21 simonmar Exp $ + * $Id: Sanity.c,v 1.24 2000/12/11 12:37:00 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -35,6 +35,8 @@ #include "RtsUtils.h" #include "BlockAlloc.h" #include "Sanity.h" +#include "MBlock.h" +#include "Storage.h" #include "Schedule.h" #include "StoragePriv.h" // for END_OF_STATIC_LIST @@ -231,15 +233,6 @@ checkClosure( StgClosure* p ) info = get_itbl(p); switch (info->type) { - case BCO: - { - StgBCO* bco = stgCast(StgBCO*,p); - nat i; - for(i=0; i < bco->n_ptrs; ++i) { - ASSERT(LOOKS_LIKE_PTR(bcoConstPtr(bco,i))); - } - return bco_sizeW(bco); - } case MVAR: { @@ -298,6 +291,7 @@ checkClosure( StgClosure* p ) #endif case BLACKHOLE: case FOREIGN: + case BCO: case STABLE_NAME: case MUT_VAR: case CONSTR_INTLIKE: diff --git a/ghc/rts/Sanity.h b/ghc/rts/Sanity.h index 461da8b..dbc3b53 100644 --- a/ghc/rts/Sanity.h +++ b/ghc/rts/Sanity.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Sanity.h,v 1.6 2000/03/31 03:09:36 hwloidl Exp $ + * $Id: Sanity.h,v 1.7 2000/12/11 12:37:00 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -10,6 +10,7 @@ #ifdef DEBUG /* debugging routines */ extern void checkHeap ( bdescr *bd, StgPtr start ); +extern void checkHeapChunk ( StgPtr start, StgPtr end ); extern void checkChain ( bdescr *bd ); extern void checkStack ( StgPtr sp, StgPtr stack_end, StgUpdateFrame* su ); extern void checkTSO ( StgTSO* tso ); diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 99111f1..c49536c 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgMiscClosures.hc,v 1.52 2000/12/04 12:31:21 simonmar Exp $ + * $Id: StgMiscClosures.hc,v 1.53 2000/12/11 12:37:00 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -658,7 +658,7 @@ STGFUN(stg_WHITEHOLE_entry) /* ----------------------------------------------------------------------------- The code for a BCO returns to the scheduler -------------------------------------------------------------------------- */ -INFO_TABLE(stg_BCO_info,stg_BCO_entry,0,0,BCO,,EF_,"BCO","BCO"); +INFO_TABLE(stg_BCO_info,stg_BCO_entry,3,0,BCO,,EF_,"BCO","BCO"); STGFUN(stg_BCO_entry) { FB_ Sp -= 1; diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index c126334..51e1fb0 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.29 2000/12/04 12:31:22 simonmar Exp $ + * $Id: Storage.c,v 1.30 2000/12/11 12:37:00 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -196,6 +196,20 @@ exitStorage (void) stat_exit(calcAllocated()); } +/* ----------------------------------------------------------------------------- + Setting the heap size. This function is callable from Haskell (GHC + uses it to implement the -H option). + -------------------------------------------------------------------------- */ + +void +setHeapSize( HsInt size ) +{ + RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE; + if (RtsFlags.GcFlags.heapSizeSuggestion > + RtsFlags.GcFlags.maxHeapSize) { + RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion; + } +} /* ----------------------------------------------------------------------------- CAF management. diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h index 5795c4f..1e5e3cf 100644 --- a/ghc/rts/Storage.h +++ b/ghc/rts/Storage.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.h,v 1.18 2000/12/04 12:31:22 simonmar Exp $ + * $Id: Storage.h,v 1.19 2000/12/11 12:37:00 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -22,6 +22,12 @@ extern void initStorage(void); extern void exitStorage(void); /* ----------------------------------------------------------------------------- + Setting the heap size. + ------------------------------------------------------------------------- */ + +extern void setHeapSize( HsInt size ); + +/* ----------------------------------------------------------------------------- Generic allocation StgPtr allocate(int n) Allocates a chunk of contiguous store @@ -391,9 +397,6 @@ static __inline__ StgOffset arr_words_sizeW( StgArrWords* x ) static __inline__ StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x ) { return sizeofW(StgMutArrPtrs) + x->ptrs; } -static __inline__ StgWord bco_sizeW( StgBCO* bco ) -{ return BCO_sizeW(bco->n_ptrs,bco->n_words,bco->n_instrs); } - static __inline__ StgWord tso_sizeW ( StgTSO *tso ) { return TSO_STRUCT_SIZEW + tso->stack_size; } -- 1.7.10.4