[project @ 2000-04-05 16:57:18 by sewardj]

Clean up the storage manager a little, and reinstate the compile time
garbage collector.  Then pray.

diff --git a/ghc/includes/options.h b/ghc/includes/options.h
index ff63fd4..aca0b1e 100644 (file)
--- a/ghc/includes/options.h
+++ b/ghc/includes/options.h
@@ -7,8 +7,8 @@
  * Hugs version 1.4, December 1997
  *
  * $RCSfile: options.h,v $
- * $Revision: 1.24 $
- * $Date: 2000/03/22 18:17:12 $
+ * $Revision: 1.25 $
+ * $Date: 2000/04/05 16:57:18 $
  * ------------------------------------------------------------------------*/
 
 
@@ -95,13 +95,14 @@
 
 #define MINIMUMHEAP        19000
 #define MAXIMUMHEAP        0
-#define DEFAULTHEAP        1000000 /*350000*/
+#define DEFAULTHEAP        320000
 
 #define TEXT_SIZE          100000
 #define NUM_TEXTH          10
 #define NUM_TYVARS         4000
 #define NUM_STACK          16000
 #define NUM_DTUPLES        5
+#define NUM_MSTACK         2000
 
 #define MAXPOSINT          0x7fffffff
 #define MINNEGINT          (-MAXPOSINT-1)

diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c
index b772f0b..461b253 100644 (file)
--- a/ghc/interpreter/hugs.c
+++ b/ghc/interpreter/hugs.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: hugs.c,v $
- * $Revision: 1.59 $
- * $Date: 2000/04/05 14:13:58 $
+ * $Revision: 1.60 $
+ * $Date: 2000/04/05 16:57:18 $
  * ------------------------------------------------------------------------*/
 
 #include <setjmp.h>
@@ -244,12 +244,17 @@ String argv[]; {
 #  endif
 
    /* Find out early on if we're in combined mode or not.
-      everybody(PREPREL) needs to know this.
+      everybody(PREPREL) needs to know this.  Also, establish the
+      heap size;
    */ 
    for (i=1; i < argc; ++i) {
       if (strcmp(argv[i], "--")==0) break;
       if (strcmp(argv[i], "-c")==0) combined = FALSE;
       if (strcmp(argv[i], "+c")==0) combined = TRUE;
+
+      if (strncmp(argv[i],"+h",2)==0 ||
+          strncmp(argv[i],"-h",2)==0)
+         setHeapSize(&(argv[i][2]));
    }
 
    everybody(PREPREL);
@@ -497,7 +502,8 @@ String s; {                             /* return FALSE if none found.     */
                        return TRUE;
 #endif
 
-            case 'h' : setHeapSize(s+1);
+            case 'h' : /* don't do anything, since pre-scan of args
+                       will have got it already */
                        return TRUE;
 
             case 'c' :  /* don't do anything, since pre-scan of args
@@ -1220,8 +1226,12 @@ static void tryLoadGroup ( Cell grp )
          assert(nonNull(m));
          if (module(m).mode == FM_SOURCE) {
             processModule ( m );
+            module(m).tree = NIL;
          } else {
             processInterfaces ( singleton(snd(grp)) );
+            m = findModule(textOf(snd(grp)));
+            assert(nonNull(m));
+            module(m).tree = NIL;
          }
          break;
       case GRP_REC:
@@ -1235,6 +1245,11 @@ static void tryLoadGroup ( Cell grp )
             }
         }
          processInterfaces ( snd(grp) );
+        for (t = snd(grp); nonNull(t); t=tl(t)) {
+            m = findModule(textOf(hd(t)));
+            assert(nonNull(m));
+            module(m).tree = NIL;
+         }
          break;
       default:
          internal("tryLoadGroup");

diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c
index 2e5f161..5884cb1 100644 (file)
--- a/ghc/interpreter/machdep.c
+++ b/ghc/interpreter/machdep.c
@@ -13,8 +13,8 @@
  * included in the distribution.
  *
  * $RCSfile: machdep.c,v $
- * $Revision: 1.26 $
- * $Date: 2000/04/04 15:41:56 $
+ * $Revision: 1.27 $
+ * $Date: 2000/04/05 16:57:18 $
  * ------------------------------------------------------------------------*/
 
 #ifdef HAVE_SIGNAL_H
@@ -936,7 +936,7 @@ Void gcCStack() {                       /* Garbage collect elements off    */
         fatal("gcCStack");
 #endif
 
-#define Blargh markWithoutMove(*ptr);
+#define Blargh mark(*ptr);
 #if 0
                markWithoutMove((*ptr)/sizeof(Cell)); \
                markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell));  \

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 2c1caa8..cdb519b 100644 (file)
--- a/ghc/interpreter/storage.c
+++ b/ghc/interpreter/storage.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.c,v $
- * $Revision: 1.62 $
- * $Date: 2000/04/05 10:25:08 $
+ * $Revision: 1.63 $
+ * $Date: 2000/04/05 16:57:18 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -469,6 +469,13 @@ Text t; {
  * tycon, class, instance and module tables.  Also, potentially, TREX Exts.
  * ------------------------------------------------------------------------*/
 
+#ifdef DEBUG_STORAGE_EXTRA
+static Bool debugStorageExtra = TRUE;
+#else
+static Bool debugStorageExtra = FALSE;
+#endif
+
+
 #define EXPANDABLE_SYMBOL_TABLE(type_name,struct_name,                  \
                                 proc_name,free_proc_name,               \
                                 free_list,tab_name,tab_size,err_msg,    \
@@ -484,9 +491,11 @@ Text t; {
          assert(TAB_BASE_ADDR <= n);                                    \
          assert(n < TAB_BASE_ADDR+tab_size);                            \
          assert(tab_name[n-TAB_BASE_ADDR].inUse);                       \
-         tab_name[n-TAB_BASE_ADDR].inUse = FALSE;                      \
-         /*tab_name[n-TAB_BASE_ADDR].nextFree = free_list; */               \
-         /*free_list = n;*/                                                 \
+         tab_name[n-TAB_BASE_ADDR].inUse = FALSE;                       \
+         if (!debugStorageExtra) {                                      \
+            tab_name[n-TAB_BASE_ADDR].nextFree = free_list;             \
+            free_list = n;                                              \
+         }                                                              \
       }                                                                 \
                                                                         \
       type_name proc_name ( void )                                      \
@@ -514,8 +523,9 @@ Text t; {
             newTab[i].inUse = FALSE;                                    \
             newTab[i].nextFree = i-1+TAB_BASE_ADDR;                     \
          }                                                              \
-         /* fprintf(stderr, "Expanding " #type_name                     \
-           "table to size %d\n", newSz );*/                    \
+         if (debugStorageExtra)                                         \
+            fprintf(stderr, "Expanding " #type_name                     \
+                            "table to size %d\n", newSz );              \
          newTab[tab_size].nextFree = TAB_BASE_ADDR-1;                   \
          free_list = newSz-1+TAB_BASE_ADDR;                             \
          tab_size = newSz;                                              \
@@ -613,7 +623,8 @@ struct strModule* generate_module_ref ( Cell mo )
  * ------------------------------------------------------------------------*/
 
 #define TYCONHSZ 256                            /* Size of Tycon hash table*/
-     //#define tHash(x) (((x)-TEXT_BASE_ADDR)%TYCONHSZ)/* Tycon hash function     */
+static  Tycon    tyconHash[TYCONHSZ];           /* Hash table storage      */
+
 static int tHash(Text x)
 {
    int r;
@@ -625,12 +636,13 @@ static int tHash(Text x)
    assert(r<TYCONHSZ);
    return r;
 }
-static  Tycon    tyconHash[TYCONHSZ];           /* Hash table storage      */
-int RC_T ( int x ) 
+
+static int RC_T ( int x ) 
 {
    assert (x >= 0 && x < TYCONHSZ);
    return x;
 }
+
 Tycon newTycon ( Text t )               /* add new tycon to tycon table    */
 {
     Int   h                      = tHash(t);
@@ -656,7 +668,7 @@ Tycon newTycon ( Text t )               /* add new tycon to tycon table    */
 Tycon findTycon(t)                      /* locate Tycon in tycon table     */
 Text t; {
     Tycon tc = tyconHash[RC_T(tHash(t))];
-assert(isTycon(tc) || isTuple(tc) || isNull(tc));
+    assert(isTycon(tc) || isTuple(tc) || isNull(tc));
     while (nonNull(tc) && tycon(tc).text!=t)
        tc = tycon(tc).nextTyconHash;
     return tc;
@@ -814,7 +826,8 @@ Tycon mkTuple ( Int n )
  * ------------------------------------------------------------------------*/
 
 #define NAMEHSZ  256                            /* Size of Name hash table */
-//#define nHash(x) (((x)-TEXT_BASE_ADDR)%NAMEHSZ) /* hash fn :: Text->Int    */
+static  Name     nameHash[NAMEHSZ];             /* Hash table storage      */
+
 static int nHash(Text x)
 {
    assert(isText(x) || inventedText(x));
@@ -822,12 +835,13 @@ static int nHash(Text x)
    if (x < 0) x = -x;
    return x%NAMEHSZ;
 }
-static  Name     nameHash[NAMEHSZ];             /* Hash table storage      */
+
 int RC_N ( int x ) 
 {
    assert (x >= 0 && x < NAMEHSZ);
    return x;
 }
+
 void hashSanity ( void )
 {
    Int i, j;
@@ -875,8 +889,8 @@ Name newName ( Text t, Cell parent )    /* Add new name to name table      */
 Name findName(t)                        /* Locate name in name table       */
 Text t; {
     Name n = nameHash[RC_N(nHash(t))];
-assert(isText(t));
-assert(isName(n) || isNull(n));
+    assert(isText(t) || isInventedVar(t) || isInventedDictVar(t));
+    assert(isName(n) || isNull(n));
     while (nonNull(n) && name(n).text!=t)
        n = name(n).nextNameHash;
     return n;
@@ -1844,12 +1858,8 @@ OSectionKind lookupSection ( void* ad )
 Int     heapSize = DEFAULTHEAP;         /* number of cells in heap         */
 Heap    heapFst;                        /* array of fst component of pairs */
 Heap    heapSnd;                        /* array of snd component of pairs */
-#ifndef GLOBALfst
 Heap    heapTopFst;
-#endif
-#ifndef GLOBALsnd
 Heap    heapTopSnd;
-#endif
 Bool    consGC = TRUE;                  /* Set to FALSE to turn off gc from*/
                                         /* C stack; use with extreme care! */
 Long    numCells;
@@ -1902,7 +1912,6 @@ static Int markCount, stackRoots;
 Cell pair(l,r)                          /* Allocate pair (l, r) from       */
 Cell l, r; {                            /* heap, garbage collecting first  */
     Cell c = freeList;                  /* if necessary ...                */
-
     if (isNull(c)) {
         lsave = l;
         rsave = r;
@@ -1923,77 +1932,40 @@ Cell l, r; {                            /* heap, garbage collecting first  */
 static Int *marks;
 static Int marksSize;
 
-Cell markExpr(c)                        /* External interface to markCell  */
-Cell c; {
-    return isGenPair(c) ? markCell(c) : c;
-}
-
-static Cell local markCell(c)           /* Traverse part of graph marking  */
-Cell c; {                               /* cells reachable from given root */
-                                        /* markCell(c) is only called if c */
-                                        /* is a pair                       */
-    {   register int place = placeInSet(c);
-        register int mask  = maskInSet(c);
-        if (marks[place]&mask)
-            return c;
-        else {
-            marks[place] |= mask;
-            recordMark();
-        }
-    }
-
-    /* STACK_CHECK: Avoid stack overflows during recursive marking. */
-    if (isGenPair(fst(c))) {
-       STACK_CHECK
-        fst(c) = markCell(fst(c));
-        markSnd(c);
-    }
-    else if (isNull(fst(c)) || isTagPtr(fst(c))) {
-       STACK_CHECK
-        markSnd(c);
-    }
-
-    return c;
-}
-
-static Void local markSnd(c)            /* Variant of markCell used to     */
-Cell c; {                               /* update snd component of cell    */
-    Cell t;                             /* using tail recursion            */
+void mark ( Cell root )
+{
+   Cell c;
+   Cell mstack[NUM_MSTACK];
+   Int  msp     = -1;
+   Int  msp_max = -1;
 
-ma: t = c;                              /* Keep pointer to original pair   */
-    c = snd(c);
-    if (!isPair(c))
-        return;
+   mstack[++msp] = root;
 
-    {   register int place = placeInSet(c);
-        register int mask  = maskInSet(c);
-        if (marks[place]&mask)
-            return;
-        else {
+   while (msp >= 0) {
+      if (msp > msp_max) msp_max = msp;
+      c = mstack[msp--];
+      if (!isGenPair(c)) continue;
+      if (fst(c)==FREECELL) continue;
+      {
+         register int place = placeInSet(c);
+         register int mask  = maskInSet(c);
+         if (!(marks[place]&mask)) {
             marks[place] |= mask;
-            recordMark();
-        }
-    }
-
-    if (isGenPair(fst(c))) {
-        fst(c) = markCell(fst(c));
-        goto ma;
-    }
-    else if (isNull(fst(c)) || isTagPtr(fst(c)))
-        goto ma;
-    return;
-}
-
-Void markWithoutMove(n)                 /* Garbage collect cell at n, as if*/
-Cell n; {                               /* it was a cell ref, but don't    */
-                                        /* move cell so we don't have      */
-                                        /* to modify the stored value of n */
-    if (isGenPair(n)) {
-        recordStackRoot();
-        markCell(n); 
-    }
+            if (msp >= NUM_MSTACK-5) {
+               fprintf ( stderr, 
+                         "hugs: fatal stack overflow during GC.  "
+                         "Increase NUM_MSTACK.\n" );
+               exit(9);
+            }
+            mstack[++msp] = fst(c);
+            mstack[++msp] = snd(c);
+         }
+      }
+   }
+   //   fprintf(stderr, "%d ",msp_max);
 }
 
+
 Void garbageCollect()     {             /* Run garbage collector ...       */
                                         /* disable break checking          */
     Int i,j;
@@ -2003,11 +1975,11 @@ Void garbageCollect()     {             /* Run garbage collector ...       */
     jmp_buf  regs;                      /* save registers on stack         */
     HugsBreakAction oldBrk
        = setBreakAction ( HugsIgnoreBreak );
-fprintf ( stderr, "wa-hey!  garbage collection!  too difficult!  bye!\n" );
-exit(0);
+
     setjmp(regs);
 
     gcStarted();
+
     for (i=0; i<marksSize; ++i)         /* initialise mark set to empty    */
         marks[i] = 0;
 
@@ -2040,6 +2012,10 @@ exit(0);
 
     everybody(GCDONE);
 
+#if defined(DEBUG_STORAGE) || defined(DEBUG_STORAGE_EXTRA)
+    fprintf(stderr, "\n--- GC recovered %d\n",recovered );
+#endif
+
     /* can only return if freeList is nonempty on return. */
     if (recovered<minRecovery || isNull(freeList)) {
         ERRMSG(0) "Garbage collection fails to reclaim sufficient space"
@@ -3144,9 +3120,9 @@ Int what; {
                             i < NAME_BASE_ADDR+tabNameSz; ++i) {
                           if (tabName[i-NAME_BASE_ADDR].inUse) {
                              mark(name(i).parent);
+                             mark(name(i).type);
                              mark(name(i).defn);
                              mark(name(i).stgVar);
-                             mark(name(i).type);
                           }
                        }
                        end("Names", nameHw-NAMEMIN);
@@ -3160,6 +3136,8 @@ Int what; {
                              mark(module(i).classes);
                              mark(module(i).exports);
                              mark(module(i).qualImports);
+                             mark(module(i).tree);
+                             mark(module(i).uses);
                              mark(module(i).objectExtraNames);
                           }
                        }
@@ -3172,9 +3150,9 @@ Int what; {
                        for (i = TYCON_BASE_ADDR; 
                             i < TYCON_BASE_ADDR+tabTyconSz; ++i) {
                           if (tabTycon[i-TYCON_BASE_ADDR].inUse) {
-                             mark(tycon(i).defn);
                              mark(tycon(i).kind);
                              mark(tycon(i).what);
+                             mark(tycon(i).defn);
                           }
                        }
                        end("Type constructors", tyconHw-TYCMIN);
@@ -3182,13 +3160,13 @@ Int what; {
                        start();
                        for (i = CCLASS_BASE_ADDR; 
                             i < CCLASS_BASE_ADDR+tabClassSz; ++i) {
-                          if (tabModule[i-MODULE_BASE_ADDR].inUse) {
-                             mark(cclass(i).head);
+                          if (tabClass[i-CCLASS_BASE_ADDR].inUse) {
                              mark(cclass(i).kinds);
                             mark(cclass(i).fds);
                             mark(cclass(i).xfds);
-                             mark(cclass(i).dsels);
+                             mark(cclass(i).head);
                              mark(cclass(i).supers);
+                             mark(cclass(i).dsels);
                              mark(cclass(i).members);
                              mark(cclass(i).defaults);
                              mark(cclass(i).instances);
@@ -3201,8 +3179,8 @@ Int what; {
                        for (i = INST_BASE_ADDR; 
                             i < INST_BASE_ADDR+tabInstSz; ++i) {
                           if (tabInst[i-INST_BASE_ADDR].inUse) {
-                             mark(inst(i).head);
                              mark(inst(i).kinds);
+                             mark(inst(i).head);
                              mark(inst(i).specifics);
                              mark(inst(i).implements);
                           }

diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h
index c8b8449..8fc200f 100644 (file)
--- a/ghc/interpreter/storage.h
+++ b/ghc/interpreter/storage.h
@@ -10,11 +10,12 @@
  * included in the distribution.
  *
  * $RCSfile: storage.h,v $
- * $Revision: 1.39 $
- * $Date: 2000/04/05 10:25:08 $
+ * $Revision: 1.40 $
+ * $Date: 2000/04/05 16:57:18 $
  * ------------------------------------------------------------------------*/
 
-#define DEBUG_STORAGE
+#define DEBUG_STORAGE               /* a moderate level of sanity checking */
+#define DEBUG_STORAGE_EXTRA         /* max paranoia in sanity checks       */
 
 /* --------------------------------------------------------------------------
  * Typedefs for main data types:
@@ -159,12 +160,7 @@ extern  Int          cellsRecovered;    /* cells recovered by last gc      */
 
 extern  Pair         pair            ( Cell,Cell );
 extern  Void         garbageCollect  ( Void );
-
-extern  Void         overwrite       ( Pair,Pair );
-extern  Cell         markExpr        ( Cell );
-extern  Void         markWithoutMove ( Cell );
-
-#define mark(v)      v=markExpr(v)
+extern  Void         mark            ( Cell );
 
 #define isPair(c)    ((c)<0)
 #define isGenPair(c) ((c)<0 && -heapSize<=(c))
@@ -1068,6 +1064,7 @@ extern  StackPtr sp;
 #define pushed(n)    stack(sp-(n))
 #define topfun(f)    top()=ap((f),top())
 #define toparg(x)    top()=ap(top(),(x))
+#define getsp()      sp
 
 extern  Void hugsStackOverflow ( Void );