[project @ 1999-03-15 16:53:10 by simonm]

[ghc-hetmet.git] / ghc / rts / GC.c

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 37a5cb1..680c8e5 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.49 1999/03/09 15:33:16 sewardj Exp $
+ * $Id: GC.c,v 1.52 1999/03/15 16:53:11 simonm Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -106,7 +106,7 @@ static void         zero_mutable_list       ( StgMutClosure *first );
 static void         revert_dead_CAFs        ( void );
 
 static rtsBool      traverse_weak_ptr_list  ( void );
-static void         cleanup_weak_ptr_list   ( void );
+static void         cleanup_weak_ptr_list   ( StgWeak **list );
 
 static void         scavenge_stack          ( StgPtr p, StgPtr stack_end );
 static void         scavenge_large          ( step *step );
@@ -420,7 +420,7 @@ void GarbageCollect(void (*get_roots)(void))
   /* Final traversal of the weak pointer list (see comment by
    * cleanUpWeakPtrList below).
    */
-  cleanup_weak_ptr_list();
+  cleanup_weak_ptr_list(&weak_ptr_list);
 
   /* Now see which stable names are still alive.
    */
@@ -788,8 +788,8 @@ traverse_weak_ptr_list(void)
    * of pending finalizers later on.
    */
   if (flag == rtsFalse) {
+    cleanup_weak_ptr_list(&old_weak_ptr_list);
     for (w = old_weak_ptr_list; w; w = w->link) {
-      w->value = evacuate(w->value);
       w->finalizer = evacuate(w->finalizer);
     }
     weak_done = rtsTrue;
@@ -811,12 +811,12 @@ traverse_weak_ptr_list(void)
    -------------------------------------------------------------------------- */
 
 static void
-cleanup_weak_ptr_list ( void )
+cleanup_weak_ptr_list ( StgWeak **list )
 {
   StgWeak *w, **last_w;
 
-  last_w = &weak_ptr_list;
-  for (w = weak_ptr_list; w; w = w->link) {
+  last_w = list;
+  for (w = *list; w; w = w->link) {
 
     if (get_itbl(w)->type == EVACUATED) {
       w = (StgWeak *)((StgEvacuated *)w)->evacuee;
@@ -1288,30 +1288,35 @@ loop:
     q = ((StgInd*)q)->indirectee;
     goto loop;
 
-    /* ToDo: optimise STATIC_LINK for known cases.
-       - FUN_STATIC       : payload[0]
-       - THUNK_STATIC     : payload[1]
-       - IND_STATIC       : payload[1]
-    */
   case THUNK_STATIC:
+    if (info->srt_len > 0 && major_gc && 
+       THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
+      THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
+      static_objects = (StgClosure *)q;
+    }
+    return q;
+
   case FUN_STATIC:
-    if (info->srt_len == 0) {  /* small optimisation */
-      return q;
+    if (info->srt_len > 0 && major_gc && 
+       FUN_STATIC_LINK((StgClosure *)q) == NULL) {
+      FUN_STATIC_LINK((StgClosure *)q) = static_objects;
+      static_objects = (StgClosure *)q;
     }
-    /* fall through */
-  case CONSTR_STATIC:
+    return q;
+
   case IND_STATIC:
-    /* don't want to evacuate these, but we do want to follow pointers
-     * from SRTs  - see scavenge_static.
-     */
+    if (major_gc && IND_STATIC_LINK((StgClosure *)q) == NULL) {
+      IND_STATIC_LINK((StgClosure *)q) = static_objects;
+      static_objects = (StgClosure *)q;
+    }
+    return q;
 
-    /* put the object on the static list, if necessary.
-     */
+  case CONSTR_STATIC:
     if (major_gc && STATIC_LINK(info,(StgClosure *)q) == NULL) {
       STATIC_LINK(info,(StgClosure *)q) = static_objects;
       static_objects = (StgClosure *)q;
     }
-    /* fall through */
+    return q;
 
   case CONSTR_INTLIKE:
   case CONSTR_CHARLIKE:
@@ -2330,7 +2335,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
       {
        StgUpdateFrame *frame = (StgUpdateFrame *)p;
        StgClosure *to;
-       StgClosureType type = get_itbl(frame->updatee)->type;
+       nat type = get_itbl(frame->updatee)->type;
 
        p += sizeofW(StgUpdateFrame);
        if (type == EVACUATED) {