rts/sm/GCAux.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * (c) The GHC Team 1998-2008
   4  *
   5  * Functions called from outside the GC need to be separate from GC.c,
   6  * because GC.c is compiled with register variable(s).
   7  *
   8  * ---------------------------------------------------------------------------*/
   9
  10 #include "PosixSource.h"
  11 #include "Rts.h"
  12
  13 #include "GC.h"
  14 #include "Storage.h"
  15 #include "Compact.h"
  16 #include "Task.h"
  17 #include "Capability.h"
  18 #include "Trace.h"
  19 #include "Schedule.h"
  20 // DO NOT include "GCThread.h", we don't want the register variable
  21
  22 /* -----------------------------------------------------------------------------
  23    isAlive determines whether the given closure is still alive (after
  24    a garbage collection) or not.  It returns the new address of the
  25    closure if it is alive, or NULL otherwise.
  26
  27    NOTE: Use it before compaction only!
  28          It untags and (if needed) retags pointers to closures.
  29    -------------------------------------------------------------------------- */
  30
  31 StgClosure *
  32 isAlive(StgClosure *p)
  33 {
  34   const StgInfoTable *info;
  35   bdescr *bd;
  36   StgWord tag;
  37   StgClosure *q;
  38
  39   while (1) {
  40     /* The tag and the pointer are split, to be merged later when needed. */
  41     tag = GET_CLOSURE_TAG(p);
  42     q = UNTAG_CLOSURE(p);
  43
  44     ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
  45
  46     // ignore static closures
  47     //
  48     // ToDo: This means we never look through IND_STATIC, which means
  49     // isRetainer needs to handle the IND_STATIC case rather than
  50     // raising an error.
  51     //
  52     // ToDo: for static closures, check the static link field.
  53     // Problem here is that we sometimes don't set the link field, eg.
  54     // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
  55     //
  56     if (!HEAP_ALLOCED_GC(q)) {
  57         return p;
  58     }
  59
  60     // ignore closures in generations that we're not collecting.
  61     bd = Bdescr((P_)q);
  62
  63     // if it's a pointer into to-space, then we're done
  64     if (bd->flags & BF_EVACUATED) {
  65         return p;
  66     }
  67
  68     // large objects use the evacuated flag
  69     if (bd->flags & BF_LARGE) {
  70         if (get_itbl(q)->type == TSO &&
  71             ((StgTSO *)p)->what_next == ThreadRelocated) {
  72             p = (StgClosure *)((StgTSO *)p)->_link;
  73             continue;
  74         }
  75         return NULL;
  76     }
  77
  78     // check the mark bit for compacted steps
  79     if ((bd->flags & BF_MARKED) && is_marked((P_)q,bd)) {
  80         return p;
  81     }
  82
  83     info = q->header.info;
  84
  85     if (IS_FORWARDING_PTR(info)) {
  86         // alive!
  87         return (StgClosure*)UN_FORWARDING_PTR(info);
  88     }
  89
  90     info = INFO_PTR_TO_STRUCT(info);
  91
  92     switch (info->type) {
  93
  94     case IND:
  95     case IND_STATIC:
  96     case IND_PERM:
  97       // follow indirections
  98       p = ((StgInd *)q)->indirectee;
  99       continue;
 100
 101     case TSO:
 102       if (((StgTSO *)q)->what_next == ThreadRelocated) {
 103         p = (StgClosure *)((StgTSO *)q)->_link;
 104         continue;
 105       }
 106       return NULL;
 107
 108     default:
 109       // dead.
 110       return NULL;
 111     }
 112   }
 113 }
 114
 115 /* -----------------------------------------------------------------------------
 116    Reverting CAFs
 117    -------------------------------------------------------------------------- */
 118
 119 void
 120 revertCAFs( void )
 121 {
 122     StgIndStatic *c;
 123
 124     for (c = (StgIndStatic *)revertible_caf_list;
 125          c != (StgIndStatic *)END_OF_STATIC_LIST;
 126          c = (StgIndStatic *)c->static_link)
 127     {
 128         SET_INFO(c, c->saved_info);
 129         c->saved_info = NULL;
 130         // could, but not necessary: c->static_link = NULL;
 131     }
 132     revertible_caf_list = END_OF_STATIC_LIST;
 133 }
 134
 135 void
 136 markCAFs (evac_fn evac, void *user)
 137 {
 138     StgIndStatic *c;
 139
 140     for (c = (StgIndStatic *)caf_list;
 141          c != (StgIndStatic*)END_OF_STATIC_LIST;
 142          c = (StgIndStatic *)c->static_link)
 143     {
 144         evac(user, &c->indirectee);
 145     }
 146     for (c = (StgIndStatic *)revertible_caf_list;
 147          c != (StgIndStatic*)END_OF_STATIC_LIST;
 148          c = (StgIndStatic *)c->static_link)
 149     {
 150         evac(user, &c->indirectee);
 151     }
 152 }