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