ggc.c

OTP是开放电信平台的简称

/* ``The contents of this file are subject to the Erlang Public License,
 * Version 1.1, (the "License"); you may not use this file except in
 * compliance with the License. You should have received a copy of the
 * Erlang Public License along with this software. If not, it can be
 * retrieved via the world wide web at http://www.erlang.org/.
 * 
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 * the License for the specific language governing rights and limitations
 * under the License.
 * 
 * The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 * AB. All Rights Reserved.''
 * 
 *     $Id$
 */

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "erl_db.h"
#include "beam_catches.h"
#include "erl_binary.h"
#include "erl_bits.h"
#include "ggc.h"
#include "erl_nmgc.h"
#if HIPE
#include "hipe_bif0.h" /* for hipe_constants_{start,next} */
#include "hipe_stack.h"
#endif

#ifndef HEAP_FRAG_ELIM_TEST

static erts_smp_spinlock_t info_lck;
static Uint garbage_cols;		/* no of garbage collections */
static Uint reclaimed;			/* no of words reclaimed in GCs */

static void remove_message_buffers(Process* p);

/*
 * Returns number of elements in an array.
 */
#define ALENGTH(a) (sizeof(a)/sizeof(a[0]))

/*
 * Used for printing beautiful stack dumps.
 */
extern Eterm beam_apply[];
extern Eterm beam_exit[];

static void gen_gc(Process*, int, Eterm*, int);
static void sweep_proc_bins(Process *p, int fullsweep);
#ifndef HYBRID /* FIND ME! */
static void sweep_proc_funs(Process *p, int fullsweep);
#endif
static void sweep_proc_externals(Process *p, int fullsweep);

#ifdef DEBUG
static void check_mbuf_sz(Process *p);
#endif


#ifdef HARDDEBUG
static void check_stack(Process*, char*);
void check_bins(Process *p);
int chk_sys(void);

#define CHECK(p)                \
    erts_check_stack(p);        \
    check_bins(p);		\
    check_mbuf_sz(p);

#elif defined(DEBUG)
# define CHECK(p) check_mbuf_sz(p)
#else
# define CHECK(p) ((void) 1)
#endif /* HARDDEBUG */

#if defined(HYBRID)
char ma_gc_flags = 0;
#endif

/*
 * Return the next heap size to use. Make sure we never return
 * a smaller heap size than the minimum heap size for the process.
 * (Use of the erlang:hibernate/3 BIF could have shrinked the
 * heap below the minimum heap size.)
 */
static Uint
next_heap_size(Process* p, Uint size, Uint offset)
{
    size = erts_next_heap_size(size, offset);
    return size < p->min_heap_size ? p->min_heap_size : size;
}

/*
 * Offset pointers to heap from stack.
 */

static void 
offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, 
		Eterm* low, Eterm* high)
{
    char* water_start = (char *)low;
    Uint water_size = (char *)high - water_start;

    while (sz--) {
	Eterm val = *hp;
	switch (primary_tag(val)) {
	  case TAG_PRIMARY_LIST:
	  case TAG_PRIMARY_BOXED: {
	      if (in_area(ptr_val(val), water_start, water_size)) {
		  *hp = offset_ptr(val, offs);
	      }
	      hp++;
	      continue;
	  }
	  default: {
	      hp++;
	      continue;
	  }
	}
    }
}

void 
erts_offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, 
		     Eterm* low, Eterm* high)
{
    offset_heap_ptr(hp, sz, offs, low, high);
}

/*
 * Offset pointers into the heap (not stack).
 * Only offset pointers that point into the interval of low and high.
 */

static void 
offset_heap(Eterm* hp, Uint sz, Sint offs, Eterm* low, Eterm* high)
{
    char* water_start = (char *)low;
    Uint water_size = (char *)high - water_start;
    
    
    while (sz--) {
	Eterm val = *hp;
	switch (primary_tag(val)) {
	  case TAG_PRIMARY_LIST:
	  case TAG_PRIMARY_BOXED: {
	      if (in_area(ptr_val(val), water_start, water_size)) {
		  *hp = offset_ptr(val, offs);
	      }
	      hp++;
	      continue;
	  }
	  case TAG_PRIMARY_HEADER: {
	      Uint tari;

	      if (header_is_transparent(val)) {
		  hp++;
		  continue;
	      }
	      tari = thing_arityval(val);
	      switch (thing_subtag(val)) {
		      
	      case REFC_BINARY_SUBTAG:
		  {
		      ProcBin* pb = (ProcBin*) hp;
		      Eterm** uptr = (Eterm **) &pb->next;

		      if (*uptr && in_area((Eterm *)pb->next,
					   water_start, water_size)) {
			  *uptr += offs; /* Patch the mso chain */
		      }
		      sz -= tari;
		      hp += tari + 1;
		  }
		  break;
	      
	      case BIN_MATCHSTATE_SUBTAG:
		{	
		  ErlBinMatchState *ms = (ErlBinMatchState*) hp;
		  ErlBinMatchBuffer *mb = &(ms->mb);
		  if (in_area(ptr_val(mb->orig), water_start, water_size)) {
		      mb->orig = offset_ptr(mb->orig, offs);
		      mb->base = binary_bytes(mb->orig);
		  }
		  sz -= tari;
		  hp += tari + 1;
		}
		break;
		  
	      case FUN_SUBTAG:
		  {
#ifndef HYBRID /* FIND ME! */
		      ErlFunThing* funp = (ErlFunThing *) hp;
		      Eterm** uptr = (Eterm **) &funp->next;

		      if (*uptr && in_area((Eterm *)funp->next,
					   water_start, water_size)) {
			  *uptr += offs;
		      }
#endif
		      sz -= tari;
		      hp += tari + 1;
		  }
		  break;
	      case EXTERNAL_PID_SUBTAG:
	      case EXTERNAL_PORT_SUBTAG:
	      case EXTERNAL_REF_SUBTAG:
		  {
		      ExternalThing* etp = (ExternalThing *) hp;
		      Eterm** uptr = (Eterm **) &etp->next;

		      if (*uptr && in_area((Eterm *)etp->next,
					   water_start, water_size)) {
			  *uptr += offs;
		      }
		      sz -= tari;
		      hp += tari + 1;
		  }
		  break;
	      default:
		  sz -= tari;
		  hp += tari + 1;
	      }
	      continue;
	  }
	  default: {
	      hp++;
	      continue;
	  }
	}
    }
}


void 
erts_offset_heap(Eterm* hp, Uint sz, Sint offs, Eterm* low, Eterm* high)
{
    offset_heap(hp, sz, offs, low, high);
}

/*
 * Offset pointers in message queue.
 */
static void
offset_mqueue(Process *p, Sint offs, Eterm* low, Eterm* high) 
{
    ErlMessage* mp = p->msg.first;
    char* water_start = (char *)low;
    Uint water_size = (char *)high - water_start;

    while (mp != NULL) {
#if defined(ERTS_SMP)
	if (!mp->bp)
#endif
	{
	    Eterm mesg = ERL_MESSAGE_TERM(mp);
	    switch (primary_tag(mesg)) {
	    case TAG_PRIMARY_LIST:
	    case TAG_PRIMARY_BOXED:
		if (in_area(ptr_val(mesg), water_start, water_size)) {
		    ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs);
		}
		break;
	    }
	    mesg = ERL_MESSAGE_TOKEN(mp);
	    if (is_boxed(mesg)
		&& in_area(ptr_val(mesg), water_start, water_size)) {
		ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
	    }
	    ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
		    is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
		    is_atom(ERL_MESSAGE_TOKEN(mp))));
	}
        mp = mp->next;
    }
}

/*
 * HiPE native code stack scanning procedures:
 * - fullsweep_nstack()
 * - gensweep_nstack()
 * - offset_nstack()
 */
#if defined(HIPE)

#define GENSWEEP_NSTACK(p,old_htop,n_htop)				\
	do {								\
		Eterm *tmp_old_htop = old_htop;				\
		Eterm *tmp_n_htop = n_htop;				\
		gensweep_nstack((p), &tmp_old_htop, &tmp_n_htop);	\
		old_htop = tmp_old_htop;				\
		n_htop = tmp_n_htop;					\
	} while(0)

/*
 * offset_nstack() can ignore the descriptor-based traversal the other
 * nstack procedures use and simply call offset_heap_ptr() instead.
 * This relies on two facts:
 * 1. The only live non-Erlang terms on an nstack are return addresses,
 *    and they will be skipped thanks to the low/high range check.
 * 2. Dead values, even if mistaken for pointers into the low/high area,
 *    can be offset safely since they won't be dereferenced.
 *
 * XXX: WARNING: If HiPE starts storing other non-Erlang values on the
 * nstack, such as floats, then this will have to be changed.
 */
#define offset_nstack(p,offs,low,high) offset_heap_ptr(hipe_nstack_start((p)),hipe_nstack_used((p)),(offs),(low),(high))

#else /* !HIPE */

#define fullsweep_nstack(p,n_htop)		(n_htop)
#define GENSWEEP_NSTACK(p,old_htop,n_htop)	do{}while(0)
#define offset_nstack(p,offs,low,high)		do{}while(0)

#endif /* HIPE */

int setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
{
    int n;
    ErlMessage* mp;
    Eterm* v_ptr;
    int v_msg_len;

    v_msg_len = 2 * p->msg.len;

    /*
     * Move pointers for all messages into an array pointed to by p->v_msg.
     */
    if (v_msg_len > ALENGTH(rootset->def_msg)) {
        rootset->v_msg = (Eterm *)
	    erts_alloc(ERTS_ALC_T_MSG_ROOTS, sizeof(Eterm) * v_msg_len);
    } else {
        rootset->v_msg = rootset->def_msg;
    }
    mp = p->msg.first;
    v_ptr = rootset->v_msg;
    while (mp != NULL) {
#if defined(ERTS_SMP)
	if (mp->bp) {
	    *v_ptr++ = NIL;
	    *v_ptr++ = NIL;
	}
	else
#endif
	{
	    *v_ptr++ = ERL_MESSAGE_TERM(mp);
	    ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
		    is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
		    is_atom(ERL_MESSAGE_TOKEN(mp))));
	    *v_ptr++ = ERL_MESSAGE_TOKEN(mp);
	}
        mp = mp->next;
    }

    n = 0;
    rootset->v[n]  = p->stop;
    rootset->sz[n] = STACK_START(p) - p->stop;
    ++n;

    if (p->dictionary != NULL) {
        rootset->v[n]  = p->dictionary->data;
        rootset->sz[n] = p->dictionary->used;
        ++n;
    }
    if (p->debug_dictionary != NULL) {
        rootset->v[n]  = p->debug_dictionary->data;
        rootset->sz[n] = p->debug_dictionary->used;
        ++n;
    }
    rootset->v[n]  = rootset->v_msg;
    rootset->sz[n] = v_msg_len;
    ++n;
    if (nobj > 0) {
        rootset->v[n]  = objv;
        rootset->sz[n] = nobj;
        ++n;
    }

    ASSERT((is_nil(p->seq_trace_token) 
	    || is_tuple(p->seq_trace_token)
	    || is_atom(p->seq_trace_token)));
    rootset->v[n] = &p->seq_trace_token;
    rootset->sz[n] = 1;
    n++;

    ASSERT(is_nil(p->tracer_proc)
	   || is_internal_pid(p->tracer_proc)
	   || is_internal_port(p->tracer_proc));

    ASSERT(is_pid(p->group_leader));
    rootset->v[n]  = &p->group_leader;
    rootset->sz[n] = 1;
    ++n;

    /*
     * The process may be garbage-collected while it is terminating.
     * (fvalue contains EXIT reason and ftrace the saved stack trace.)
     */
    rootset->v[n]  = &p->fvalue;
    rootset->sz[n] = 1;
    n++;
    rootset->v[n]  = &p->ftrace;
    rootset->sz[n] = 1;
    n++;

#ifdef HYBRID
    if ((ma_gc_flags & GC_GLOBAL) && (p->nrr != 0))
    {
        rootset->v[n]  = p->rrma;
        rootset->sz[n] = p->nrr;
        n++;
    }
#endif

#if HIPE && defined(HYBRID)
    rootset->p = p;
#endif

    ASSERT(n <= ALENGTH(rootset->v));
    return n;
}

#if defined(HYBRID)
Uint collect_roots(Process* current, Eterm *objv, int nobj, Rootset rootset[])
{
    Process* p;
    Uint i, j = 0;
    Uint n = erts_num_active_procs;

    for (i = 0; i < n; i++) {
        p = erts_active_procs[i];
	if ((IS_ACTIVE(p) && INC_IS_ACTIVE(p)) ||
            ma_gc_flags & GC_INCLUDE_ALL) {
	    if (p == current) {
		rootset[j].n = setup_rootset(p, objv, nobj, &rootset[j]);
	    } else {
		rootset[j].n = setup_rootset(p, p->arg_reg, p->arity, &rootset[j]);
	    }
	    j++;
	}
    }
    return j;
}
#endif

static ERTS_INLINE
void restore_this_rootset(Process *p, Rootset *rootset)
{
    Eterm* v_ptr;
    ErlMessage* mp;

#ifdef HYBRID
    /*
     * Restore remembered rootset of this process.
     */
    if(!(ma_gc_flags & GC_GLOBAL)) {
        /*
         * If this was a collection of a private heap, make sure to
         * strike out pointers to the message area that was dead.
         */
        int i;
        for (i = 0; i < p->nrr; i++) {
            if (ptr_within(p->rrsrc[i],p->heap,p->hend)) {
                RRMA_REMOVE(p,i);
            }
        }
    }
    else {
        /*
         * If this was a collection of the message area, update
         * pointers in private heaps to point to the new message area.
         */
        int i;
        for (i = 0; i < p->nrr; i++) {
            ASSERT(p->rrsrc[i] != NULL);
            *(p->rrsrc[i]) = p->rrma[i];
        }
    }
#endif

    /*
     * Restore all message pointers.
     */
    mp = p->msg.first;
    v_ptr = rootset->v_msg;
    while (mp != NULL) {
#if defined(ERTS_SMP)
	if (mp->bp) {
	    v_ptr += 2;
	}