[project @ 2000-12-11 12:36:59 by simonmar]

- update representation of BCOs
- add setHeapSize for use from within GHC

diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index 41d3fd8..0f276d5 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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<size> 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 (file)
--- 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; }