6930181996-02-25Fredrik Hübinette (Hubbe) /*\
06983f1996-09-22Fredrik Hübinette (Hubbe) ||| This file a part of Pike, and is copyright by Fredrik Hubinette ||| Pike is distributed as GPL (General Public License)
6930181996-02-25Fredrik Hübinette (Hubbe) ||| See the files COPYING and DISCLAIMER for more information. \*/
3741091999-09-25Henrik Grubbström (Grubba) /**/
6930181996-02-25Fredrik Hübinette (Hubbe) #include "global.h"
a29e021996-10-15Fredrik Hübinette (Hubbe) struct callback *gc_evaluator_callback=0;
c94c371996-03-28Fredrik Hübinette (Hubbe) #include "array.h"
06983f1996-09-22Fredrik Hübinette (Hubbe) #include "multiset.h"
c94c371996-03-28Fredrik Hübinette (Hubbe) #include "mapping.h" #include "object.h" #include "program.h"
4a578f1997-01-27Fredrik Hübinette (Hubbe) #include "stralloc.h"
9c6f7d1997-04-15Fredrik Hübinette (Hubbe) #include "stuff.h" #include "error.h"
9aa6fa1997-05-19Fredrik Hübinette (Hubbe) #include "pike_memory.h"
1a11681997-10-06Fredrik Hübinette (Hubbe) #include "pike_macros.h"
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) #include "pike_types.h"
dc296b1997-10-21Fredrik Hübinette (Hubbe) #include "time_stuff.h"
2eeba91999-03-17Fredrik Hübinette (Hubbe) #include "constants.h"
1637c42000-02-01Fredrik Hübinette (Hubbe) #include "interpret.h"
c94c371996-03-28Fredrik Hübinette (Hubbe) 
6930181996-02-25Fredrik Hübinette (Hubbe) #include "gc.h" #include "main.h"
dc296b1997-10-21Fredrik Hübinette (Hubbe) #include <math.h>
6930181996-02-25Fredrik Hübinette (Hubbe) 
3741091999-09-25Henrik Grubbström (Grubba) #include "block_alloc.h"
996f872000-06-12Martin Stjernholm RCSID("$Id: gc.c,v 1.91 2000/06/12 03:21:11 mast Exp $");
24ddc71998-03-28Henrik Grubbström (Grubba) 
e2d9e62000-06-10Martin Stjernholm /* Run garbage collect approximately every time
6930181996-02-25Fredrik Hübinette (Hubbe)  * 20 percent of all arrays, objects and programs is * garbage. */ #define GC_CONST 20 #define MIN_ALLOC_THRESHOLD 1000
b95bef1996-03-29Fredrik Hübinette (Hubbe) #define MAX_ALLOC_THRESHOLD 10000000
6930181996-02-25Fredrik Hübinette (Hubbe) #define MULTIPLIER 0.9
c94c371996-03-28Fredrik Hübinette (Hubbe) #define MARKER_CHUNK_SIZE 1023
e2d9e62000-06-10Martin Stjernholm #define REF_CYCLE_CHUNK_SIZE 32 /* The gc will free all things with no external references that isn't * referenced by undestructed objects with destroy() lfuns (known as * "live" objects). Live objects without external references are then * destructed and garbage collected with normal refcount garbing * (which might leave dead garbage around for the next gc). These live * objects are destructed in an order that tries to be as well defined * as possible using several rules: * * o If an object A references B single way, then A is destructed * before B. * o If A and B are in a cycle, and there is a reference somewhere * from B to A that is weaker than any reference from A to B, then * A is destructed before B. * o Weak references are considered weaker than normal ones, and both * are considered weaker than strong references. * o Strong references are used in special cases like parent object * references. There can never be a cycle consisting only of strong * references. (This means the gc will never destruct a parent * object before all childs has been destructed.) * * The gc tries to detect and warn about cases where there are live * objects with no well defined order between them. There are cases * that are missed by this detection, though. * * Things that aren't live objects but are referenced from them are * still intact during this destruct pass, so it's entirely possible * to save these things by adding external references to them. * However, it's not possible for live objects to save themselves or * other live objects; all live objects that didn't have external * references at the start of the gc pass will be destructed * regardless of added references. * * Things that have only weak references at the start of the gc pass * will be freed. That's done before the live object destruct pass. */ /* #define GC_VERBOSE */ /* #define GC_CYCLE_DEBUG */ #if defined(GC_VERBOSE) && !defined(PIKE_DEBUG) #undef GC_VERBOSE #endif #ifdef GC_VERBOSE #define GC_VERBOSE_DO(X) X #else #define GC_VERBOSE_DO(X) #endif
6930181996-02-25Fredrik Hübinette (Hubbe) 
7bf6232000-04-23Martin Stjernholm INT32 num_objects = 1; /* Account for empty_array. */
dc296b1997-10-21Fredrik Hübinette (Hubbe) INT32 num_allocs =0;
6930181996-02-25Fredrik Hübinette (Hubbe) INT32 alloc_threshold = MIN_ALLOC_THRESHOLD;
6bc62b2000-04-14Martin Stjernholm int Pike_in_gc = 0;
8ea2061998-04-29Fredrik Noring struct pike_queue gc_mark_queue;
4452c12000-02-02Fredrik Hübinette (Hubbe) time_t last_gc;
996f872000-06-12Martin Stjernholm static struct marker rec_list = {0, 0, 0};
e2d9e62000-06-10Martin Stjernholm struct marker *gc_rec_last = &rec_list; static struct marker *kill_list = 0; static unsigned last_cycle;
6930181996-02-25Fredrik Hübinette (Hubbe) 
996f872000-06-12Martin Stjernholm /* rec_list is a linked list of the markers currently being recursed * through in the cycle check pass. gc_rec_last points at the * innermost marker being visited. A new marker is linked in after * gc_rec_last, except when that's inside a cycle, in which case it's * linked in after that cycle. A cycle is always treated as one atomic * unit, e.g. it's either popped whole or not at all. * * Two ranges of markers next to each other may swap places to break a * cyclic reference at a chosen point. Some markers thus get a place * earlier on the list even though their corresponding stack frames * are later than some other markers they have references to. These * markers are given the GC_DONT_POP flag to make them stay on the * list when they're popped from the stack. They'll get popped * eventually since all markers in the gap between the top one and * it's previous gc_rec_last point are popped. * * Markers for live objects are linked into the beginning of kill_list * when they're popped from rec_list. * * The cycle check functions might recurse another round through the * markers that have been recursed already, to propagate the GC_LIVE * flag to things that have been found to be referenced from live * objects. rec_list is not touched at all in this extra round. */
dc296b1997-10-21Fredrik Hübinette (Hubbe) static double objects_alloced = 0.0; static double objects_freed = 0.0;
6930181996-02-25Fredrik Hübinette (Hubbe) 
4a578f1997-01-27Fredrik Hübinette (Hubbe) struct callback_list gc_callbacks;
424d9c1999-05-02Fredrik Hübinette (Hubbe) struct callback *debug_add_gc_callback(callback_func call,
4a578f1997-01-27Fredrik Hübinette (Hubbe)  void *arg, callback_func free_func) { return add_to_callback(&gc_callbacks, call, arg, free_func); }
c94c371996-03-28Fredrik Hübinette (Hubbe) 
424d9c1999-05-02Fredrik Hübinette (Hubbe) #undef INIT_BLOCK
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm #define INIT_BLOCK(X) \ (X)->flags=(X)->refs=(X)->weak_refs=(X)->xrefs=0; \ (X)->saved_refs=-1; \ (X)->cycle = (unsigned INT16) -1; \ (X)->link = (struct marker *) -1;
424d9c1999-05-02Fredrik Hübinette (Hubbe) #else
e2d9e62000-06-10Martin Stjernholm #define INIT_BLOCK(X) \ (X)->flags=(X)->refs=(X)->weak_refs=0;
05c7cd1997-07-19Fredrik Hübinette (Hubbe) #endif
c94c371996-03-28Fredrik Hübinette (Hubbe) 
424d9c1999-05-02Fredrik Hübinette (Hubbe) PTR_HASH_ALLOC(marker,MARKER_CHUNK_SIZE)
c94c371996-03-28Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm int gc_in_cycle_check = 0; static unsigned weak_freed, checked, marked, cycle_checked, live_ref; static unsigned gc_extra_refs = 0;
dc296b1997-10-21Fredrik Hübinette (Hubbe) void dump_gc_info(void) { fprintf(stderr,"Current number of objects: %ld\n",(long)num_objects); fprintf(stderr,"Objects allocated total : %ld\n",(long)num_allocs); fprintf(stderr," threshold for next gc() : %ld\n",(long)alloc_threshold); fprintf(stderr,"Average allocs per gc() : %f\n",objects_alloced); fprintf(stderr,"Average frees per gc() : %f\n",objects_freed); fprintf(stderr,"Second since last gc() : %ld\n", (long)TIME(0) - (long)last_gc); fprintf(stderr,"Projected garbage : %f\n", objects_freed * (double) num_allocs / (double) alloc_threshold);
6bc62b2000-04-14Martin Stjernholm  fprintf(stderr,"in_gc : %d\n", Pike_in_gc);
dc296b1997-10-21Fredrik Hübinette (Hubbe) }
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) TYPE_T attempt_to_identify(void *something) { struct array *a; struct object *o; struct program *p;
62971d1998-01-19Fredrik Hübinette (Hubbe)  struct mapping *m; struct multiset *mu;
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  a=&empty_array; do { if(a==(struct array *)something) return T_ARRAY; a=a->next; }while(a!=&empty_array); for(o=first_object;o;o=o->next) if(o==(struct object *)something) return T_OBJECT; for(p=first_program;p;p=p->next) if(p==(struct program *)something) return T_PROGRAM;
62971d1998-01-19Fredrik Hübinette (Hubbe)  for(m=first_mapping;m;m=m->next) if(m==(struct mapping *)something) return T_MAPPING; for(mu=first_multiset;mu;mu=mu->next) if(mu==(struct multiset *)something) return T_MULTISET; if(safe_debug_findstring((struct pike_string *)something)) return T_STRING;
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  return T_UNKNOWN; }
20513c2000-04-12Fredrik Hübinette (Hubbe) void *check_for =0;
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) static char *found_where="";
f6d0171997-10-15Fredrik Hübinette (Hubbe) static void *found_in=0;
4694111997-11-07Fredrik Hübinette (Hubbe) static int found_in_type=0;
f6d0171997-10-15Fredrik Hübinette (Hubbe) void *gc_svalue_location=0;
06ae272000-04-19Martin Stjernholm char *fatal_after_gc=0;
e2d9e62000-06-10Martin Stjernholm int gc_debug = 0;
ad2bdb2000-04-12Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe) #define DESCRIBE_MEM 1 #define DESCRIBE_NO_REFS 2 #define DESCRIBE_SHORT 4 #define DESCRIBE_NO_DMALLOC 8
ad2bdb2000-04-12Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe) /* type == -1 means that memblock is a char* and should be * really be printed.. */ void describe_location(void *real_memblock, int real_type, void *location, int indent, int depth, int flags)
3568101997-10-16Fredrik Hübinette (Hubbe) {
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  struct program *p;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  void *memblock=0; int type=real_type;
4694111997-11-07Fredrik Hübinette (Hubbe)  if(!location) return;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe) /* fprintf(stderr,"**Location of (short) svalue: %p\n",location); */
62971d1998-01-19Fredrik Hübinette (Hubbe) 
87c7f92000-04-19Martin Stjernholm  if(real_type!=-1) memblock=real_memblock;
a4033e2000-04-14Fredrik Hübinette (Hubbe) 
20513c2000-04-12Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC if(memblock == 0 || type == -1) { extern void *dmalloc_find_memblock_base(void *); memblock=dmalloc_find_memblock_base(location); } #endif
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(type==T_UNKNOWN) type=attempt_to_identify(memblock);
20513c2000-04-12Fredrik Hübinette (Hubbe)  if(memblock)
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s-> from %s %p offset %ld\n", indent,"",
20513c2000-04-12Fredrik Hübinette (Hubbe)  get_name_of_type(type), memblock, ((long)location - (long)memblock)); else
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s-> at location %p in unknown memblock (mmaped?)\n", indent,"",
20513c2000-04-12Fredrik Hübinette (Hubbe)  location);
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(memblock && depth>0) describe_something(memblock,type,indent+2,depth-1,flags | DESCRIBE_MEM);
20513c2000-04-12Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  again:
62971d1998-01-19Fredrik Hübinette (Hubbe)  switch(type)
3568101997-10-16Fredrik Hübinette (Hubbe)  {
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  case T_UNKNOWN: for(p=first_program;p;p=p->next) { if(memblock == (void *)p->program) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In memory block for program at %p\n", indent,"", p);
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  memblock=p; type=T_PROGRAM;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  goto again;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  } } break;
0b69441998-01-19Fredrik Hübinette (Hubbe)  case T_PROGRAM: {
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  long e;
0b69441998-01-19Fredrik Hübinette (Hubbe)  char *ptr=(char *)location;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  p=(struct program *)memblock;
0b69441998-01-19Fredrik Hübinette (Hubbe) 
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  if(location == (void *)&p->prev)
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In p->prev\n",indent,"");
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  if(location == (void *)&p->next)
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In p->next\n",indent,"");
1e4e5f2000-04-07Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(p->inherits && ptr >= (char *)p->inherits && ptr<(char*)(p->inherits+p->num_inherits))
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  { e=((long)ptr - (long)(p->inherits)) / sizeof(struct inherit);
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In p->inherits[%ld] (%s)\n",indent,"",
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  e, p->inherits[e].name ? p->inherits[e].name->str : "no name");
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  }
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(p->constants && ptr >= (char *)p->constants && ptr<(char*)(p->constants+p->num_constants))
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  { e=((long)ptr - (long)(p->constants)) / sizeof(struct program_constant);
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In p->constants[%ld] (%s)\n",indent,"",
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  e, p->constants[e].name ? p->constants[e].name->str : "no name");
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  }
0b69441998-01-19Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(p->identifiers && ptr >= (char *)p->identifiers && ptr<(char*)(p->identifiers+p->num_identifiers))
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  { e=((long)ptr - (long)(p->identifiers)) / sizeof(struct identifier);
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In p->identifiers[%ld] (%s)\n",indent,"",
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  e,
a4033e2000-04-14Fredrik Hübinette (Hubbe)  p->identifiers[e].name ? p->identifiers[e].name->str : "no name");
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  } #define FOO(NTYP,TYP,NAME) \
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(location == (void *)&p->NAME) fprintf(stderr,"%*s **In p->" #NAME "\n",indent,""); \
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  if(ptr >= (char *)p->NAME && ptr<(char*)(p->NAME+p->PIKE_CONCAT(num_,NAME))) \
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In p->" #NAME "[%ld]\n",indent,"",((long)ptr - (long)(p->NAME)) / sizeof(TYP));
1e4e5f2000-04-07Fredrik Hübinette (Hubbe) #include "program_areas.h"
0b69441998-01-19Fredrik Hübinette (Hubbe) 
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
0b69441998-01-19Fredrik Hübinette (Hubbe)  }
62971d1998-01-19Fredrik Hübinette (Hubbe)  case T_OBJECT:
3568101997-10-16Fredrik Hübinette (Hubbe)  {
62971d1998-01-19Fredrik Hübinette (Hubbe)  struct object *o=(struct object *)memblock;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  struct program *p;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(location == (void *)&o->parent) fprintf(stderr,"%*s **In o->parent\n",indent,""); if(location == (void *)&o->prog) fprintf(stderr,"%*s **In o->prog\n",indent,""); if(location == (void *)&o->next) fprintf(stderr,"%*s **In o->next\n",indent,""); if(location == (void *)&o->prev) fprintf(stderr,"%*s **In o->prev\n",indent,"");
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  p=o->prog; if(!o->prog) { p=id_to_program(o->program_id); if(p)
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **(We are lucky, found program for destructed object)\n",indent,"");
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  } if(p)
3568101997-10-16Fredrik Hübinette (Hubbe)  {
62971d1998-01-19Fredrik Hübinette (Hubbe)  INT32 e,d;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  for(e=0;e<(INT32)p->num_inherits;e++)
3568101997-10-16Fredrik Hübinette (Hubbe)  {
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  struct inherit tmp=p->inherits[e];
62971d1998-01-19Fredrik Hübinette (Hubbe)  char *base=o->storage + tmp.storage_offset; for(d=0;d<(INT32)tmp.prog->num_identifiers;d++)
3568101997-10-16Fredrik Hübinette (Hubbe)  {
62971d1998-01-19Fredrik Hübinette (Hubbe)  struct identifier *id=tmp.prog->identifiers+d; if(!IDENTIFIER_IS_VARIABLE(id->identifier_flags)) continue; if(location == (void *)(base + id->func.offset)) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In variable %s\n",indent,"",id->name->str);
62971d1998-01-19Fredrik Hübinette (Hubbe)  }
3568101997-10-16Fredrik Hübinette (Hubbe)  }
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  if((char *)location >= base && (char *)location <= base + ( tmp.prog->storage_needed - tmp.prog->inherits[0].storage_offset )) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In storage for inherit %d",indent,"",e);
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  if(tmp.name) fprintf(stderr," (%s)",tmp.name->str); fprintf(stderr,"\n"); }
3568101997-10-16Fredrik Hübinette (Hubbe)  } }
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
3568101997-10-16Fredrik Hübinette (Hubbe)  }
62971d1998-01-19Fredrik Hübinette (Hubbe)  case T_ARRAY: { struct array *a=(struct array *)memblock; struct svalue *s=(struct svalue *)location;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s **In index %ld\n",indent,"",(long)(s-ITEM(a)));
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
62971d1998-01-19Fredrik Hübinette (Hubbe)  }
3568101997-10-16Fredrik Hübinette (Hubbe)  }
dfe8f32000-04-26Fredrik Hübinette (Hubbe) 
57a4362000-04-27Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  dmalloc_describe_location(memblock, location, indent);
57a4362000-04-27Fredrik Hübinette (Hubbe) #endif
3568101997-10-16Fredrik Hübinette (Hubbe) }
e2d9e62000-06-10Martin Stjernholm static void describe_marker(struct marker *m) { if (m) fprintf(stderr, "marker at %p: flags=0x%04x, refs=%d, weak=%d, " "xrefs=%d, saved=%d, cycle=%d, link=%p\n", m, m->flags, m->refs, m->weak_refs, m->xrefs, m->saved_refs, m->cycle, m->link); else fprintf(stderr, "no marker\n"); } void debug_gc_fatal(void *a, int flags, const char *fmt, ...) { va_list args; struct marker *m = find_marker(a); va_start(args, fmt); fprintf(stderr, "**"); (void) VFPRINTF(stderr, fmt, args); if (m) { fprintf(stderr, "**Describing gc marker: "); describe_marker(m); } describe(a); if (flags & 1) locate_references(a); if (flags & 2) fatal_after_gc = "Fatal in garbage collector.\n"; else debug_fatal("Fatal in garbage collector.\n"); }
b8a6e71996-09-25Fredrik Hübinette (Hubbe) static void gdb_gc_stop_here(void *a) {
20513c2000-04-12Fredrik Hübinette (Hubbe)  fprintf(stderr,"***One ref found%s.\n",found_where?found_where:"");
a4033e2000-04-14Fredrik Hübinette (Hubbe)  describe_something(found_in, found_in_type, 2, 1, DESCRIBE_NO_DMALLOC); describe_location(found_in , found_in_type, gc_svalue_location,2,1,0);
20513c2000-04-12Fredrik Hübinette (Hubbe)  fprintf(stderr,"----------end------------\n");
b8a6e71996-09-25Fredrik Hübinette (Hubbe) }
f6d0171997-10-15Fredrik Hübinette (Hubbe) 
4694111997-11-07Fredrik Hübinette (Hubbe) void debug_gc_xmark_svalues(struct svalue *s, int num, char *fromwhere) { found_in=(void *)fromwhere; found_in_type=-1; gc_xmark_svalues(s,num); found_in_type=T_UNKNOWN; found_in=0; }
f6d0171997-10-15Fredrik Hübinette (Hubbe) TYPE_FIELD debug_gc_check_svalues(struct svalue *s, int num, TYPE_T t, void *data) { TYPE_FIELD ret; found_in=data; found_in_type=t; ret=gc_check_svalues(s,num); found_in_type=T_UNKNOWN;
4694111997-11-07Fredrik Hübinette (Hubbe)  found_in=0;
f6d0171997-10-15Fredrik Hübinette (Hubbe)  return ret; }
e2d9e62000-06-10Martin Stjernholm TYPE_FIELD debug_gc_check_weak_svalues(struct svalue *s, int num, TYPE_T t, void *data) { TYPE_FIELD ret; found_in=data; found_in_type=t; ret=gc_check_weak_svalues(s,num); found_in_type=T_UNKNOWN; found_in=0; return ret; }
f6d0171997-10-15Fredrik Hübinette (Hubbe) void debug_gc_check_short_svalue(union anything *u, TYPE_T type, TYPE_T t, void *data) { found_in=data; found_in_type=t; gc_check_short_svalue(u,type); found_in_type=T_UNKNOWN;
4694111997-11-07Fredrik Hübinette (Hubbe)  found_in=0;
f6d0171997-10-15Fredrik Hübinette (Hubbe) }
e2d9e62000-06-10Martin Stjernholm void debug_gc_check_weak_short_svalue(union anything *u, TYPE_T type, TYPE_T t, void *data) { found_in=data; found_in_type=t; gc_check_weak_short_svalue(u,type); found_in_type=T_UNKNOWN; found_in=0; }
0b69441998-01-19Fredrik Hübinette (Hubbe)  int debug_gc_check(void *x, TYPE_T t, void *data) { int ret; found_in=data; found_in_type=t; ret=gc_check(x); found_in_type=T_UNKNOWN; found_in=0; return ret; }
a4033e2000-04-14Fredrik Hübinette (Hubbe) void low_describe_something(void *a, int t, int indent, int depth, int flags)
f6d0171997-10-15Fredrik Hübinette (Hubbe) { struct program *p=(struct program *)a;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(depth<0) return;
f6d0171997-10-15Fredrik Hübinette (Hubbe)  switch(t) {
2eeba91999-03-17Fredrik Hübinette (Hubbe)  case T_FUNCTION: if(attempt_to_identify(a) != T_OBJECT) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Builtin function!\n",indent,"");
2eeba91999-03-17Fredrik Hübinette (Hubbe)  break; }
f6d0171997-10-15Fredrik Hübinette (Hubbe)  case T_OBJECT: p=((struct object *)a)->prog;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Parent identifier: %d\n",indent,"",((struct object *)a)->parent_identifier); fprintf(stderr,"%*s**Program id: %ld\n",indent,"",((struct object *)a)->program_id);
1e4e5f2000-04-07Fredrik Hübinette (Hubbe) 
7bf6232000-04-23Martin Stjernholm  if (((struct object *)a)->next == ((struct object *)a)) fprintf(stderr, "%*s**The object is fake.\n",indent,"");
e2d9e62000-06-10Martin Stjernholm  { struct object *o; for (o = first_object; o && o != (struct object *) a; o = o->next) {} if (!o) fprintf(stderr,"%*s**The object is not on the object link list.\n",indent,""); for (o = objects_to_destruct; o && o != (struct object *) a; o = o->next) {} if (o) fprintf(stderr,"%*s**The object is on objects_to_destruct.\n",indent,""); }
7bf6232000-04-23Martin Stjernholm  if(!p) { fprintf(stderr,"%*s**The object is destructed.\n",indent,""); p=id_to_program(((struct object *)a)->program_id); } if (p) { fprintf(stderr,"%*s**Attempting to describe program object was instantiated from:\n",indent,""); low_describe_something(p, T_PROGRAM, indent, depth, flags); }
8fb1e11998-04-05Fredrik Hübinette (Hubbe)  if( ((struct object *)a)->parent) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Describing object's parent:\n",indent,""); describe_something( ((struct object *)a)->parent, t, indent+2,depth-1, (flags | DESCRIBE_SHORT | DESCRIBE_NO_REFS ) & ~ (DESCRIBE_MEM));
8fb1e11998-04-05Fredrik Hübinette (Hubbe)  }else{
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**There is no parent (any longer?)\n",indent,"");
8fb1e11998-04-05Fredrik Hübinette (Hubbe)  }
7bf6232000-04-23Martin Stjernholm  break;
f6d0171997-10-15Fredrik Hübinette (Hubbe)  case T_PROGRAM:
3568101997-10-16Fredrik Hübinette (Hubbe)  { char *tmp; INT32 line,pos;
2eeba91999-03-17Fredrik Hübinette (Hubbe)  int foo=0;
3568101997-10-16Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Program id: %ld\n",indent,"",(long)(p->id));
e2d9e62000-06-10Martin Stjernholm 
05590d1998-04-23Fredrik Hübinette (Hubbe)  if(p->flags & PROGRAM_HAS_C_METHODS)
f6d0171997-10-15Fredrik Hübinette (Hubbe)  {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**The program was written in C.\n",indent,"");
f6d0171997-10-15Fredrik Hübinette (Hubbe)  }
2eeba91999-03-17Fredrik Hübinette (Hubbe)  for(pos=0;pos<100;pos++)
f6d0171997-10-15Fredrik Hübinette (Hubbe)  {
3568101997-10-16Fredrik Hübinette (Hubbe)  tmp=get_line(p->program+pos, p, &line); if(tmp && line) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Location: %s:%ld\n",indent,"",tmp,(long)line);
2eeba91999-03-17Fredrik Hübinette (Hubbe)  foo=1;
3568101997-10-16Fredrik Hübinette (Hubbe)  break; }
2eeba91999-03-17Fredrik Hübinette (Hubbe)  if(pos+1>=(long)p->num_program) break; } #if 0 if(!foo && p->num_linenumbers>1 && EXTRACT_UCHAR(p->linenumbers)=='\177') {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**From file: %s\n",indent,"",p->linenumbers+1);
2eeba91999-03-17Fredrik Hübinette (Hubbe)  foo=1; } #endif if(!foo) { int e;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**identifiers:\n",indent,"");
2eeba91999-03-17Fredrik Hübinette (Hubbe)  for(e=0;e<p->num_identifier_references;e++)
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**** %s\n",indent,"",ID_FROM_INT(p,e)->name->str);
2eeba91999-03-17Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**num inherits: %d\n",indent,"",p->num_inherits);
f6d0171997-10-15Fredrik Hübinette (Hubbe)  }
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(flags & DESCRIBE_MEM) {
1e4e5f2000-04-07Fredrik Hübinette (Hubbe) #define FOO(NUMTYPE,TYPE,NAME) \
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s* " #NAME " %p[%d]\n",indent,"",p->NAME,p->PIKE_CONCAT(num_,NAME));
1e4e5f2000-04-07Fredrik Hübinette (Hubbe) #include "program_areas.h"
a4033e2000-04-14Fredrik Hübinette (Hubbe)  }
2eeba91999-03-17Fredrik Hübinette (Hubbe) 
f6d0171997-10-15Fredrik Hübinette (Hubbe)  break;
3568101997-10-16Fredrik Hübinette (Hubbe)  }
e2d9e62000-06-10Martin Stjernholm  case T_MULTISET: fprintf(stderr,"%*s**Describing array of multiset:\n",indent,""); debug_dump_array(((struct multiset *)a)->ind); break;
f6d0171997-10-15Fredrik Hübinette (Hubbe)  case T_ARRAY:
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Describing array:\n",indent,"");
f6d0171997-10-15Fredrik Hübinette (Hubbe)  debug_dump_array((struct array *)a); break;
62971d1998-01-19Fredrik Hübinette (Hubbe) 
61e9a01998-01-25Fredrik Hübinette (Hubbe)  case T_MAPPING:
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Describing mapping:\n",indent,"");
1d152d2000-03-07Fredrik Hübinette (Hubbe)  debug_dump_mapping((struct mapping *)a);
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Describing mapping data block:\n",indent,""); describe_something( ((struct mapping *)a)->data, -2, indent+2,depth-1,flags);
61e9a01998-01-25Fredrik Hübinette (Hubbe)  break;
62971d1998-01-19Fredrik Hübinette (Hubbe)  case T_STRING: { struct pike_string *s=(struct pike_string *)a;
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**String length is %d:\n",indent,"",s->len);
62971d1998-01-19Fredrik Hübinette (Hubbe)  if(s->len>77) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s** \"%60s ...\"\n",indent,"",s->str);
62971d1998-01-19Fredrik Hübinette (Hubbe)  }else{
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s** \"%s\"\n",indent,"",s->str);
62971d1998-01-19Fredrik Hübinette (Hubbe)  } break; }
f6d0171997-10-15Fredrik Hübinette (Hubbe)  }
25479a2000-03-07Fredrik Hübinette (Hubbe) }
a4033e2000-04-14Fredrik Hübinette (Hubbe) void describe_something(void *a, int t, int indent, int depth, int flags)
25479a2000-03-07Fredrik Hübinette (Hubbe) {
111fdd2000-04-17Fredrik Hübinette (Hubbe)  int tmp;
25479a2000-03-07Fredrik Hübinette (Hubbe)  struct program *p=(struct program *)a; if(!a) return; if(t==-1) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Location description: %s\n",indent,"",(char *)a);
25479a2000-03-07Fredrik Hübinette (Hubbe)  return; }
111fdd2000-04-17Fredrik Hübinette (Hubbe)  /* Disable debug, this may help reduce recursion bugs */ tmp=d_flag; d_flag=0;
3845452000-03-08Henrik Grubbström (Grubba) #ifdef DEBUG_MALLOC if (((int)a) == 0x55555555) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Location: %p Type: %s Zapped pointer\n",indent,"",a,
3845452000-03-08Henrik Grubbström (Grubba)  get_name_of_type(t)); } else #endif /* DEBUG_MALLOC */ if (((int)a) & 3) {
87c7f92000-04-19Martin Stjernholm  fprintf(stderr,"%*s**Location: %p Type: %s Misaligned address\n",indent,"",a,
3845452000-03-08Henrik Grubbström (Grubba)  get_name_of_type(t)); } else {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Location: %p Type: %s Refs: %d\n",indent,"",a,
3845452000-03-08Henrik Grubbström (Grubba)  get_name_of_type(t), *(INT32 *)a); }
25479a2000-03-07Fredrik Hübinette (Hubbe)  #ifdef DEBUG_MALLOC
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(!(flags & DESCRIBE_NO_DMALLOC)) debug_malloc_dump_references(a,indent+2,depth-1,flags);
25479a2000-03-07Fredrik Hübinette (Hubbe) #endif
87c7f92000-04-19Martin Stjernholm  low_describe_something(a,t,indent,depth,flags);
25479a2000-03-07Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s*******************\n",indent,"");
111fdd2000-04-17Fredrik Hübinette (Hubbe)  d_flag=tmp;
8fb1e11998-04-05Fredrik Hübinette (Hubbe) } void describe(void *x) {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  describe_something(x, attempt_to_identify(x), 0, 2, 0);
f6d0171997-10-15Fredrik Hübinette (Hubbe) }
c72a4e1998-12-15Fredrik Hübinette (Hubbe) void debug_describe_svalue(struct svalue *s) { fprintf(stderr,"Svalue at %p is:\n",s); switch(s->type) { case T_INT: fprintf(stderr," %ld\n",(long)s->u.integer); break; case T_FLOAT: fprintf(stderr," %f\n",s->u.float_number); break;
2eeba91999-03-17Fredrik Hübinette (Hubbe)  case T_FUNCTION: if(s->subtype == FUNCTION_BUILTIN) { fprintf(stderr," Builtin function: %s\n",s->u.efun->name->str); }else{ if(!s->u.object->prog) {
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  struct program *p=id_to_program(s->u.object->program_id); if(p) { fprintf(stderr," Function (destructed) name: %s\n",ID_FROM_INT(p,s->subtype)->name->str); }else{ fprintf(stderr," Function in destructed object.\n"); }
2eeba91999-03-17Fredrik Hübinette (Hubbe)  }else{ fprintf(stderr," Function name: %s\n",ID_FROM_INT(s->u.object->prog,s->subtype)->name->str); } }
c72a4e1998-12-15Fredrik Hübinette (Hubbe)  }
a4033e2000-04-14Fredrik Hübinette (Hubbe)  describe_something(s->u.refs,s->type,0,2,0);
c72a4e1998-12-15Fredrik Hübinette (Hubbe) }
7bf6232000-04-23Martin Stjernholm void debug_gc_touch(void *a) { struct marker *m;
e2d9e62000-06-10Martin Stjernholm  if (!a) fatal("Got null pointer.\n");
7bf6232000-04-23Martin Stjernholm  m = find_marker(a); if (Pike_in_gc == GC_PASS_PRETOUCH) {
e2d9e62000-06-10Martin Stjernholm  if (m) gc_fatal(a, 0, "Object touched twice.\n");
7bf6232000-04-23Martin Stjernholm  get_marker(a)->flags |= GC_TOUCHED; } else if (Pike_in_gc == GC_PASS_POSTTOUCH) { if (m) {
e2d9e62000-06-10Martin Stjernholm  if (!(m->flags & GC_TOUCHED)) gc_fatal(a, 2, "An existing but untouched marker found " "for object in linked lists.\n");
996f872000-06-12Martin Stjernholm  else if (m->flags & (GC_RECURSING|GC_LIVE_RECURSE|GC_DONT_POP| GC_WEAK_REF|GC_STRONG_REF))
e2d9e62000-06-10Martin Stjernholm  gc_fatal(a, 2, "Marker still got flag from recurse list.\n"); else if (m->flags & GC_REFERENCED) return; else if (m->flags & GC_XREFERENCED) gc_fatal(a, 3, "A thing with external references " "got missed by mark pass.\n"); else if (!(m->flags & GC_CYCLE_CHECKED)) gc_fatal(a, 2, "A thing was missed by " "both mark and cycle check pass.\n"); else if (!(m->flags & GC_IS_REFERENCED)) gc_fatal(a, 2, "An unreferenced thing " "got missed by gc_is_referenced().\n"); else if (!(m->flags & GC_DO_FREE)) gc_fatal(a, 2, "An unreferenced thing " "got missed by gc_do_free().\n"); else if (m->flags & GC_GOT_EXTRA_REF) gc_fatal(a, 2, "A thing still got an extra ref.\n");
a595b92000-06-11Martin Stjernholm  else if (m->weak_refs >= m->saved_refs)
e2d9e62000-06-10Martin Stjernholm  gc_fatal(a, 3, "A thing which had only weak references is " "still around after gc.\n"); else if (!(m->flags & GC_LIVE)) gc_fatal(a, 3, "A thing to garb is still around.\n");
7bf6232000-04-23Martin Stjernholm  } } else fatal("debug_gc_touch() used in invalid gc pass.\n"); }
e2d9e62000-06-10Martin Stjernholm static INLINE struct marker *gc_check_debug(void *a)
c94c371996-03-28Fredrik Hübinette (Hubbe) {
7bf6232000-04-23Martin Stjernholm  struct marker *m;
87c7f92000-04-19Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  if (!a) fatal("Got null pointer.\n");
b8a6e71996-09-25Fredrik Hübinette (Hubbe)  if(check_for) { if(check_for == a) { gdb_gc_stop_here(a); }
4a578f1997-01-27Fredrik Hübinette (Hubbe)  return 0;
b8a6e71996-09-25Fredrik Hübinette (Hubbe)  }
e942a72000-04-15Fredrik Hübinette (Hubbe) 
7bf6232000-04-23Martin Stjernholm  if (Pike_in_gc != GC_PASS_CHECK) fatal("gc check attempted in invalid pass.\n"); m = get_marker(a);
87c7f92000-04-19Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  if (!*(INT32 *)a) gc_fatal(a, 1, "GC check on thing without refs.\n"); if(m->saved_refs != -1 && m->saved_refs != *(INT32 *)a) gc_fatal(a, 1, "Refs changed in gc.\n");
e942a72000-04-15Fredrik Hübinette (Hubbe)  m->saved_refs = *(INT32 *)a;
ff322e2000-06-10Martin Stjernholm  if (m->refs + m->xrefs >= *(INT32 *) a) /* m->refs will be incremented by the caller. */ gc_fatal(a, 1, "Thing is getting more internal refs than refs.\n");
e2d9e62000-06-10Martin Stjernholm  checked++; return m; } #endif /* PIKE_DEBUG */ INT32 real_gc_check(void *a) { struct marker *m; #ifdef PIKE_DEBUG if (!(m = gc_check_debug(a))) return 0;
2200002000-04-23Martin Stjernholm #else m = get_marker(a);
b8a6e71996-09-25Fredrik Hübinette (Hubbe) #endif
e2d9e62000-06-10Martin Stjernholm  return add_ref(m); }
e942a72000-04-15Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm INT32 real_gc_check_weak(void *a) { struct marker *m; #ifdef PIKE_DEBUG if (!(m = gc_check_debug(a))) return 0; #else m = get_marker(a); #endif m->weak_refs++;
ff322e2000-06-10Martin Stjernholm #ifdef PIKE_DEBUG if (m->weak_refs > m->refs + 1) gc_fatal(a, 1, "Thing has gotten more weak refs than internal refs.\n");
a595b92000-06-11Martin Stjernholm  if (m->weak_refs == m->saved_refs) weak_freed++;
ff322e2000-06-10Martin Stjernholm #endif
e09ea12000-04-13Fredrik Hübinette (Hubbe)  return add_ref(m);
c94c371996-03-28Fredrik Hübinette (Hubbe) }
b51e6d1998-02-18Fredrik Hübinette (Hubbe) static void init_gc(void) {
424d9c1999-05-02Fredrik Hübinette (Hubbe)  init_marker_hash();
b51e6d1998-02-18Fredrik Hübinette (Hubbe) } static void exit_gc(void) {
424d9c1999-05-02Fredrik Hübinette (Hubbe) #ifdef DO_PIKE_CLEANUP int e=0; struct marker *h; for(e=0;e<marker_hash_table_size;e++) while(marker_hash_table[e]) remove_marker(marker_hash_table[e]->data); #endif exit_marker_hash();
b51e6d1998-02-18Fredrik Hübinette (Hubbe) }
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
b51e6d1998-02-18Fredrik Hübinette (Hubbe) void locate_references(void *a) {
7bf6232000-04-23Martin Stjernholm  int tmp, orig_in_gc = Pike_in_gc;
7506fe2000-04-19Martin Stjernholm  void *orig_check_for=check_for;
6bc62b2000-04-14Martin Stjernholm  if(!Pike_in_gc)
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  init_gc();
7bf6232000-04-23Martin Stjernholm  Pike_in_gc = GC_PASS_LOCATE; /* Disable debug, this may help reduce recursion bugs */ tmp=d_flag; d_flag=0;
06ae272000-04-19Martin Stjernholm 
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  fprintf(stderr,"**Looking for references:\n"); check_for=a;
25d21c1998-02-24Per Hedbor 
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  found_where=" in an array"; gc_check_all_arrays(); found_where=" in a multiset"; gc_check_all_multisets(); found_where=" in a mapping"; gc_check_all_mappings(); found_where=" in a program"; gc_check_all_programs(); found_where=" in an object"; gc_check_all_objects();
20513c2000-04-12Fredrik Hübinette (Hubbe)  #ifdef PIKE_DEBUG if(master_object) gc_external_mark2(master_object,0," &master_object");
5f61da2000-04-13Fredrik Hübinette (Hubbe)  { extern struct mapping *builtin_constants; if(builtin_constants) gc_external_mark2(builtin_constants,0," &builtin_constants"); }
20513c2000-04-12Fredrik Hübinette (Hubbe) #endif
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  found_where=" in a module"; call_callback(& gc_callbacks, (void *)0); found_where="";
7506fe2000-04-19Martin Stjernholm  check_for=orig_check_for;
20513c2000-04-12Fredrik Hübinette (Hubbe)  #ifdef DEBUG_MALLOC { extern void dmalloc_find_references_to(void *); #if 0 fprintf(stderr,"**DMALLOC Looking for references:\n"); dmalloc_find_references_to(a); #endif } #endif
7bf6232000-04-23Martin Stjernholm  Pike_in_gc = orig_in_gc;
6bc62b2000-04-14Martin Stjernholm  if(!Pike_in_gc)
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  exit_gc();
7bf6232000-04-23Martin Stjernholm  d_flag=tmp;
b51e6d1998-02-18Fredrik Hübinette (Hubbe) }
25d21c1998-02-24Per Hedbor #endif
b51e6d1998-02-18Fredrik Hübinette (Hubbe) 
1637c42000-02-01Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm void gc_add_extra_ref(void *a)
c94c371996-03-28Fredrik Hübinette (Hubbe) {
e2d9e62000-06-10Martin Stjernholm  struct marker *m = get_marker(a); if (m->flags & GC_GOT_EXTRA_REF) gc_fatal(a, 0, "Thing already got an extra gc ref.\n"); m->flags |= GC_GOT_EXTRA_REF; gc_extra_refs++; ++*(INT32 *) a; }
1637c42000-02-01Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm void gc_free_extra_ref(void *a) { struct marker *m = get_marker(a); if (!(m->flags & GC_GOT_EXTRA_REF)) gc_fatal(a, 0, "Thing haven't got an extra gc ref.\n"); m->flags &= ~GC_GOT_EXTRA_REF; gc_extra_refs--; } int debug_gc_is_referenced(void *a) { struct marker *m; if (!a) fatal("Got null pointer.\n"); if (Pike_in_gc != GC_PASS_MARK) fatal("gc_is_referenced() called in invalid gc pass.\n");
1422411997-10-13Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  if (gc_debug) { m = find_marker(a); if ((!m || !(m->flags & GC_TOUCHED)) && !safe_debug_findstring((struct pike_string *) a)) gc_fatal(a, 0, "Doing gc_is_referenced() on invalid object.\n"); if (!m) m = get_marker(a);
b8a6e71996-09-25Fredrik Hübinette (Hubbe)  }
e2d9e62000-06-10Martin Stjernholm  else m = get_marker(a);
1637c42000-02-01Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  if (m->flags & GC_IS_REFERENCED) gc_fatal(a, 0, "gc_is_referenced() called twice for thing.\n"); m->flags |= GC_IS_REFERENCED;
c94c371996-03-28Fredrik Hübinette (Hubbe)  return m->refs < *(INT32 *)a; }
20513c2000-04-12Fredrik Hübinette (Hubbe) int gc_external_mark3(void *a, void *in, char *where)
05c7cd1997-07-19Fredrik Hübinette (Hubbe) { struct marker *m;
e2d9e62000-06-10Martin Stjernholm  if (!a) fatal("Got null pointer.\n"); if (Pike_in_gc != GC_PASS_CHECK && Pike_in_gc != GC_PASS_LOCATE) fatal("gc_external_mark() called in invalid gc pass.\n");
7506fe2000-04-19Martin Stjernholm 
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  if(check_for) { if(a==check_for) {
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  char *tmp=found_where;
20513c2000-04-12Fredrik Hübinette (Hubbe)  void *tmp2=found_in; if(where) found_where=where; if(in) found_in=in;
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  gdb_gc_stop_here(a);
20513c2000-04-12Fredrik Hübinette (Hubbe) 
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  found_where=tmp;
20513c2000-04-12Fredrik Hübinette (Hubbe)  found_in=tmp2;
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  return 1; } return 0; }
424d9c1999-05-02Fredrik Hübinette (Hubbe)  m=get_marker(a);
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  m->xrefs++; m->flags|=GC_XREFERENCED;
ff322e2000-06-10Martin Stjernholm  if(m->refs + m->xrefs > *(INT32 *)a || (Pike_in_gc == GC_PASS_CHECK && m->saved_refs != -1 && m->saved_refs != *(INT32 *)a)) gc_fatal(a, 1, "Ref counts are wrong.\n");
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  return 0; }
e2d9e62000-06-10Martin Stjernholm  int gc_do_weak_free(void *a) { struct marker *m;
ff322e2000-06-10Martin Stjernholm  if (!a) fatal("Got null pointer.\n");
e2d9e62000-06-10Martin Stjernholm  if (Pike_in_gc != GC_PASS_MARK && Pike_in_gc != GC_PASS_CYCLE) fatal("gc_do_weak_free() called in invalid gc pass.\n"); if (gc_debug) { if (!(m = find_marker(a))) gc_fatal(a, 0, "gc_do_weak_free() got unknown object.\n"); }
ff322e2000-06-10Martin Stjernholm  else m = get_marker(a);
e2d9e62000-06-10Martin Stjernholm  debug_malloc_touch(a);
ff322e2000-06-10Martin Stjernholm  if (m->weak_refs > m->saved_refs) gc_fatal(a, 0, "More weak references than references.\n");
e2d9e62000-06-10Martin Stjernholm  if (m->weak_refs > m->refs) gc_fatal(a, 0, "More weak references than internal references.\n");
a595b92000-06-11Martin Stjernholm  return m->weak_refs >= *(INT32 *) a;
e2d9e62000-06-10Martin Stjernholm }
05c7cd1997-07-19Fredrik Hübinette (Hubbe) 
ff322e2000-06-10Martin Stjernholm #endif /* PIKE_DEBUG */
c94c371996-03-28Fredrik Hübinette (Hubbe) int gc_mark(void *a) { struct marker *m;
87c7f92000-04-19Martin Stjernholm #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm  if (!a) fatal("Got null pointer.\n");
7bf6232000-04-23Martin Stjernholm  if (Pike_in_gc != GC_PASS_MARK) fatal("gc mark attempted in invalid pass.\n");
87c7f92000-04-19Martin Stjernholm #endif
7bf6232000-04-23Martin Stjernholm  m = get_marker(debug_malloc_pass(a));
c94c371996-03-28Fredrik Hübinette (Hubbe)  if(m->flags & GC_REFERENCED) { return 0; }else{ m->flags |= GC_REFERENCED;
e2d9e62000-06-10Martin Stjernholm  DO_IF_DEBUG(marked++);
c94c371996-03-28Fredrik Hübinette (Hubbe)  return 1; } }
e2d9e62000-06-10Martin Stjernholm #ifdef GC_CYCLE_DEBUG static int gc_cycle_indent = 0;
996f872000-06-12Martin Stjernholm #define CYCLE_DEBUG_MSG(M, TXT) do { \ fprintf(stderr, "%*s%-33s %p [%p] ", gc_cycle_indent, "", \ (TXT), (M)->data, gc_rec_last->data); \ describe_marker(M); \ } while (0) #else #define CYCLE_DEBUG_MSG(M, TXT) do {} while (0)
e2d9e62000-06-10Martin Stjernholm #endif static void break_cycle (struct marker *beg, struct marker *pos) { /* There's a cycle from beg to gc_rec_last which should be broken at
996f872000-06-12Martin Stjernholm  * pos. Do it by switching places of the markers before and after pos. */
e2d9e62000-06-10Martin Stjernholm  struct marker *p, *q;
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(pos, "break_cycle");
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG if (beg == pos) gc_fatal(beg->data, 0, "Cycle already broken at requested position.\n"); #endif
a595b92000-06-11Martin Stjernholm  if (beg->cycle) {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
a595b92000-06-11Martin Stjernholm  if (pos->cycle == beg->cycle || gc_rec_last->cycle == beg->cycle)
bfacd92000-06-10Martin Stjernholm  gc_fatal(pos->data, 0, "Same cycle on both sides of broken link.\n");
e2d9e62000-06-10Martin Stjernholm #endif for (p = &rec_list; p->link->cycle != beg->cycle; p = p->link) {}
996f872000-06-12Martin Stjernholm  beg = p->link;
e2d9e62000-06-10Martin Stjernholm  } else for (p = &rec_list; p->link != beg; p = p->link) {} p->link = pos;
996f872000-06-12Martin Stjernholm  for (p = beg; p->link != pos; p = p->link) {} for (q = pos;; q = q->link) { q->flags |= GC_DONT_POP; CYCLE_DEBUG_MSG(q, "break_cycle, mark for don't pop"); if (q == gc_rec_last) break; } { struct marker *m = q->link; q->link = beg; p->link = m;
e2d9e62000-06-10Martin Stjernholm  } } int gc_cycle_push(void *x, struct marker *m, int weak)
c94c371996-03-28Fredrik Hübinette (Hubbe) {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG if (!x) fatal("Got null pointer.\n"); if (m->data != x) fatal("Got wrong marker.\n"); if (Pike_in_gc != GC_PASS_CYCLE) fatal("GC cycle push attempted in invalid pass.\n"); if (gc_debug && !(m->flags & GC_TOUCHED)) gc_fatal(x, 0, "gc_cycle_push() called for untouched thing.\n"); if (m->flags & (GC_REFERENCED)) gc_fatal(x, 1, "Got a referenced marker to gc_cycle_push.\n"); if (m->flags & GC_XREFERENCED) gc_fatal(x, 1, "Doing cycle check in externally referenced thing " "missed in mark pass.\n"); if (gc_debug) { struct array *a; struct object *o; struct program *p; struct mapping *m; struct multiset *l; for(a = gc_internal_array; a != &empty_array; a = a->next) if(a == (struct array *) x) goto on_gc_internal_lists; for(o = gc_internal_object; o; o = o->next) if(o == (struct object *) x) goto on_gc_internal_lists; for(p = gc_internal_program; p; p = p->next) if(p == (struct program *) x) goto on_gc_internal_lists; for(m = gc_internal_mapping; m; m = m->next) if(m == (struct mapping *) x) goto on_gc_internal_lists; for(l = gc_internal_multiset; l; l = l->next) if(l == (struct multiset *) x) goto on_gc_internal_lists; gc_fatal(x, 0, "gc_cycle_check() called for thing not on gc_internal lists.\n"); on_gc_internal_lists: } #endif
11649a2000-04-14Henrik Grubbström (Grubba) 
e2d9e62000-06-10Martin Stjernholm  if (gc_rec_last->flags & GC_LIVE_RECURSE) { #ifdef PIKE_DEBUG if (!(gc_rec_last->flags & GC_LIVE)) gc_fatal(x, 0, "Doing live recursion from a dead thing.\n"); #endif
1637c42000-02-01Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  if (m->flags & GC_CYCLE_CHECKED) { if (!(m->flags & GC_LIVE)) { /* Only recurse through things already handled; we'll get to the * other later in the normal recursion. */ #ifdef PIKE_DEBUG if (m->flags & GC_LIVE_RECURSE) gc_fatal(x, 0, "Mark live recursion attempted twice into thing.\n"); #endif goto live_recurse; }
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, no live recurse");
e2d9e62000-06-10Martin Stjernholm  } else { /* Nothing more to do. Unwind the live recursion. */ int flags;
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, live rec done");
e2d9e62000-06-10Martin Stjernholm  do { gc_rec_last->flags &= ~GC_LIVE_RECURSE; #ifdef GC_CYCLE_DEBUG gc_cycle_indent -= 2;
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(gc_rec_last, "gc_cycle_push, unwinding live");
e2d9e62000-06-10Martin Stjernholm #endif gc_rec_last = (struct marker *) dequeue_lifo(&gc_mark_queue, (queue_call) gc_set_rec_last); #ifdef PIKE_DEBUG if (!gc_rec_last) fatal("Expected a gc_set_rec_last entry in gc_mark_queue.\n"); #endif } while (gc_rec_last->flags & GC_LIVE_RECURSE);
996f872000-06-12Martin Stjernholm  if (!dequeue_lifo(&gc_mark_queue, (queue_call) gc_cycle_pop)) {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
996f872000-06-12Martin Stjernholm  fatal("Expected a gc_cycle_pop entry in gc_mark_queue.\n");
e2d9e62000-06-10Martin Stjernholm #endif } } return 0; }
a595b92000-06-11Martin Stjernholm #ifdef PIKE_DEBUG if (weak < 0 && gc_rec_last->flags & GC_FOLLOWED_NONSTRONG) gc_fatal(x, 0, "Followed strong link too late.\n"); if (weak >= 0) gc_rec_last->flags |= GC_FOLLOWED_NONSTRONG; #endif
e2d9e62000-06-10Martin Stjernholm  if (m->flags & GC_RECURSING) { /* A cycle is found. */ if (m != gc_rec_last) { struct marker *p, *weak_ref = 0, *nonstrong_ref = 0; if (!weak) { struct marker *q; for (q = m, p = m->link; p; q = p, p = p->link) { if (p->flags & (GC_WEAK_REF|GC_STRONG_REF)) { if (p->flags & GC_WEAK_REF) weak_ref = p; else if (!nonstrong_ref) nonstrong_ref = q; } if (p == gc_rec_last) break; } } else if (weak < 0) { for (p = m->link; p; p = p->link) { if (p->flags & GC_WEAK_REF) weak_ref = p; if (!(p->flags & GC_STRONG_REF)) nonstrong_ref = p; if (p == gc_rec_last) break; } #ifdef PIKE_DEBUG if (!nonstrong_ref) gc_fatal(x, 0, "Only strong links in cycle.\n"); #endif } else { struct marker *q; for (q = m, p = m->link; p; q = p, p = p->link) { if (!(p->flags & GC_WEAK_REF) && !nonstrong_ref) nonstrong_ref = q; if (p == gc_rec_last) break; } }
996f872000-06-12Martin Stjernholm  if (p == gc_rec_last) { /* It was a backward reference. */
e2d9e62000-06-10Martin Stjernholm  if (weak_ref) { /* The backward link is normal or strong and there are one * or more weak links in the cycle. Let's break it at the * last one (to ensure that a sequence of several weak links * are broken at the last one). */
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, weak break");
e2d9e62000-06-10Martin Stjernholm  break_cycle (m, weak_ref); } else if (weak < 0) { /* The backward link is strong. Must break the cycle at the * last nonstrong link. */
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, nonstrong break");
e2d9e62000-06-10Martin Stjernholm  break_cycle (m, nonstrong_ref); if (m->flags & GC_STRONG_REF) nonstrong_ref->flags |= GC_STRONG_REF; } else if (nonstrong_ref) { /* Either a nonweak cycle with a strong link in it or a weak * cycle with a nonweak link in it. Break before the first * link that's stronger than the others. */ if (nonstrong_ref != m) {
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, weaker break");
e2d9e62000-06-10Martin Stjernholm  break_cycle (m, nonstrong_ref); } } else { /* A normal or weak cycle which will be destructed in * arbitrary order. */ unsigned cycle = m->cycle ? m->cycle : ++last_cycle;
996f872000-06-12Martin Stjernholm  if (cycle == gc_rec_last->cycle) CYCLE_DEBUG_MSG(m, "gc_cycle_push, old cycle"); else { CYCLE_DEBUG_MSG(m, "gc_cycle_push, cycle"); for (p = m;; p = p->link) { p->cycle = cycle; CYCLE_DEBUG_MSG(p, "gc_cycle_push, mark cycle"); if (p == gc_rec_last) break; }}}} /* Mmm.. lisp ;) */ else { /* A forward reference. */ /* It might be a reference to a marker that has been swapped * further down the list by break_cycle(). In that case we * must mark this path to stay on the list. */ CYCLE_DEBUG_MSG(m, "gc_cycle_push, forward ref"); for (p = rec_list.link; !(p->flags & GC_DONT_POP); p = p->link) if (p == gc_rec_last) goto dont_stay_on_list; for (;; p = p->link) { p->flags |= GC_DONT_POP; CYCLE_DEBUG_MSG(p, "gc_cycle_push, mark for don't pop"); if (p == gc_rec_last) break; } dont_stay_on_list: } } }
e2d9e62000-06-10Martin Stjernholm  else if (!(m->flags & GC_CYCLE_CHECKED)) { struct marker *p; m->flags |= gc_rec_last->flags & GC_LIVE; if (weak) { if (weak > 0) m->flags |= GC_WEAK_REF; else m->flags |= GC_STRONG_REF; } #ifdef PIKE_DEBUG cycle_checked++; if (m->flags & GC_LIVE_RECURSE) gc_fatal(x, 0, "GC_LIVE_RECURSE set in normal recursion.\n"); #endif
996f872000-06-12Martin Stjernholm  p = gc_rec_last; if (gc_rec_last->cycle) for (; p->link && p->link->cycle == gc_rec_last->cycle; p = p->link) {} m->link = p->link;
e2d9e62000-06-10Martin Stjernholm  p->link = m;
996f872000-06-12Martin Stjernholm  m->flags |= GC_CYCLE_CHECKED|GC_RECURSING; m->cycle = 0;
e2d9e62000-06-10Martin Stjernholm  #ifdef GC_CYCLE_DEBUG
996f872000-06-12Martin Stjernholm  if (weak > 0) CYCLE_DEBUG_MSG(m, "gc_cycle_push, recurse weak"); else if (weak < 0) CYCLE_DEBUG_MSG(m, "gc_cycle_push, recurse strong"); else CYCLE_DEBUG_MSG(m, "gc_cycle_push, recurse");
e2d9e62000-06-10Martin Stjernholm  gc_cycle_indent += 2; #endif gc_rec_last = m; return 1; } /* Should normally not recurse now, but got to do that anyway if we * must mark live things. */ if (!(gc_rec_last->flags & GC_LIVE) || m->flags & GC_LIVE) {
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, no recurse");
e2d9e62000-06-10Martin Stjernholm  return 0; } live_recurse: #ifdef PIKE_DEBUG if (m->flags & GC_LIVE) fatal("Shouldn't live recurse when there's nothing to do.\n"); #endif m->flags |= GC_LIVE|GC_LIVE_RECURSE; if (m->flags & GC_GOT_DEAD_REF) { /* A thing previously popped as dead is now being marked live. * Have to remove the extra ref added by gc_cycle_pop(). */ gc_free_extra_ref(x); if (!--*(INT32 *) x) { #ifdef PIKE_DEBUG gc_fatal(x, 0, "Thing got zero refs after removing the dead gc ref.\n"); #endif } } /* Recurse without linking m onto rec_list. */ #ifdef GC_CYCLE_DEBUG
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, live recurse");
e2d9e62000-06-10Martin Stjernholm  gc_cycle_indent += 2; #endif gc_rec_last = m; return 1; }
bfacd92000-06-10Martin Stjernholm /* Add an extra ref when a dead thing is popped. It's taken away in * the free pass. This is done to not refcount garb the cycles * themselves recursively, which in bad cases can consume a lot of C * stack. */ #define ADD_REF_IF_DEAD(M) \ if (!(M->flags & GC_LIVE)) { \ DO_IF_DEBUG( \ if (M->flags & GC_GOT_DEAD_REF) \ gc_fatal(M->data, 0, "A thing already got an extra dead cycle ref.\n"); \ ); \ gc_add_extra_ref(M->data); \ M->flags |= GC_GOT_DEAD_REF; \ }
996f872000-06-12Martin Stjernholm void gc_cycle_pop(void *a)
e2d9e62000-06-10Martin Stjernholm {
996f872000-06-12Martin Stjernholm  struct marker *m = find_marker(a), *p, *q;
e2d9e62000-06-10Martin Stjernholm  #ifdef PIKE_DEBUG if (Pike_in_gc != GC_PASS_CYCLE) fatal("GC cycle pop attempted in invalid pass.\n"); if (!(m->flags & GC_CYCLE_CHECKED)) gc_fatal(a, 0, "Marker being popped doesn't have GC_CYCLE_CHECKED.\n"); if (m->flags & (GC_REFERENCED)) gc_fatal(a, 1, "Got a referenced marker to gc_cycle_pop.\n"); if (m->flags & GC_XREFERENCED) gc_fatal(a, 1, "Doing cycle check in externally referenced thing " "missed in mark pass.\n"); #endif #ifdef GC_CYCLE_DEBUG gc_cycle_indent -= 2; #endif
a595b92000-06-11Martin Stjernholm  if (!(m->flags & GC_RECURSING) || m->flags & GC_LIVE_RECURSE) {
e2d9e62000-06-10Martin Stjernholm  m->flags &= ~GC_LIVE_RECURSE;
996f872000-06-12Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_pop, pop ignored"); return;
e2d9e62000-06-10Martin Stjernholm  } #ifdef PIKE_DEBUG
bfacd92000-06-10Martin Stjernholm  if (m->flags & GC_GOT_DEAD_REF) gc_fatal(a, 0, "Didn't expect a dead extra ref.\n");
e2d9e62000-06-10Martin Stjernholm #endif
996f872000-06-12Martin Stjernholm  if (m->flags & GC_DONT_POP) { CYCLE_DEBUG_MSG(m, "gc_cycle_pop, keep on stack"); return;
e2d9e62000-06-10Martin Stjernholm  }
996f872000-06-12Martin Stjernholm  q = gc_rec_last; while (1) { p = q->link;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
996f872000-06-12Martin Stjernholm  if (p->flags & GC_LIVE_RECURSE) gc_fatal(p->data, 0, "Marker still got GC_LIVE_RECURSE at pop.\n");
e2d9e62000-06-10Martin Stjernholm #endif
996f872000-06-12Martin Stjernholm  if (!p->cycle && !(p->flags & GC_LIVE_OBJ)) { ADD_REF_IF_DEAD(p); p->flags &= ~(GC_RECURSING|GC_DONT_POP|GC_WEAK_REF|GC_STRONG_REF); q->link = p->link; DO_IF_DEBUG(p->link = (struct marker *) -1); CYCLE_DEBUG_MSG(p, "gc_cycle_pop, pop off");
e2d9e62000-06-10Martin Stjernholm  }
996f872000-06-12Martin Stjernholm  else { p->flags &= ~(GC_DONT_POP|GC_WEAK_REF|GC_STRONG_REF); q = p; } if (p == m) break;
e2d9e62000-06-10Martin Stjernholm  }
996f872000-06-12Martin Stjernholm  if (gc_rec_last != q) { if (!q->cycle || gc_rec_last->cycle != q->cycle) { /* If the thing(s) are part of a cycle that we aren't leaving, * we let them stay on the list so the whole cycle is popped at * once. Otherwise it's time to move live objects to the kill * list. */ struct marker *base; #ifdef PIKE_DEBUG int cycle = q->cycle; #endif base = gc_rec_last; if (gc_rec_last->cycle) for (; base->link->cycle == gc_rec_last->cycle; base = base->link) {} q = base; while ((p = q->link)) { #ifdef PIKE_DEBUG if (p->cycle && cycle && p->cycle != cycle) gc_fatal(p->data, 0, "Popping more than one cycle from rec_list.\n"); if (!(p->flags & GC_RECURSING)) gc_fatal(p->data, 0, "Marker being cycle popped doesn't have GC_RECURSING.\n"); if (p->flags & GC_GOT_DEAD_REF) gc_fatal(p->data, 0, "Didn't expect a dead extra ref.\n");
e2d9e62000-06-10Martin Stjernholm #endif
996f872000-06-12Martin Stjernholm  p->flags &= ~GC_RECURSING; if (p->flags & GC_LIVE_OBJ) { /* This extra ref is taken away in the kill pass. */ gc_add_extra_ref(p->data); q = p; CYCLE_DEBUG_MSG(p, "gc_cycle_pop, put on kill list"); } else { ADD_REF_IF_DEAD(p); q->link = p->link; DO_IF_DEBUG(p->link = (struct marker *) -1); CYCLE_DEBUG_MSG(p, "gc_cycle_pop, cycle pop off"); } } q->link = kill_list; kill_list = base->link; base->link = p; } else CYCLE_DEBUG_MSG(m, "gc_cycle_pop, keep in cycle");
8fb1e11998-04-05Fredrik Hübinette (Hubbe)  }
e2d9e62000-06-10Martin Stjernholm } void gc_set_rec_last(struct marker *m) { gc_rec_last = m; } void do_gc_recurse_svalues(struct svalue *s, int num) { gc_recurse_svalues(s, num); }
1637c42000-02-01Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm void do_gc_recurse_short_svalue(union anything *u, TYPE_T type) { gc_recurse_short_svalue(u, type);
c94c371996-03-28Fredrik Hübinette (Hubbe) }
e2d9e62000-06-10Martin Stjernholm  int gc_do_free(void *a) { struct marker *m; #ifdef PIKE_DEBUG if (!a) fatal("Got null pointer.\n"); if (Pike_in_gc != GC_PASS_FREE) fatal("gc free attempted in invalid pass.\n"); #endif m=find_marker(debug_malloc_pass(a)); if (!m) return 0; /* Object created after cycle pass. */ #ifdef PIKE_DEBUG if (m->flags & GC_REFERENCED) gc_fatal(a, 0, "gc_do_free() called for referenced thing.\n"); if (gc_debug && (m->flags & (GC_TOUCHED|GC_REFERENCED|GC_IS_REFERENCED)) == GC_TOUCHED) gc_fatal(a, 0, "gc_do_free() called without prior call to " "gc_mark() or gc_is_referenced().\n"); if((m->flags & (GC_REFERENCED|GC_XREFERENCED)) == GC_XREFERENCED) gc_fatal(a, 1, "Thing with external reference missed in gc mark pass.\n"); if ((m->flags & (GC_DO_FREE|GC_LIVE)) == GC_LIVE) live_ref++; m->flags |= GC_DO_FREE;
1637c42000-02-01Fredrik Hübinette (Hubbe) #endif
c94c371996-03-28Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  return !(m->flags & (GC_REFERENCED|GC_LIVE)); } static void warn_bad_cycles() { JMP_BUF uwp; struct array *obj_arr = 0; if (!SETJMP(uwp)) { struct marker *p; unsigned cycle = 0; obj_arr = allocate_array(0); for (p = kill_list; p;) { if ((cycle = p->cycle)) { push_object((struct object *) p->data); obj_arr = append_array(obj_arr, --sp); } p = p->link; if (p ? p->cycle != cycle : cycle) { if (obj_arr->size >= 2) { push_constant_text("gc"); push_constant_text("bad_cycle"); push_array(obj_arr); SAFE_APPLY_MASTER("runtime_warning", 3); pop_stack(); obj_arr = allocate_array(0); } else obj_arr = resize_array(obj_arr, 0); } if (!p) break; } } UNSETJMP(uwp); if (obj_arr) free_array(obj_arr); } int do_gc(void)
6930181996-02-25Fredrik Hübinette (Hubbe) { double tmp;
e2d9e62000-06-10Martin Stjernholm  int objs, pre_kill_objs;
dc296b1997-10-21Fredrik Hübinette (Hubbe)  double multiplier;
e2d9e62000-06-10Martin Stjernholm  struct array *a; struct multiset *l; struct mapping *m; struct program *p; struct object *o;
db62dc2000-04-14Martin Stjernholm #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm #ifdef HAVE_GETHRTIME
6bc62b2000-04-14Martin Stjernholm  hrtime_t gcstarttime;
b088ab2000-04-15Martin Stjernholm #endif
e2d9e62000-06-10Martin Stjernholm  unsigned destroy_count, obj_count;
db62dc2000-04-14Martin Stjernholm #endif
6930181996-02-25Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  if(Pike_in_gc) return 0;
7bf6232000-04-23Martin Stjernholm  init_gc(); Pike_in_gc=GC_PASS_PREPARE; #ifdef PIKE_DEBUG gc_debug = d_flag; #endif
890e5b1996-11-21Fredrik Hübinette (Hubbe) 
7f9b4c2000-04-19Martin Stjernholm  destruct_objects_to_destruct();
e78abd1996-11-21Fredrik Hübinette (Hubbe)  if(gc_evaluator_callback) { remove_callback(gc_evaluator_callback); gc_evaluator_callback=0; }
890e5b1996-11-21Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  objs=num_objects; last_cycle = 0;
6930181996-02-25Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm  if(GC_VERBOSE_DO(1 ||) t_flag) {
6930181996-02-25Fredrik Hübinette (Hubbe)  fprintf(stderr,"Garbage collecting ... ");
e2d9e62000-06-10Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "\n"));
b088ab2000-04-15Martin Stjernholm #ifdef HAVE_GETHRTIME
6bc62b2000-04-14Martin Stjernholm  gcstarttime = gethrtime();
b088ab2000-04-15Martin Stjernholm #endif
6bc62b2000-04-14Martin Stjernholm  }
06983f1996-09-22Fredrik Hübinette (Hubbe)  if(num_objects < 0) fatal("Panic, less than zero objects!\n");
6930181996-02-25Fredrik Hübinette (Hubbe) #endif
4452c12000-02-02Fredrik Hübinette (Hubbe)  last_gc=TIME(0);
dc296b1997-10-21Fredrik Hübinette (Hubbe)  multiplier=pow(MULTIPLIER, (double) num_allocs / (double) alloc_threshold); objects_alloced*=multiplier;
6930181996-02-25Fredrik Hübinette (Hubbe)  objects_alloced += (double) num_allocs;
dc296b1997-10-21Fredrik Hübinette (Hubbe)  objects_freed*=multiplier;
c94c371996-03-28Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  /* Thread switches, object alloc/free and any reference changes * (except by the gc itself) are disallowed now. */
08679c2000-04-26Martin Stjernholm 
7bf6232000-04-23Martin Stjernholm #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm  weak_freed = checked = marked = cycle_checked = live_ref = 0;
7bf6232000-04-23Martin Stjernholm  if (gc_debug) {
e2d9e62000-06-10Martin Stjernholm  unsigned n;
7bf6232000-04-23Martin Stjernholm  Pike_in_gc = GC_PASS_PRETOUCH; n = gc_touch_all_arrays(); n += gc_touch_all_multisets(); n += gc_touch_all_mappings(); n += gc_touch_all_programs(); n += gc_touch_all_objects();
e2d9e62000-06-10Martin Stjernholm  if (n != (unsigned) num_objects)
7bf6232000-04-23Martin Stjernholm  fatal("Object count wrong before gc; expected %d, got %d.\n", num_objects, n);
e2d9e62000-06-10Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| pretouch: %u things\n", n));
7bf6232000-04-23Martin Stjernholm  } #endif
c94c371996-03-28Fredrik Hübinette (Hubbe) 
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_CHECK;
a991451997-07-08Fredrik Hübinette (Hubbe)  /* First we count internal references */
6930181996-02-25Fredrik Hübinette (Hubbe)  gc_check_all_arrays();
06983f1996-09-22Fredrik Hübinette (Hubbe)  gc_check_all_multisets();
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_check_all_mappings();
6930181996-02-25Fredrik Hübinette (Hubbe)  gc_check_all_programs(); gc_check_all_objects();
20513c2000-04-12Fredrik Hübinette (Hubbe)  #ifdef PIKE_DEBUG if(master_object) gc_external_mark2(master_object,0," &master_object");
5f61da2000-04-13Fredrik Hübinette (Hubbe)  { extern struct mapping *builtin_constants; if(builtin_constants) gc_external_mark2(builtin_constants,0," &builtin_constants"); }
20513c2000-04-12Fredrik Hübinette (Hubbe) #endif
7bf6232000-04-23Martin Stjernholm  /* These callbacks are mainly for the check pass, but can also * do things that are normally associated with the mark pass
5fbe6e2000-04-14Fredrik Hübinette (Hubbe)  */
4a578f1997-01-27Fredrik Hübinette (Hubbe)  call_callback(& gc_callbacks, (void *)0);
c94c371996-03-28Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| check: %u references checked\n", checked));
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_MARK;
e2d9e62000-06-10Martin Stjernholm  /* Anything after and including gc_internal_foo in the linked lists * are considered to lack external references. The mark pass move * externally referenced things in front of these pointers. */ gc_internal_array = empty_array.next; gc_internal_multiset = first_multiset; gc_internal_mapping = first_mapping; gc_internal_program = first_program; gc_internal_object = first_object;
a991451997-07-08Fredrik Hübinette (Hubbe)  /* Next we mark anything with external references */
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_mark_all_arrays();
991e5a1998-04-28Fredrik Hübinette (Hubbe)  run_queue(&gc_mark_queue);
06983f1996-09-22Fredrik Hübinette (Hubbe)  gc_mark_all_multisets();
991e5a1998-04-28Fredrik Hübinette (Hubbe)  run_queue(&gc_mark_queue);
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_mark_all_mappings();
991e5a1998-04-28Fredrik Hübinette (Hubbe)  run_queue(&gc_mark_queue);
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_mark_all_programs();
991e5a1998-04-28Fredrik Hübinette (Hubbe)  run_queue(&gc_mark_queue);
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_mark_all_objects();
991e5a1998-04-28Fredrik Hübinette (Hubbe)  run_queue(&gc_mark_queue);
e2d9e62000-06-10Martin Stjernholm /* if(gc_debug) */ /* gc_mark_all_strings(); */ GC_VERBOSE_DO(fprintf(stderr, "| mark: %u markers referenced,\n" "| %u weak references freed, %d things really freed\n", marked, weak_freed, objs - num_objects));
c94c371996-03-28Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  Pike_in_gc=GC_PASS_CYCLE; #ifdef PIKE_DEBUG obj_count = num_objects; #endif
4a578f1997-01-27Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  /* Now find all cycles in the internal structures */ /* Note: The order between types here is normally not significant, * but the permuting destruct order tests in the testsuite won't be * really effective unless objects are handled first. :P */ gc_cycle_check_all_objects(); gc_cycle_check_all_arrays(); gc_cycle_check_all_multisets(); gc_cycle_check_all_mappings(); gc_cycle_check_all_programs();
08679c2000-04-26Martin Stjernholm 
20513c2000-04-12Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm  if (gc_mark_queue.first) fatal("gc_mark_queue not empty at end of cycle check pass.\n"); if (rec_list.link || gc_rec_last != &rec_list) fatal("Recurse list not empty or inconsistent after cycle check pass.\n");
20513c2000-04-12Fredrik Hübinette (Hubbe) #endif
e2d9e62000-06-10Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| cycle: %u internal things visited, %u cycle ids used,\n" "| %u weak references freed, %d things really freed\n", cycle_checked, last_cycle, weak_freed, obj_count - num_objects)); /* Thread switches, object alloc/free and reference changes are * allowed again now. */
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_FREE;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG weak_freed = 0; obj_count = num_objects; #endif
a991451997-07-08Fredrik Hübinette (Hubbe)  /* Now we free the unused stuff */
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_free_all_unreferenced_arrays();
06983f1996-09-22Fredrik Hübinette (Hubbe)  gc_free_all_unreferenced_multisets();
c94c371996-03-28Fredrik Hübinette (Hubbe)  gc_free_all_unreferenced_mappings(); gc_free_all_unreferenced_programs();
e2d9e62000-06-10Martin Stjernholm  gc_free_all_unreferenced_objects(); GC_VERBOSE_DO(fprintf(stderr, "| free: %d really freed, %u left with live references\n", obj_count - num_objects, live_ref)); gc_internal_array = &empty_array; gc_internal_multiset = 0; gc_internal_mapping = 0; gc_internal_program = 0; gc_internal_object = 0;
c94c371996-03-28Fredrik Hübinette (Hubbe) 
20513c2000-04-12Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
ad2bdb2000-04-12Fredrik Hübinette (Hubbe)  if(fatal_after_gc) fatal(fatal_after_gc);
20513c2000-04-12Fredrik Hübinette (Hubbe) #endif
e2d9e62000-06-10Martin Stjernholm  Pike_in_gc=GC_PASS_KILL; /* Destruct the live objects in cycles, but first warn about any bad * cycles. */ pre_kill_objs = num_objects; if (last_cycle) { objs -= num_objects; warn_bad_cycles(); objs += num_objects; } #ifdef PIKE_DEBUG destroy_count = 0; #endif for (; kill_list; kill_list = kill_list->link) { struct object *o = (struct object *) kill_list->data; #ifdef PIKE_DEBUG if ((kill_list->flags & (GC_LIVE|GC_LIVE_OBJ)) != (GC_LIVE|GC_LIVE_OBJ)) gc_fatal(o, 0, "Invalid thing in kill list.\n"); #endif GC_VERBOSE_DO(fprintf(stderr, "| Killing %p with %d refs\n", o, o->refs)); destruct(o); free_object(o); gc_free_extra_ref(o); #ifdef PIKE_DEBUG destroy_count++; #endif } GC_VERBOSE_DO(fprintf(stderr, "| kill: %u objects killed, %d things really freed\n", destroy_count, pre_kill_objs - num_objects));
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_DESTRUCT;
e2d9e62000-06-10Martin Stjernholm  /* Destruct objects on the destruct queue. */ GC_VERBOSE_DO(obj_count = num_objects);
7bf6232000-04-23Martin Stjernholm  destruct_objects_to_destruct();
e2d9e62000-06-10Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| destruct: %d things really freed\n", obj_count - num_objects));
08679c2000-04-26Martin Stjernholm 
7bf6232000-04-23Martin Stjernholm #ifdef PIKE_DEBUG if (gc_debug) {
e2d9e62000-06-10Martin Stjernholm  unsigned n;
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_POSTTOUCH; n = gc_touch_all_arrays(); n += gc_touch_all_multisets(); n += gc_touch_all_mappings(); n += gc_touch_all_programs(); n += gc_touch_all_objects();
e2d9e62000-06-10Martin Stjernholm  if (n != (unsigned) num_objects)
7bf6232000-04-23Martin Stjernholm  fatal("Object count wrong after gc; expected %d, got %d.\n", num_objects, n);
e2d9e62000-06-10Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| posttouch: %u things\n", n));
7bf6232000-04-23Martin Stjernholm  if(fatal_after_gc) fatal(fatal_after_gc); }
e2d9e62000-06-10Martin Stjernholm  if (gc_extra_refs) fatal("Lost track of %d extra refs to things in gc.\n", gc_extra_refs);
7bf6232000-04-23Martin Stjernholm #endif Pike_in_gc=0;
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  exit_gc();
06983f1996-09-22Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  /* It's possible that more things got allocated in the kill pass * than were freed. The count before that is a better measurement * then. */ if (pre_kill_objs < num_objects) objs -= pre_kill_objs; else objs -= num_objects; objects_freed += (double) objs;
6930181996-02-25Fredrik Hübinette (Hubbe)  tmp=(double)num_objects; tmp=tmp * GC_CONST/100.0 * (objects_alloced+1.0) / (objects_freed+1.0);
6acd502000-05-01Fredrik Noring  if(alloc_threshold + num_allocs <= tmp) tmp = (double)(alloc_threshold + num_allocs); if(tmp < MIN_ALLOC_THRESHOLD) tmp = (double)MIN_ALLOC_THRESHOLD; if(tmp > MAX_ALLOC_THRESHOLD) tmp = (double)MAX_ALLOC_THRESHOLD; alloc_threshold = (int)tmp;
6930181996-02-25Fredrik Hübinette (Hubbe)  num_allocs=0;
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
e2d9e62000-06-10Martin Stjernholm  if(GC_VERBOSE_DO(1 ||) t_flag)
a4033e2000-04-14Fredrik Hübinette (Hubbe)  { #ifdef HAVE_GETHRTIME
6bc62b2000-04-14Martin Stjernholm  fprintf(stderr,"done (freed %ld of %ld objects), %ld ms.\n",
e2d9e62000-06-10Martin Stjernholm  (long)objs,(long)objs + num_objects,
a4033e2000-04-14Fredrik Hübinette (Hubbe)  (long)((gethrtime() - gcstarttime)/1000000));
b088ab2000-04-15Martin Stjernholm #else
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"done (freed %ld of %ld objects)\n",
e2d9e62000-06-10Martin Stjernholm  (long)objs,(long)objs + num_objects);
b088ab2000-04-15Martin Stjernholm #endif
a4033e2000-04-14Fredrik Hübinette (Hubbe)  }
6930181996-02-25Fredrik Hübinette (Hubbe) #endif
a29e021996-10-15Fredrik Hübinette (Hubbe) 
bf45771996-12-05Fredrik Hübinette (Hubbe) #ifdef ALWAYS_GC
890e5b1996-11-21Fredrik Hübinette (Hubbe)  ADD_GC_CALLBACK(); #else
bf45771996-12-05Fredrik Hübinette (Hubbe)  if(d_flag > 3) ADD_GC_CALLBACK();
a29e021996-10-15Fredrik Hübinette (Hubbe) #endif
e2d9e62000-06-10Martin Stjernholm  return objs;
6930181996-02-25Fredrik Hübinette (Hubbe) }
1637c42000-02-01Fredrik Hübinette (Hubbe) void f__gc_status(INT32 args) { pop_n_elems(args); push_constant_text("num_objects"); push_int(num_objects); push_constant_text("num_allocs"); push_int(num_allocs); push_constant_text("alloc_threshold"); push_int(alloc_threshold); push_constant_text("objects_alloced"); push_int(objects_alloced); push_constant_text("objects_freed"); push_int(objects_freed); push_constant_text("last_gc"); push_int(last_gc); push_constant_text("projected_garbage"); push_float(objects_freed * (double) num_allocs / (double) alloc_threshold); f_aggregate_mapping(14); }