GCAux.c 4.14 KB
Newer Older
1 2 3 4
/* -----------------------------------------------------------------------------
 *
 * (c) The GHC Team 1998-2008
 *
5
 * Functions called from outside the GC need to be separate from GC.c,
6 7 8 9
 * because GC.c is compiled with register variable(s).
 *
 * ---------------------------------------------------------------------------*/

Simon Marlow's avatar
Simon Marlow committed
10
#include "PosixSource.h"
11
#include "Rts.h"
Simon Marlow's avatar
Simon Marlow committed
12

13
#include "GC.h"
Simon Marlow's avatar
Simon Marlow committed
14
#include "Storage.h"
15 16 17 18 19
#include "Compact.h"
#include "Task.h"
#include "Capability.h"
#include "Trace.h"
#include "Schedule.h"
Simon Marlow's avatar
Simon Marlow committed
20
// DO NOT include "GCTDecl.h", we don't want the register variable
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45

/* -----------------------------------------------------------------------------
   isAlive determines whether the given closure is still alive (after
   a garbage collection) or not.  It returns the new address of the
   closure if it is alive, or NULL otherwise.

   NOTE: Use it before compaction only!
         It untags and (if needed) retags pointers to closures.
   -------------------------------------------------------------------------- */

StgClosure *
isAlive(StgClosure *p)
{
  const StgInfoTable *info;
  bdescr *bd;
  StgWord tag;
  StgClosure *q;

  while (1) {
    /* The tag and the pointer are split, to be merged later when needed. */
    tag = GET_CLOSURE_TAG(p);
    q = UNTAG_CLOSURE(p);

    ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));

46
    // ignore static closures
47
    //
Ian Lynagh's avatar
Ian Lynagh committed
48 49 50 51
    // ToDo: This means we never look through IND_STATIC, which means
    // isRetainer needs to handle the IND_STATIC case rather than
    // raising an error.
    //
52 53
    // ToDo: for static closures, check the static link field.
    // Problem here is that we sometimes don't set the link field, eg.
Simon Marlow's avatar
Simon Marlow committed
54
    // for static closures with an empty SRT or CONSTR_NOCAFs.
55
    //
56
    if (!HEAP_ALLOCED_GC(q)) {
57
        return p;
58 59
    }

60
    // ignore closures in generations that we're not collecting.
61 62 63 64
    bd = Bdescr((P_)q);

    // if it's a pointer into to-space, then we're done
    if (bd->flags & BF_EVACUATED) {
65
        return p;
66 67 68 69
    }

    // large objects use the evacuated flag
    if (bd->flags & BF_LARGE) {
70
        return NULL;
71 72
    }

Simon Marlow's avatar
Simon Marlow committed
73
    // check the mark bit for compacted generations
74
    if ((bd->flags & BF_MARKED) && is_marked((P_)q,bd)) {
75
        return p;
76 77
    }

78 79 80
    info = q->header.info;

    if (IS_FORWARDING_PTR(info)) {
81
        // alive!
82
        return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info));
83 84 85 86
    }

    info = INFO_PTR_TO_STRUCT(info);

87 88 89 90
    switch (info->type) {

    case IND:
    case IND_STATIC:
91
      // follow indirections
92 93 94
      p = ((StgInd *)q)->indirectee;
      continue;

95 96 97 98 99 100 101 102
    case BLACKHOLE:
        p = ((StgInd*)q)->indirectee;
        if (GET_CLOSURE_TAG(p) != 0) {
            continue;
        } else {
            return NULL;
        }

103
    default:
104
      // dead.
105 106 107 108 109 110 111 112 113 114 115 116
      return NULL;
    }
  }
}

/* -----------------------------------------------------------------------------
   Reverting CAFs
   -------------------------------------------------------------------------- */

void
revertCAFs( void )
{
117
    StgIndStatic *c = revertible_caf_list;
118

119
    while (c != (StgIndStatic *) END_OF_CAF_LIST) {
120
        c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
121 122
        StgIndStatic *next = (StgIndStatic *) c->static_link;

123
        SET_INFO((StgClosure *)c, c->saved_info);
124
        c->saved_info = NULL;
125 126 127 128 129 130 131
        // We must reset static_link lest the major GC finds that
        // static_flag==3 and will consequently ignore references
        // into code that we are trying to unload. This would result
        // in reachable object code being unloaded prematurely.
        // See #16842.
        c->static_link = NULL;
        c = next;
132
    }
133
    revertible_caf_list = (StgIndStatic*)END_OF_CAF_LIST;
134 135 136 137 138 139 140
}

void
markCAFs (evac_fn evac, void *user)
{
    StgIndStatic *c;

141
    for (c = dyn_caf_list;
142
         c != (StgIndStatic*)END_OF_CAF_LIST;
143
         c = (StgIndStatic *)c->static_link)
144
    {
145
        c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
146
        evac(user, &c->indirectee);
147
    }
148
    for (c = revertible_caf_list;
149
         c != (StgIndStatic*)END_OF_CAF_LIST;
150
         c = (StgIndStatic *)c->static_link)
151
    {
152
        c = (StgIndStatic *)UNTAG_STATIC_LIST_PTR(c);
153
        evac(user, &c->indirectee);
154 155
    }
}