e576bb2002-10-11Martin Nilsson /* || This file is part of Pike. For copyright information see COPYRIGHT. || Pike is distributed under GPL, LGPL and MPL. See the file COPYING || for more information.
28a9672004-09-30Martin Stjernholm || $Id: gc.c,v 1.261 2004/09/30 12:12:10 mast Exp $
e576bb2002-10-11Martin Nilsson */
aedfb12002-10-09Martin Nilsson 
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"
b2d3e42000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
9aa6fa1997-05-19Fredrik Hübinette (Hubbe) #include "pike_memory.h"
1a11681997-10-06Fredrik Hübinette (Hubbe) #include "pike_macros.h"
51adb82003-01-12Martin Stjernholm #include "pike_rusage.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"
132f0d2000-08-13Henrik Grubbström (Grubba) #include "bignum.h"
cd9aec2003-02-09Martin Stjernholm #include "pike_threadlib.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"
51adb82003-01-12Martin Stjernholm int gc_enabled = 1;
51955c2003-01-11Martin Stjernholm 
51adb82003-01-12Martin Stjernholm /* These defaults are only guesses and hardly tested at all. Please improve. */ double gc_garbage_ratio_low = 0.2; double gc_time_ratio = 0.05; double gc_garbage_ratio_high = 0.5;
51955c2003-01-11Martin Stjernholm 
51adb82003-01-12Martin Stjernholm /* This slowness factor approximately corresponds to the average over * the last ten gc rounds. (0.9 == 1 - 1/10) */ double gc_average_slowness = 0.9;
51955c2003-01-11Martin Stjernholm 
3aab372002-11-24Martin Stjernholm #define GC_LINK_CHUNK_SIZE 64
e2d9e62000-06-10Martin Stjernholm  /* 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
22aa2f2000-09-04Martin Stjernholm  * object before all children have been destructed.)
e2d9e62000-06-10Martin Stjernholm  * * 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
22aa2f2000-09-04Martin Stjernholm  * to save them 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.
e2d9e62000-06-10Martin Stjernholm  *
10c4a42000-08-17Martin Stjernholm  * Things that have only weak external references at the start of the * gc pass will be freed. That's done before the live object destruct * pass. Internal weak references are however still intact.
79566d2004-03-15Martin Stjernholm  * * Note: Keep the doc for lfun::destroy up-to-date with the above.
e2d9e62000-06-10Martin Stjernholm  */
d9dd812000-06-12Martin Stjernholm /* #define GC_VERBOSE */ /* #define GC_CYCLE_DEBUG */
e2d9e62000-06-10Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm /* #define GC_STACK_DEBUG */
e2d9e62000-06-10Martin Stjernholm #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) 
5272b22004-09-22Martin Stjernholm int num_objects = 2; /* Account for *_empty_array. */
88ef972004-03-19Martin Stjernholm ALLOC_COUNT_TYPE num_allocs =0; ALLOC_COUNT_TYPE alloc_threshold = GC_MIN_ALLOC_THRESHOLD;
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT int Pike_in_gc = 0;
9a6d002001-06-26Fredrik Hübinette (Hubbe) int gc_generation = 0;
0d9f932003-01-14Martin Stjernholm time_t last_gc;
50d97a2003-02-01Martin Stjernholm int gc_trace = 0, gc_debug = 0;
57cfbd2004-03-15Martin Stjernholm #ifdef DO_PIKE_CLEANUP int gc_destruct_everything = 0; #endif
4452c12000-02-02Fredrik Hübinette (Hubbe) 
45d87e2000-07-18Martin Stjernholm struct gc_frame { struct gc_frame *back; /* Previous stack frame. */ void *data; union { struct { /* Pop frame. */ struct gc_frame *prev; /* Previous frame in rec_list. */ struct gc_frame *next; /* Next pointer in rec_list and kill_list. */ unsigned INT16 cycle; /* Cycle id number. */ } pop; struct { /* Link frame. */ gc_cycle_check_cb *checkfn; int weak; } link;
b351292001-08-20Martin Stjernholm  int free_extra_type; /* Used on free_extra_list. The type of the thing. */
45d87e2000-07-18Martin Stjernholm  } u; unsigned INT16 frameflags; }; #define GC_POP_FRAME 0x01 #define GC_WEAK_REF 0x02 #define GC_STRONG_REF 0x04 #define GC_OFF_STACK 0x08
0db2c02003-02-14Martin Stjernholm #define GC_ON_KILL_LIST 0x10
45d87e2000-07-18Martin Stjernholm #ifdef PIKE_DEBUG
0db2c02003-02-14Martin Stjernholm #define GC_LINK_FREED 0x20 #define GC_FOLLOWED_NONSTRONG 0x40
45d87e2000-07-18Martin Stjernholm #endif #undef BLOCK_ALLOC_NEXT #define BLOCK_ALLOC_NEXT back BLOCK_ALLOC(gc_frame,GC_LINK_CHUNK_SIZE) #define PREV(frame) ((frame)->u.pop.prev) #define NEXT(frame) ((frame)->u.pop.next) #define CYCLE(frame) ((frame)->u.pop.cycle) #ifdef PIKE_DEBUG #define CHECK_POP_FRAME(frame) do { \ if ((frame)->frameflags & GC_LINK_FREED) \ gc_fatal((frame)->data, 0, "Accessing freed gc_frame.\n"); \ if (!((frame)->frameflags & GC_POP_FRAME)) \ gc_fatal((frame)->data, 0, #frame " is not a pop frame.\n"); \ if (NEXT(PREV(frame)) != (frame)) \ gc_fatal((frame)->data, 0, \ "Pop frame pointers are inconsistent.\n"); \ } while (0) #else #define CHECK_POP_FRAME(frame) do {} while (0) #endif static struct gc_frame rec_list = {0, 0, {{0, 0, 0}}, GC_POP_FRAME}; static struct gc_frame *gc_rec_last = &rec_list, *gc_rec_top = 0; static struct gc_frame *kill_list = 0;
fcb3222001-07-05Martin Stjernholm static struct gc_frame *free_extra_list = 0; /* See note in gc_delayed_free. */
45d87e2000-07-18Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm static unsigned last_cycle;
6d30f52000-07-11Martin Stjernholm size_t gc_ext_weak_refs;
6930181996-02-25Fredrik Hübinette (Hubbe) 
45d87e2000-07-18Martin Stjernholm /* gc_frame objects are used as frames in a recursion stack during the * cycle check pass. gc_rec_top points to the current top of the * stack. When a thing is recursed, a pop frame is first pushed on the * stack and then the gc_cycle_check_* function fills in with link * frames for every reference the thing contains.
996f872000-06-12Martin Stjernholm  *
45d87e2000-07-18Martin Stjernholm  * rec_list is a double linked list of the pop frames on the stack, * and that list represents the current prospective destruct order. * gc_rec_last points at the last frame in the list and new frames are * linked in after it. A cycle is always treated as one atomic unit,
43c7782003-03-30Martin Stjernholm  * i.e. it's either popped whole or not at all. That means that
0db2c02003-02-14Martin Stjernholm  * rec_list might contain frames that are no longer on the stack.
996f872000-06-12Martin Stjernholm  *
0db2c02003-02-14Martin Stjernholm  * A range of frames which always ends at the end of the list may be
45d87e2000-07-18Martin Stjernholm  * rotated a number of slots to break a cyclic reference at a chosen * point. The stack of link frames are rotated simultaneously. * * Frames for live objects are linked into the beginning of kill_list
996f872000-06-12Martin Stjernholm  * when they're popped from rec_list. * * The cycle check functions might recurse another round through the
45d87e2000-07-18Martin Stjernholm  * frames that have been recursed already, to propagate the GC_LIVE
996f872000-06-12Martin Stjernholm  * 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;
51adb82003-01-12Martin Stjernholm static double gc_time = 0.0, non_gc_time = 0.0;
5ef9052003-01-13Martin Stjernholm static cpu_time_t last_gc_end_time = 0;
9699fc2003-02-10Martin Stjernholm #if CPU_TIME_IS_THREAD_LOCAL == PIKE_NO
f4a9952003-02-08Martin Stjernholm cpu_time_t auto_gc_time = 0; #endif
51adb82003-01-12Martin Stjernholm  /* These are only collected for the sake of gc_status. */ static double last_garbage_ratio = 0.0; static enum { GARBAGE_RATIO_LOW, GARBAGE_RATIO_HIGH } last_garbage_strategy = GARBAGE_RATIO_LOW;
6930181996-02-25Fredrik Hübinette (Hubbe) 
4a578f1997-01-27Fredrik Hübinette (Hubbe) struct callback_list gc_callbacks;
0305412003-09-29Martin Stjernholm /* These callbacks are run early in the check pass of the gc and when * locate_references is called. They are typically used to mark * external references (using gc_mark_external) for debug purposes. */
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); }
1e91212001-07-05Martin Stjernholm static void init_gc(void);
45d87e2000-07-18Martin Stjernholm static void gc_cycle_pop(void *a); #undef BLOCK_ALLOC_NEXT #define BLOCK_ALLOC_NEXT next
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; \
0816292000-07-03Martin Stjernholm  (X)->saved_refs=-1; \
45d87e2000-07-18Martin Stjernholm  (X)->frame = 0;
424d9c1999-05-02Fredrik Hübinette (Hubbe) #else
e2d9e62000-06-10Martin Stjernholm #define INIT_BLOCK(X) \
45d87e2000-07-18Martin Stjernholm  (X)->flags=(X)->refs=(X)->weak_refs=0; \ (X)->frame = 0;
05c7cd1997-07-19Fredrik Hübinette (Hubbe) #endif
c94c371996-03-28Fredrik Hübinette (Hubbe) 
22aa2f2000-09-04Martin Stjernholm #ifdef PIKE_DEBUG #undef get_marker #define get_marker debug_get_marker #undef find_marker #define find_marker debug_find_marker #endif
3aab372002-11-24Martin Stjernholm PTR_HASH_ALLOC_FIXED_FILL_PAGES(marker,2)
c94c371996-03-28Fredrik Hübinette (Hubbe) 
e1a35e2003-09-08Martin Stjernholm #if defined (PIKE_DEBUG) || defined (GC_MARK_DEBUG) void *gc_found_in = NULL; int gc_found_in_type = PIKE_T_UNKNOWN; const char *gc_found_place = NULL; #endif
3b65672004-05-23Martin Nilsson #ifdef DO_PIKE_CLEANUP /* To keep the markers after the gc. Only used for the leak report at exit. */ int gc_keep_markers = 0; int gc_external_refs_zapped = 0; #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) 
22aa2f2000-09-04Martin Stjernholm #undef get_marker #define get_marker(X) ((struct marker *) debug_malloc_pass(debug_get_marker(X))) #undef find_marker #define find_marker(X) ((struct marker *) debug_malloc_pass(debug_find_marker(X)))
e2d9e62000-06-10Martin Stjernholm int gc_in_cycle_check = 0;
d9d6f02001-06-30Martin Stjernholm static unsigned delayed_freed, weak_freed, checked, marked, cycle_checked, live_ref;
8e6d5c2001-07-02Martin Stjernholm static unsigned max_gc_frames, num_gc_frames = 0, live_rec, frame_rot;
e2d9e62000-06-10Martin Stjernholm static unsigned gc_extra_refs = 0;
8e6d5c2001-07-02Martin Stjernholm static unsigned max_tot_gc_frames = 0; static unsigned tot_cycle_checked = 0, tot_live_rec = 0, tot_frame_rot = 0;
1e91212001-07-05Martin Stjernholm static int gc_is_watching = 0;
e1a35e2003-09-08Martin Stjernholm int attempt_to_identify(void *something, void **inblock)
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) {
60c15a2003-08-20Martin Stjernholm  size_t i;
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  struct array *a; struct object *o; struct program *p;
62971d1998-01-19Fredrik Hübinette (Hubbe)  struct mapping *m; struct multiset *mu;
60c15a2003-08-20Martin Stjernholm  struct pike_type *t; struct callable *c;
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) 
b351292001-08-20Martin Stjernholm  if (inblock) *inblock = 0;
cd451f2004-03-15Martin Stjernholm  for (a = first_array; a; a = a->next) {
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  if(a==(struct array *)something) return T_ARRAY;
cd451f2004-03-15Martin Stjernholm  }
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) 
b351292001-08-20Martin Stjernholm  for(o=first_object;o;o=o->next) {
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  if(o==(struct object *)something) return T_OBJECT;
b351292001-08-20Martin Stjernholm  if (o->storage && o->prog && (char *) something >= o->storage && (char *) something < o->storage + o->prog->storage_needed) { if (inblock) *inblock = (void *) o; return T_STORAGE; } }
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) 
55530f2000-09-30Martin Stjernholm  for(p=first_program;p;p=p->next)
1ca3ba1997-10-13Fredrik Hübinette (Hubbe)  if(p==(struct program *)something) return T_PROGRAM;
55530f2000-09-30Martin Stjernholm  for(m=first_mapping;m;m=m->next)
62971d1998-01-19Fredrik Hübinette (Hubbe)  if(m==(struct mapping *)something) return T_MAPPING;
22aa2f2000-09-04Martin Stjernholm  else if (m->data == (struct mapping_data *) something) return T_MAPPING_DATA;
62971d1998-01-19Fredrik Hübinette (Hubbe) 
55530f2000-09-30Martin Stjernholm  for(mu=first_multiset;mu;mu=mu->next)
62971d1998-01-19Fredrik Hübinette (Hubbe)  if(mu==(struct multiset *)something) return T_MULTISET;
5b15bb2001-12-10Martin Stjernholm  else if (mu->msd == (struct multiset_data *) something) return T_MULTISET_DATA;
62971d1998-01-19Fredrik Hübinette (Hubbe)  if(safe_debug_findstring((struct pike_string *)something)) return T_STRING;
4fab5f2004-04-18Martin Stjernholm  if (pike_type_hash) for (i = 0; i < pike_type_hash_size; i++) for (t = pike_type_hash[i]; t; t = t->next) if (t == (struct pike_type *) something) return T_TYPE;
60c15a2003-08-20Martin Stjernholm  for (c = first_callable; c; c = c->next) if (c == (struct callable *) something) return T_STRUCT_CALLABLE;
04966d2000-10-03Fredrik Hübinette (Hubbe)  return PIKE_T_UNKNOWN;
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) }
20513c2000-04-12Fredrik Hübinette (Hubbe) void *check_for =0;
f6d0171997-10-15Fredrik Hübinette (Hubbe) void *gc_svalue_location=0;
884c122004-03-15Martin Stjernholm static size_t found_ref_count;
06ae272000-04-19Martin Stjernholm char *fatal_after_gc=0;
ad2bdb2000-04-12Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe) #define DESCRIBE_MEM 1 #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,
b351292001-08-20Martin Stjernholm  int type,
a4033e2000-04-14Fredrik Hübinette (Hubbe)  void *location, int indent, int depth, int flags)
3568101997-10-16Fredrik Hübinette (Hubbe) {
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  struct program *p;
b351292001-08-20Martin Stjernholm  void *memblock=0, *descblock, *inblock;
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) 
b351292001-08-20Martin Stjernholm  if(type!=-1 && real_memblock != (void *) -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
04966d2000-10-03Fredrik Hübinette (Hubbe)  if(type==PIKE_T_UNKNOWN)
b351292001-08-20Martin Stjernholm  type=attempt_to_identify(memblock, &inblock);
20513c2000-04-12Fredrik Hübinette (Hubbe)  if(memblock)
e1be4f2001-07-01Martin Stjernholm  fprintf(stderr,"%*s-> from %s %p offset %"PRINTPTRDIFFT"d\n",
a4033e2000-04-14Fredrik Hübinette (Hubbe)  indent,"",
20513c2000-04-12Fredrik Hübinette (Hubbe)  get_name_of_type(type), memblock,
e1be4f2001-07-01Martin Stjernholm  (char *)location - (char *)memblock);
20513c2000-04-12Fredrik Hübinette (Hubbe)  else
d9d6f02001-06-30Martin Stjernholm  fprintf(stderr,"%*s-> at location %p%s\n",
a4033e2000-04-14Fredrik Hübinette (Hubbe)  indent,"",
d9d6f02001-06-30Martin Stjernholm  location, real_memblock == (void *) -1 ? "" : " in unknown memblock (mmaped?)");
20513c2000-04-12Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  again:
d9d6f02001-06-30Martin Stjernholm  descblock = memblock;
62971d1998-01-19Fredrik Hübinette (Hubbe)  switch(type)
3568101997-10-16Fredrik Hübinette (Hubbe)  {
04966d2000-10-03Fredrik Hübinette (Hubbe)  case PIKE_T_UNKNOWN:
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  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: {
9c815b2000-08-10Henrik Grubbström (Grubba)  ptrdiff_t 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) 
f3c7152001-04-14Fredrik Hübinette (Hubbe)  if(location == (void *)&p->parent) fprintf(stderr,"%*s **In p->parent\n",indent,"");
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(p->inherits && ptr >= (char *)p->inherits &&
f00c362000-08-10Henrik Grubbström (Grubba)  ptr < (char*)(p->inherits+p->num_inherits))
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  {
f00c362000-08-10Henrik Grubbström (Grubba)  e=((char *)ptr - (char *)(p->inherits)) / sizeof(struct inherit);
e1be4f2001-07-01Martin Stjernholm  fprintf(stderr,"%*s **In p->inherits[%"PRINTPTRDIFFT"d] (%s)\n",indent,"", 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 &&
f00c362000-08-10Henrik Grubbström (Grubba)  ptr < (char*)(p->constants+p->num_constants))
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  {
f00c362000-08-10Henrik Grubbström (Grubba)  e = ((char *)ptr - (char *)(p->constants)) /
9c815b2000-08-10Henrik Grubbström (Grubba)  sizeof(struct program_constant);
4ea54f2004-05-29Henrik Grubbström (Grubba) #if 0
e1be4f2001-07-01Martin Stjernholm  fprintf(stderr,"%*s **In p->constants[%"PRINTPTRDIFFT"d] (%s)\n",indent,"", e, p->constants[e].name ? p->constants[e].name->str : "no name");
4ea54f2004-05-29Henrik Grubbström (Grubba) #else /* !0 */ fprintf(stderr,"%*s **In p->constants[%"PRINTPTRDIFFT"d] (%d)\n",indent,"", e, p->constants[e].offset); #endif /* 0 */
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 &&
f00c362000-08-10Henrik Grubbström (Grubba)  ptr < (char*)(p->identifiers+p->num_identifiers))
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  {
f00c362000-08-10Henrik Grubbström (Grubba)  e = ((char *)ptr - (char *)(p->identifiers)) /
9c815b2000-08-10Henrik Grubbström (Grubba)  sizeof(struct identifier);
074d0a2001-02-27Fredrik Hübinette (Hubbe) 
e1be4f2001-07-01Martin Stjernholm  fprintf(stderr,"%*s **In p->identifiers[%"PRINTPTRDIFFT"d] (%s)\n",indent,"", e, p->identifiers[e].name ?
074d0a2001-02-27Fredrik Hübinette (Hubbe)  (strlen(p->identifiers[e].name->str)<100 ? p->identifiers[e].name->str : "Name too long or already freed.." ) : "no name");
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  }
7e877a2003-04-02Martin Stjernholm #define FOO(NUMTYPE,TYPE,ARGTYPE,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))) \
e1be4f2001-07-01Martin Stjernholm  fprintf(stderr,"%*s **In p->" #NAME "[%"PRINTPTRDIFFT"d]\n",indent,"", \
7e877a2003-04-02Martin Stjernholm  ((char *)ptr - (char *)(p->NAME)) / sizeof(TYPE));
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)  }
b351292001-08-20Martin Stjernholm 
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;
f3c7152001-04-14Fredrik Hübinette (Hubbe)  if(o->prog && o->prog->flags & PROGRAM_USES_PARENT) { if(location == (void *)&PARENT_INFO(o)->parent) fprintf(stderr,"%*s **In o->parent\n",indent,""); }
a4033e2000-04-14Fredrik Hübinette (Hubbe)  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);
0305412003-09-29Martin Stjernholm  if(tmp.name && !tmp.name->size_shift)
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  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)  }
b351292001-08-20Martin Stjernholm  case T_STORAGE: fprintf(stderr, "%*s **In storage of object\n", indent, ""); break;
5b15bb2001-12-10Martin Stjernholm  case T_MULTISET: descblock = ((struct multiset *) memblock)->msd; /* FALL THROUGH */ case T_MULTISET_DATA: { struct multiset_data *msd = (struct multiset_data *) descblock; union msnode *node = low_multiset_first (msd); struct svalue ind; int indval = msd->flags & MULTISET_INDVAL; for (; node; node = low_multiset_next (node)) { if (&node->i.ind == (struct svalue *) location) { fprintf (stderr, "%*s **In index ", indent, ""); print_svalue (stderr, low_use_multiset_index (node, ind)); fputc ('\n', stderr); break; } else if (indval && &node->iv.val == (struct svalue *) location) { fprintf(stderr, "%*s **In value with index ", indent, ""); print_svalue(stderr, low_use_multiset_index (node, ind)); fputc('\n', stderr); break; } } break; }
62971d1998-01-19Fredrik Hübinette (Hubbe)  case T_ARRAY: {
d9d6f02001-06-30Martin Stjernholm  struct array *a=(struct array *)descblock;
62971d1998-01-19Fredrik Hübinette (Hubbe)  struct svalue *s=(struct svalue *)location;
d5dcf32001-09-10Fredrik Hübinette (Hubbe)  if(location == (void *)&a->next) fprintf(stderr,"%*s **In a->next\n",indent,""); if(location == (void *)&a->prev) fprintf(stderr,"%*s **In a->prev\n",indent,""); if( s-ITEM(a) > 0) fprintf(stderr,"%*s **In index number %"PRINTPTRDIFFT"d\n",indent,"", s-ITEM(a));
dfe8f32000-04-26Fredrik Hübinette (Hubbe)  break;
62971d1998-01-19Fredrik Hübinette (Hubbe)  }
d9d6f02001-06-30Martin Stjernholm  case T_MAPPING: descblock = ((struct mapping *) memblock)->data; /* FALL THROUGH */ case T_MAPPING_DATA: { INT32 e; struct keypair *k; NEW_MAPPING_LOOP((struct mapping_data *) descblock) if (&k->ind == (struct svalue *) location) { fprintf(stderr, "%*s **In index ", indent, ""); print_svalue(stderr, &k->ind); fputc('\n', stderr); break; } else if (&k->val == (struct svalue *) location) { fprintf(stderr, "%*s **In value with index ", indent, ""); print_svalue(stderr, &k->ind); fputc('\n', stderr); break; } break; }
f2bfde2003-09-24Martin Stjernholm  case T_PIKE_FRAME: { struct pike_frame *f = (struct pike_frame *) descblock; if (f->locals) { /* Paranoia. */ ptrdiff_t pos = (struct svalue *) location - f->locals; if (pos >= 0) { if (pos < f->num_args) fprintf (stderr, "%*s **In argument %"PRINTPTRDIFFT"d\n", indent, "", pos); else fprintf (stderr, "%*s **At position %"PRINTPTRDIFFT"d among locals\n", indent, "", pos - f->num_args);
79566d2004-03-15Martin Stjernholm  /* Don't describe current_object for the frame. */ flags |= DESCRIBE_SHORT;
f2bfde2003-09-24Martin Stjernholm  } } break; }
3568101997-10-16Fredrik Hübinette (Hubbe)  }
dfe8f32000-04-26Fredrik Hübinette (Hubbe) 
d9d6f02001-06-30Martin Stjernholm  if(memblock && depth>0)
c905ff2003-09-24Martin Stjernholm  describe_something(memblock,type,indent+2,depth-1,flags,inblock);
d9d6f02001-06-30Martin Stjernholm 
57a4362000-04-27Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC
dc4d8c2000-08-11Henrik Grubbström (Grubba)  /* FIXME: Is the following call correct? * Shouldn't the second argument be an offset? */
e743b72001-08-31Martin Stjernholm  /* dmalloc_describe_location(descblock, location, indent); */ /* My attempt to fix it, although I'm not really sure: /mast */ if (memblock) dmalloc_describe_location(memblock, (char *) location - (char *) memblock, indent);
57a4362000-04-27Fredrik Hübinette (Hubbe) #endif
3568101997-10-16Fredrik Hübinette (Hubbe) }
45d87e2000-07-18Martin Stjernholm static void describe_gc_frame(struct gc_frame *l) { if (l->frameflags & GC_POP_FRAME) fprintf(stderr, "back=%p, prev=%p, next=%p, data=%p, cycle=%u, flags=0x%02x", l->back, PREV(l), NEXT(l), l->data, CYCLE(l), l->frameflags); else fprintf(stderr, "LINK back=%p, data=%p, weak=%d, flags=0x%02x", l->back, l->data, l->u.link.weak, l->frameflags); }
e2d9e62000-06-10Martin Stjernholm static void describe_marker(struct marker *m) {
45d87e2000-07-18Martin Stjernholm  if (m) {
1e91212001-07-05Martin Stjernholm  fprintf(stderr, "marker at %p: flags=0x%05lx, refs=%d, weak=%d, "
45d87e2000-07-18Martin Stjernholm  "xrefs=%d, saved=%d, frame=%p",
1e91212001-07-05Martin Stjernholm  m, (long) m->flags, m->refs, m->weak_refs,
45d87e2000-07-18Martin Stjernholm  m->xrefs, m->saved_refs, m->frame); #ifdef PIKE_DEBUG if (m->frame) { fputs(" [", stderr); describe_gc_frame(m->frame); putc(']', stderr); } #endif putc('\n', stderr); }
e2d9e62000-06-10Martin Stjernholm  else fprintf(stderr, "no marker\n"); }
50d97a2003-02-01Martin Stjernholm #endif /* PIKE_DEBUG */
e2d9e62000-06-10Martin Stjernholm void debug_gc_fatal(void *a, int flags, const char *fmt, ...) {
1e0b962003-05-12Martin Nilsson #ifdef PIKE_DEBUG
56252f2001-06-28Fredrik Hübinette (Hubbe)  struct marker *m;
1e0b962003-05-12Martin Nilsson #endif
1d938c2001-04-18Martin Stjernholm  int orig_gc_pass = Pike_in_gc;
e2d9e62000-06-10Martin Stjernholm  va_list args; va_start(args, fmt); fprintf(stderr, "**"); (void) VFPRINTF(stderr, fmt, args);
f129fd2002-05-15Henrik Grubbström (Grubba)  va_end(args);
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
8ed8dc2001-07-01Martin Stjernholm  if (a) { /* Temporarily jumping out of gc to avoid being catched in debug * checks in describe(). */ Pike_in_gc = 0; describe(a);
56252f2001-06-28Fredrik Hübinette (Hubbe) 
8ed8dc2001-07-01Martin Stjernholm  if (flags & 1) locate_references(a);
56252f2001-06-28Fredrik Hübinette (Hubbe) 
8ed8dc2001-07-01Martin Stjernholm  m=find_marker(a); if(m) { fprintf(stderr,"** Describing marker for this thing.\n"); describe(m); }else{ fprintf(stderr,"** No marker found for this thing.\n"); } Pike_in_gc = orig_gc_pass;
56252f2001-06-28Fredrik Hübinette (Hubbe)  }
8ed8dc2001-07-01Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  if (flags & 2) fatal_after_gc = "Fatal in garbage collector.\n"; else
50d97a2003-02-01Martin Stjernholm #endif
e2d9e62000-06-10Martin Stjernholm  debug_fatal("Fatal in garbage collector.\n"); }
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
0816292000-07-03Martin Stjernholm static void gdb_gc_stop_here(void *a, int weak)
b8a6e71996-09-25Fredrik Hübinette (Hubbe) {
884c122004-03-15Martin Stjernholm  found_ref_count++;
1a12e82000-09-30Martin Stjernholm  fprintf(stderr,"***One %sref found%s. ",
0816292000-07-03Martin Stjernholm  weak ? "weak " : "",
e1a35e2003-09-08Martin Stjernholm  gc_found_place ? gc_found_place : ""); if (gc_found_in) {
5d01dd2001-07-11Martin Stjernholm  if (gc_svalue_location)
79566d2004-03-15Martin Stjernholm  describe_location(gc_found_in , gc_found_in_type, gc_svalue_location,0,1, DESCRIBE_SHORT);
5d01dd2001-07-11Martin Stjernholm  else { fputc('\n', stderr);
79566d2004-03-15Martin Stjernholm  describe_something(gc_found_in, gc_found_in_type, 0, 0, DESCRIBE_SHORT, 0);
5d01dd2001-07-11Martin Stjernholm  }
d9d6f02001-06-30Martin Stjernholm  }
a7078c2001-09-06Martin Stjernholm  else fputc('\n', stderr);
20513c2000-04-12Fredrik Hübinette (Hubbe)  fprintf(stderr,"----------end------------\n");
b8a6e71996-09-25Fredrik Hübinette (Hubbe) }
f6d0171997-10-15Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe) void low_describe_something(void *a, int t, int indent, int depth,
b351292001-08-20Martin Stjernholm  int flags, void *inblock)
f6d0171997-10-15Fredrik Hübinette (Hubbe) { struct program *p=(struct program *)a;
0816292000-07-03Martin Stjernholm  struct marker *m;
f6d0171997-10-15Fredrik Hübinette (Hubbe) 
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(depth<0) return;
c0df092001-06-29Martin Stjernholm  if (marker_hash_table && (m = find_marker(a))) {
0816292000-07-03Martin Stjernholm  fprintf(stderr,"%*s**Got gc ",indent,""); describe_marker(m); }
b351292001-08-20Martin Stjernholm again:
f6d0171997-10-15Fredrik Hübinette (Hubbe)  switch(t) {
b351292001-08-20Martin Stjernholm  case T_STORAGE: if (!inblock) attempt_to_identify (a, &a); t = T_OBJECT; goto again;
2eeba91999-03-17Fredrik Hübinette (Hubbe)  case T_FUNCTION:
b351292001-08-20Martin Stjernholm  if(attempt_to_identify(a, 0) != T_OBJECT)
2eeba91999-03-17Fredrik Hübinette (Hubbe)  {
a4033e2000-04-14Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Builtin function!\n",indent,"");
2eeba91999-03-17Fredrik Hübinette (Hubbe)  break; }
b351292001-08-20Martin Stjernholm  /* FALL THROUGH */
2eeba91999-03-17Fredrik Hübinette (Hubbe) 
f6d0171997-10-15Fredrik Hübinette (Hubbe)  case T_OBJECT: p=((struct object *)a)->prog;
f3c7152001-04-14Fredrik Hübinette (Hubbe)  if(p && (p->flags & PROGRAM_USES_PARENT)) { fprintf(stderr,"%*s**Parent identifier: %d\n",indent,"",PARENT_INFO( ((struct object *)a) )->parent_identifier); }
c8eea52003-08-02Martin Stjernholm  fprintf(stderr,"%*s**Program id: %d\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) { p=id_to_program(((struct object *)a)->program_id);
8e5a402004-03-16Martin Stjernholm  if(p) fprintf(stderr,"%*s**The object is destructed but program found from id.\n", indent,""); else fprintf(stderr,"%*s**The object is destructed and program not found from id.\n", indent,"");
7bf6232000-04-23Martin Stjernholm  }
5a484d2003-09-09Martin Stjernholm 
3eed602004-04-18Martin Stjernholm  if (((struct object *) a)->refs > 0 && p) {
5a484d2003-09-09Martin Stjernholm  size_t inh_idx, var_idx, var_count = 0; fprintf (stderr, "%*s**Object variables:\n", indent, ""); for (inh_idx = 0; inh_idx < p->num_inherits; inh_idx++) { struct inherit *inh = p->inherits + inh_idx; struct program *p2 = inh->prog; if (inh->inherit_level) { if (inh->name) { fprintf (stderr, "%*s**%*s=== In inherit ", indent, "", inh->inherit_level + 1, "");
f189372004-04-03Martin Stjernholm  print_short_svalue (stderr, (union anything *) &inh->name, T_STRING);
5a484d2003-09-09Martin Stjernholm  fprintf (stderr, ", program %d:\n", inh->prog->id); } else fprintf (stderr, "%*s**%*s=== In nameless inherit, program %d:\n", indent, "", inh->inherit_level + 1, "", inh->prog->id); } for (var_idx = 0; var_idx < p2->num_variable_index; var_idx++) { struct identifier *id = p2->identifiers + p2->variable_index[var_idx]; void *ptr; fprintf (stderr, "%*s**%*srtt: %-8s name: ", indent, "", inh->inherit_level + 1, "", get_name_of_type (id->run_time_type));
99cee92004-04-03Martin Stjernholm  if (id->name->size_shift)
f189372004-04-03Martin Stjernholm  print_short_svalue (stderr, (union anything *) &id->name, T_STRING);
5a484d2003-09-09Martin Stjernholm  else fprintf (stderr, "%-20s", id->name->str); fprintf (stderr, " off: %4"PRINTPTRDIFFT"d value: ", inh->storage_offset + id->func.offset); ptr = PIKE_OBJ_STORAGE ((struct object *) a) + inh->storage_offset + id->func.offset; if (id->run_time_type == T_MIXED)
99cee92004-04-03Martin Stjernholm  print_svalue_compact (stderr, (struct svalue *) ptr);
5a484d2003-09-09Martin Stjernholm  else
99cee92004-04-03Martin Stjernholm  print_short_svalue_compact (stderr, (union anything *) ptr, id->run_time_type);
5a484d2003-09-09Martin Stjernholm  fputc ('\n', stderr); var_count++; } } if (!var_count) fprintf (stderr, "%*s** (none)\n", indent, "");
60c15a2003-08-20Martin Stjernholm  fprintf(stderr,"%*s**Describing program %p of object:\n",indent,"", p);
505e3e2000-09-30Martin Stjernholm #ifdef DEBUG_MALLOC if ((int) p == 0x55555555)
728b232000-09-30Martin Stjernholm  fprintf(stderr, "%*s**Zapped program pointer.\n", indent, "");
505e3e2000-09-30Martin Stjernholm  else #endif
c905ff2003-09-24Martin Stjernholm  low_describe_something(p, T_PROGRAM, indent, depth,
22415d2003-09-24Martin Stjernholm  depth ? flags : flags | DESCRIBE_SHORT, 0);
7bf6232000-04-23Martin Stjernholm 
5a484d2003-09-09Martin Stjernholm  if((p->flags & PROGRAM_USES_PARENT) && LOW_PARENT_INFO(((struct object *)a),p)->parent) { if (depth) { fprintf(stderr,"%*s**Describing parent of object:\n",indent,""); describe_something( PARENT_INFO((struct object *)a)->parent, T_OBJECT, indent+2, depth-1,
22415d2003-09-24Martin Stjernholm  (flags | DESCRIBE_SHORT) & ~DESCRIBE_MEM,
5a484d2003-09-09Martin Stjernholm  0); } else fprintf (stderr, "%*s**Object got a parent.\n", indent, ""); }else{ fprintf(stderr,"%*s**There is no parent (any longer?)\n",indent,""); }
8fb1e11998-04-05Fredrik Hübinette (Hubbe)  }
7bf6232000-04-23Martin Stjernholm  break;
22aa2f2000-09-04Martin Stjernholm 
f6d0171997-10-15Fredrik Hübinette (Hubbe)  case T_PROGRAM:
3568101997-10-16Fredrik Hübinette (Hubbe)  {
376e472001-09-10Fredrik Hübinette (Hubbe)  char *tmp;
b13ee62001-06-30Martin Stjernholm  INT32 line;
5a484d2003-09-09Martin Stjernholm  ptrdiff_t id_idx, id_count = 0; struct inherit *inh = p->inherits, *next_inh = p->inherits + 1; ptrdiff_t inh_id_end = p->num_identifier_references;
3568101997-10-16Fredrik Hübinette (Hubbe) 
a6c6a12003-08-02Martin Stjernholm  fprintf(stderr,"%*s**Program id: %ld, flags: %x, parent id: %d\n", indent,"", (long)(p->id), p->flags, p->parent ? p->parent->id : -1);
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)  }
50edc82001-07-13Henrik Grubbström (Grubba) 
e0cbd32003-03-29Martin Stjernholm  tmp = low_get_program_line_plain(p, &line, 1); if (tmp) {
50edc82001-07-13Henrik Grubbström (Grubba)  fprintf(stderr,"%*s**Location: %s:%ld\n",
376e472001-09-10Fredrik Hübinette (Hubbe)  indent, "", tmp, (long)line);
e0cbd32003-03-29Martin Stjernholm  free (tmp);
2eeba91999-03-17Fredrik Hübinette (Hubbe)  }
3eed602004-04-18Martin Stjernholm  if (!(flags & DESCRIBE_SHORT) && p->refs > 0) {
c905ff2003-09-24Martin Stjernholm  fprintf (stderr, "%*s**Identifiers:\n", indent, "");
5a484d2003-09-09Martin Stjernholm 
c905ff2003-09-24Martin Stjernholm  for (id_idx = 0; id_idx < p->num_identifier_references; id_idx++) { struct reference *id_ref = p->identifier_references + id_idx; struct inherit *id_inh; struct identifier *id; const char *type; char prot[100], descr[120]; while (next_inh < p->inherits + p->num_inherits && id_idx == next_inh->identifier_level) { inh = next_inh++; inh_id_end = inh->identifier_level + inh->prog->num_identifier_references; if (inh->name) { fprintf (stderr, "%*s**%*s=== In inherit ", indent, "", inh->inherit_level + 1, "");
f189372004-04-03Martin Stjernholm  print_short_svalue (stderr, (union anything *) &inh->name, T_STRING);
c905ff2003-09-24Martin Stjernholm  fprintf (stderr, ", program %d:\n", inh->prog->id); } else fprintf (stderr, "%*s**%*s=== In nameless inherit, program %d:\n", indent, "", inh->inherit_level + 1, "", inh->prog->id);
5a484d2003-09-09Martin Stjernholm  }
c905ff2003-09-24Martin Stjernholm  while (id_idx == inh_id_end) { int cur_lvl = inh->inherit_level; if (inh->name) { fprintf (stderr, "%*s**%*s=== End of inherit ", indent, "", inh->inherit_level + 1, "");
f189372004-04-03Martin Stjernholm  print_short_svalue (stderr, (union anything *) &inh->name, T_STRING);
c905ff2003-09-24Martin Stjernholm  fputc ('\n', stderr); } else fprintf (stderr, "%*s**%*s=== End of nameless inherit\n", indent, "", inh->inherit_level + 1, ""); while (inh > p->inherits) { /* Paranoia. */ if ((--inh)->inherit_level < cur_lvl) break; } inh_id_end = inh->identifier_level + inh->prog->num_identifier_references;
5a484d2003-09-09Martin Stjernholm  }
c905ff2003-09-24Martin Stjernholm  if (id_ref->id_flags & ID_HIDDEN || (id_ref->id_flags & (ID_INHERITED|ID_PRIVATE)) == (ID_INHERITED|ID_PRIVATE)) continue;
5a484d2003-09-09Martin Stjernholm 
c905ff2003-09-24Martin Stjernholm  id_inh = INHERIT_FROM_PTR (p, id_ref); id = id_inh->prog->identifiers + id_ref->identifier_offset;
5a484d2003-09-09Martin Stjernholm 
c905ff2003-09-24Martin Stjernholm  if (IDENTIFIER_IS_PIKE_FUNCTION (id->identifier_flags)) type = "fun"; else if (IDENTIFIER_IS_FUNCTION (id->identifier_flags)) type = "cfun"; else if (IDENTIFIER_IS_CONSTANT (id->identifier_flags)) type = "const"; else if (IDENTIFIER_IS_ALIAS (id->identifier_flags)) type = "alias"; else if (IDENTIFIER_IS_VARIABLE (id->identifier_flags)) type = "var"; else type = "???";
5a484d2003-09-09Martin Stjernholm 
c905ff2003-09-24Martin Stjernholm  prot[0] = prot[1] = 0; if (id_ref->id_flags & ID_PRIVATE) { strcat (prot, ",pri"); if (!(id_ref->id_flags & ID_STATIC)) strcat (prot, ",!sta"); } else if (id_ref->id_flags & ID_STATIC) strcat (prot, ",sta"); if (id_ref->id_flags & ID_NOMASK) strcat (prot, ",nom"); if (id_ref->id_flags & ID_PUBLIC) strcat (prot, ",pub"); if (id_ref->id_flags & ID_PROTECTED) strcat (prot, ",pro"); if (id_ref->id_flags & ID_INLINE) strcat (prot, ",inl"); if (id_ref->id_flags & ID_OPTIONAL) strcat (prot, ",opt"); if (id_ref->id_flags & ID_EXTERN) strcat (prot, ",ext"); if (id_ref->id_flags & ID_VARIANT) strcat (prot, ",var"); if (id_ref->id_flags & ID_ALIAS) strcat (prot, ",ali"); sprintf (descr, "%s: %s", type, prot + 1); fprintf (stderr, "%*s**%*s%-18s name: ", indent, "", id_inh->inherit_level + 1, "", descr);
99cee92004-04-03Martin Stjernholm  if (id->name->size_shift)
f189372004-04-03Martin Stjernholm  print_short_svalue (stderr, (union anything *) &id->name, T_STRING);
c905ff2003-09-24Martin Stjernholm  else fprintf (stderr, "%-20s", id->name->str); if (id->identifier_flags & IDENTIFIER_C_FUNCTION) fprintf (stderr, " addr: %p", id->func.c_fun); else if (IDENTIFIER_IS_VARIABLE (id->identifier_flags)) fprintf (stderr, " rtt: %s off: %"PRINTPTRDIFFT"d", get_name_of_type (id->run_time_type), id->func.offset); else if (IDENTIFIER_IS_PIKE_FUNCTION (id->identifier_flags)) fprintf (stderr, " pc: %"PRINTPTRDIFFT"d", id->func.offset); else if (IDENTIFIER_IS_CONSTANT (id->identifier_flags)) { fputs (" value: ", stderr); print_svalue_compact (stderr, &id_inh->prog->constants[id->func.offset].sval); } fputc ('\n', stderr); id_count++;
5a484d2003-09-09Martin Stjernholm  }
c905ff2003-09-24Martin Stjernholm  if (!id_count) fprintf (stderr, "%*s** (none)\n", indent, "");
f6d0171997-10-15Fredrik Hübinette (Hubbe)  }
a4033e2000-04-14Fredrik Hübinette (Hubbe)  if(flags & DESCRIBE_MEM) {
7e877a2003-04-02Martin Stjernholm #define FOO(NUMTYPE,TYPE,ARGTYPE,NAME) \
17c7622001-08-20Martin Stjernholm  fprintf(stderr, "%*s* " #NAME " %p[%"PRINTSIZET"u]\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 
5b15bb2001-12-10Martin Stjernholm  case T_MULTISET_DATA: {
308d272003-08-26Martin Stjernholm  int found = 0;
5b15bb2001-12-10Martin Stjernholm  struct multiset *l; for (l = first_multiset; l; l = l->next) { if (l->msd == (struct multiset_data *) a) {
308d272003-08-26Martin Stjernholm  fprintf(stderr, "%*s**Describing multiset %p for this data block:\n", indent, "", l);
5b15bb2001-12-10Martin Stjernholm  debug_dump_multiset(l);
308d272003-08-26Martin Stjernholm  found = 1;
5b15bb2001-12-10Martin Stjernholm  } }
308d272003-08-26Martin Stjernholm  if (!found) fprintf (stderr, "%*s**Didn't find multiset for this data block!\n", indent, "");
5b15bb2001-12-10Martin Stjernholm  break; } case T_MULTISET:
3eed602004-04-18Martin Stjernholm  if (((struct multiset *) a)->refs > 0) debug_dump_multiset((struct multiset *) a);
5b15bb2001-12-10Martin Stjernholm  break;
f6d0171997-10-15Fredrik Hübinette (Hubbe)  case T_ARRAY:
3eed602004-04-18Martin Stjernholm  if (((struct array *) a)->refs > 0) debug_dump_array((struct array *)a);
f6d0171997-10-15Fredrik Hübinette (Hubbe)  break;
62971d1998-01-19Fredrik Hübinette (Hubbe) 
9a6d002001-06-26Fredrik Hübinette (Hubbe)  case T_MAPPING_DATA: {
308d272003-08-26Martin Stjernholm  int found = 0;
9a6d002001-06-26Fredrik Hübinette (Hubbe)  struct mapping *m; for(m=first_mapping;m;m=m->next) { if(m->data == (struct mapping_data *)a) {
ffb3902001-06-26Fredrik Hübinette (Hubbe)  fprintf(stderr,"%*s**Describing mapping for this data block:\n",indent,"");
9a6d002001-06-26Fredrik Hübinette (Hubbe)  debug_dump_mapping((struct mapping *)m);
308d272003-08-26Martin Stjernholm  found = 1;
9a6d002001-06-26Fredrik Hübinette (Hubbe)  } }
308d272003-08-26Martin Stjernholm  if (!found) fprintf (stderr, "%*s**Didn't find mapping for this data block!\n", indent, "");
9a6d002001-06-26Fredrik Hübinette (Hubbe)  break; }
61e9a01998-01-25Fredrik Hübinette (Hubbe)  case T_MAPPING:
3eed602004-04-18Martin Stjernholm  if (((struct mapping *) a)->refs > 0) debug_dump_mapping((struct mapping *)a);
61e9a01998-01-25Fredrik Hübinette (Hubbe)  break;
62971d1998-01-19Fredrik Hübinette (Hubbe)  case T_STRING: { struct pike_string *s=(struct pike_string *)a;
308d272003-08-26Martin Stjernholm  fprintf(stderr,"%*s**size_shift: %d, len: %"PRINTPTRDIFFT"d, hash: %"PRINTSIZET"x\n", indent,"", s->len, s->size_shift, s->hval);
3eed602004-04-18Martin Stjernholm  if (!s->size_shift && s->refs > 0) {
308d272003-08-26Martin Stjernholm  if(s->len>77) { fprintf(stderr,"%*s** \"%60s\"...\n",indent,"",s->str); }else{ fprintf(stderr,"%*s** \"%s\"\n",indent,"",s->str); }
62971d1998-01-19Fredrik Hübinette (Hubbe)  } break; }
b351292001-08-20Martin Stjernholm  case T_PIKE_FRAME: { struct pike_frame *f = (struct pike_frame *) a; do {
3eed602004-04-18Martin Stjernholm  if (f->refs <= 0) break;
b351292001-08-20Martin Stjernholm  if (f->current_object) {
17c7622001-08-20Martin Stjernholm  struct program *p = f->current_object->prog; if (p) { struct identifier *id = ID_FROM_INT(p, f->fun); INT32 line; struct pike_string *file; if (IDENTIFIER_IS_PIKE_FUNCTION(id->identifier_flags) &&
4d04752003-08-20Henrik Grubbström (Grubba)  id->func.offset >= 0 &&
17c7622001-08-20Martin Stjernholm  (file = get_line(p->program + id->func.offset, p, &line))) { fprintf(stderr, "%*s**Function %s at %s:%ld\n", indent, "", id->name->str, file->str, (long) line); free_string(file); } else fprintf(stderr, "%*s**Function %s at unknown location.\n", indent, "", id->name->str); }
79566d2004-03-15Martin Stjernholm  if (!(flags & DESCRIBE_SHORT)) { fprintf(stderr, "%*s**Describing the current object:\n", indent, ""); describe_something(f->current_object, T_OBJECT, indent+2, depth, flags, 0); }
b351292001-08-20Martin Stjernholm  }
17c7622001-08-20Martin Stjernholm  else fprintf(stderr, "%*s**No current object.\n", indent, "");
b351292001-08-20Martin Stjernholm  if ((f = f->scope)) fprintf(stderr, "%*s**Moving on to outer scope frame %p:\n", indent, "", f); } while (f); break; } default: fprintf(stderr, "%*s**Cannot describe block of unknown type %d\n", indent, "", t);
f6d0171997-10-15Fredrik Hübinette (Hubbe)  }
25479a2000-03-07Fredrik Hübinette (Hubbe) }
b351292001-08-20Martin Stjernholm void describe_something(void *a, int t, int indent, int depth, int flags, void *inblock)
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;
f189372004-04-03Martin Stjernholm  if(!a) { fprintf (stderr, "%*s**NULL pointer\n", indent, ""); return; }
25479a2000-03-07Fredrik Hübinette (Hubbe)  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) {
43c7782003-03-30Martin Stjernholm  fprintf(stderr,"%*s**Block: %p Type: %s Zapped pointer\n",indent,"",a,
3845452000-03-08Henrik Grubbström (Grubba)  get_name_of_type(t)); } else #endif /* DEBUG_MALLOC */
728b232000-09-30Martin Stjernholm  if (((ptrdiff_t)a) & 3) {
43c7782003-03-30Martin Stjernholm  fprintf(stderr,"%*s**Block: %p Type: %s Misaligned address\n",indent,"",a,
728b232000-09-30Martin Stjernholm  get_name_of_type(t)); } else {
43c7782003-03-30Martin Stjernholm  fprintf(stderr,"%*s**Block: %p Type: %s Refs: %d\n",indent,"",a,
728b232000-09-30Martin Stjernholm  get_name_of_type(t), *(INT32 *)a);
25479a2000-03-07Fredrik Hübinette (Hubbe) 
e0cbd32003-03-29Martin Stjernholm  low_describe_something(a,t,indent,depth,flags,inblock);
25479a2000-03-07Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC
728b232000-09-30Martin Stjernholm  if(!(flags & DESCRIBE_NO_DMALLOC)) debug_malloc_dump_references(a,indent+2,depth-1,flags);
25479a2000-03-07Fredrik Hübinette (Hubbe) #endif
728b232000-09-30Martin Stjernholm  }
87c7f92000-04-19Martin Stjernholm 
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) }
1f21332000-07-28Fredrik Hübinette (Hubbe) PMOD_EXPORT void describe(void *x)
8fb1e11998-04-05Fredrik Hübinette (Hubbe) {
b351292001-08-20Martin Stjernholm  void *inblock; int type = attempt_to_identify(x, &inblock);
5a484d2003-09-09Martin Stjernholm  describe_something(x, type, 0, 0, 0, inblock);
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:
f980132004-03-21Martin Nilsson  fprintf(stderr," %"PRINTPIKEINT"d (subtype %d)\n",s->u.integer, s->subtype);
c72a4e1998-12-15Fredrik Hübinette (Hubbe)  break; case T_FLOAT:
27ec272003-09-10Martin Stjernholm  fprintf(stderr," %"PRINTPIKEFLOAT"f\n",s->u.float_number);
c72a4e1998-12-15Fredrik Hübinette (Hubbe)  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) {
8e5a402004-03-16Martin Stjernholm  fprintf(stderr," Function in destructed object: %s\n", ID_FROM_INT(p,s->subtype)->name->str);
1e4e5f2000-04-07Fredrik Hübinette (Hubbe)  }else{ fprintf(stderr," Function in destructed object.\n"); }
2eeba91999-03-17Fredrik Hübinette (Hubbe)  }else{
8e5a402004-03-16Martin Stjernholm  fprintf(stderr," Function name: %s\n", ID_FROM_INT(s->u.object->prog,s->subtype)->name->str);
2eeba91999-03-17Fredrik Hübinette (Hubbe)  } }
c72a4e1998-12-15Fredrik Hübinette (Hubbe)  }
22415d2003-09-24Martin Stjernholm  describe_something(s->u.refs,s->type,0,1,0,0);
c72a4e1998-12-15Fredrik Hübinette (Hubbe) }
1e91212001-07-05Martin Stjernholm void gc_watch(void *a) { struct marker *m; init_gc(); m = get_marker(a); if (!(m->flags & GC_WATCHED)) { m->flags |= GC_WATCHED; fprintf(stderr, "## Watching thing %p.\n", a); gc_is_watching++; } else fprintf(stderr, "## Already watching thing %p.\n", a); }
8e5a402004-03-16Martin Stjernholm static void gc_watched_found (struct marker *m, const char *found_in) { fprintf(stderr, "## Watched thing %p with %d refs found in " "%s in pass %d.\n", m->data, *(INT32 *) m->data, found_in, Pike_in_gc); describe_marker (m); }
50d97a2003-02-01Martin Stjernholm #endif /* PIKE_DEBUG */
e1a35e2003-09-08Martin Stjernholm #ifndef GC_MARK_DEBUG struct pike_queue gc_mark_queue; #else /* !GC_MARK_DEBUG */ /* Cut'n'paste from queue.c. */ struct gc_queue_entry { queue_call call; void *data; int in_type; void *in; const char *place; }; #define GC_QUEUE_ENTRIES 8191 struct gc_queue_block { struct gc_queue_block *next; int used; struct gc_queue_entry entries[GC_QUEUE_ENTRIES]; }; struct gc_queue_block *gc_mark_first = NULL, *gc_mark_last = NULL; void gc_mark_run_queue() { struct gc_queue_block *b; while((b=gc_mark_first)) { int e; for(e=0;e<b->used;e++) { debug_malloc_touch(b->entries[e].data); b->entries[e].call(b->entries[e].data); } gc_mark_first=b->next; free((char *)b); } gc_mark_last=0; } void gc_mark_discard_queue() { struct gc_queue_block *b = gc_mark_first; while (b) { struct gc_queue_block *next = b->next; free((char *) b); b = next; } gc_mark_first = gc_mark_last = 0; } void gc_mark_enqueue (queue_call call, void *data) { struct gc_queue_block *b; #ifdef PIKE_DEBUG if (gc_found_in_type == PIKE_T_UNKNOWN || !gc_found_in) gc_fatal (data, 0, "gc_mark_enqueue() called outside GC_ENTER.\n"); { struct marker *m; if (gc_is_watching && (m = find_marker(data)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_mark_enqueue()");
e1a35e2003-09-08Martin Stjernholm  } } #endif b=gc_mark_last; if(!b || b->used >= GC_QUEUE_ENTRIES) { b = (struct gc_queue_block *) malloc (sizeof (struct gc_queue_block)); if (!b) fatal ("Out of memory in gc.\n"); b->used=0; b->next=0; if(gc_mark_first) gc_mark_last->next=b; else gc_mark_first=b; gc_mark_last=b; } b->entries[b->used].call=call; b->entries[b->used].data=debug_malloc_pass(data); b->entries[b->used].in_type = gc_found_in_type; b->entries[b->used].in = debug_malloc_pass (gc_found_in); b->entries[b->used].place = gc_found_place; b->used++; } #endif /* GC_MARK_DEBUG */
7bf6232000-04-23Martin Stjernholm void debug_gc_touch(void *a) { struct marker *m;
1e91212001-07-05Martin Stjernholm 
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_touch()");
1e91212001-07-05Martin Stjernholm  }
50d97a2003-02-01Martin Stjernholm #endif
1e91212001-07-05Martin Stjernholm 
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
22aa2f2000-09-04Martin Stjernholm  switch (Pike_in_gc) { case GC_PASS_PRETOUCH:
c0df092001-06-29Martin Stjernholm  m = find_marker(a);
50d97a2003-02-01Martin Stjernholm  if (m && !(m->flags & (GC_PRETOUCHED #ifdef PIKE_DEBUG |GC_WATCHED #endif )))
22aa2f2000-09-04Martin Stjernholm  gc_fatal(a, 1, "Thing got an existing but untouched marker.\n");
b13ee62001-06-30Martin Stjernholm  m = get_marker(a); m->flags |= GC_PRETOUCHED;
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
b13ee62001-06-30Martin Stjernholm  m->saved_refs = *(INT32 *) a;
50d97a2003-02-01Martin Stjernholm #endif
22aa2f2000-09-04Martin Stjernholm  break;
b13ee62001-06-30Martin Stjernholm  case GC_PASS_MIDDLETOUCH: {
1e0b962003-05-12Martin Nilsson #ifdef PIKE_DEBUG
b13ee62001-06-30Martin Stjernholm  int extra_ref;
1e0b962003-05-12Martin Nilsson #endif
c0df092001-06-29Martin Stjernholm  m = find_marker(a);
22aa2f2000-09-04Martin Stjernholm  if (!m) gc_fatal(a, 1, "Found a thing without marker.\n"); else if (!(m->flags & GC_PRETOUCHED)) gc_fatal(a, 1, "Thing got an existing but untouched marker.\n");
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
b13ee62001-06-30Martin Stjernholm  extra_ref = (m->flags & GC_GOT_EXTRA_REF) == GC_GOT_EXTRA_REF; if (m->saved_refs + extra_ref < *(INT32 *) a) if (m->flags & GC_WEAK_FREED) gc_fatal(a, 1, "Something failed to remove weak reference(s) to thing, " "or it has gotten more references since gc start.\n"); else gc_fatal(a, 1, "Thing has gotten more references since gc start.\n");
50d97a2003-02-01Martin Stjernholm  else if (m->weak_refs > m->saved_refs) gc_fatal(a, 0, "A thing got more weak references than references.\n"); #endif
22aa2f2000-09-04Martin Stjernholm  m->flags |= GC_MIDDLETOUCHED; break;
b13ee62001-06-30Martin Stjernholm  }
22aa2f2000-09-04Martin Stjernholm  case GC_PASS_POSTTOUCH:
c0df092001-06-29Martin Stjernholm  m = find_marker(a);
22aa2f2000-09-04Martin Stjernholm  if (!*(INT32 *) a) gc_fatal(a, 1, "Found a thing without refs.\n"); if (m) { if (!(m->flags & (GC_PRETOUCHED|GC_MIDDLETOUCHED))) gc_fatal(a, 2, "An existing but untouched marker found " "for object in linked lists.\n"); else if (m->flags & GC_LIVE_RECURSE || (m->frame && m->frame->frameflags & (GC_WEAK_REF|GC_STRONG_REF))) gc_fatal(a, 2, "Thing still got flag from recurse list.\n");
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
22aa2f2000-09-04Martin Stjernholm  else if (m->flags & GC_MARKED) return;
57cfbd2004-03-15Martin Stjernholm  else if (gc_destruct_everything) return;
22aa2f2000-09-04Martin Stjernholm  else if (!(m->flags & GC_NOT_REFERENCED) || 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");
1a12e82000-09-30Martin Stjernholm  else if (m->weak_refs > m->saved_refs) gc_fatal(a, 2, "A thing got more weak references than references.\n");
22aa2f2000-09-04Martin Stjernholm  else if (!(m->flags & GC_LIVE)) {
1a12e82000-09-30Martin Stjernholm  if (m->weak_refs < 0)
22aa2f2000-09-04Martin Stjernholm  gc_fatal(a, 3, "A thing which had only weak references is " "still around after gc.\n"); else gc_fatal(a, 3, "A thing to garb is still around.\n"); }
50d97a2003-02-01Martin Stjernholm #endif
6d30f52000-07-11Martin Stjernholm  }
22aa2f2000-09-04Martin Stjernholm  break; default:
5aad932002-08-15Marcus Comstedt  Pike_fatal("debug_gc_touch() used in invalid gc pass.\n");
7bf6232000-04-23Martin Stjernholm  } }
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
0816292000-07-03Martin Stjernholm static INLINE struct marker *gc_check_debug(void *a, int weak)
c94c371996-03-28Fredrik Hübinette (Hubbe) {
7bf6232000-04-23Martin Stjernholm  struct marker *m;
87c7f92000-04-19Martin Stjernholm 
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
d9d6f02001-06-30Martin Stjernholm  if(Pike_in_gc == GC_PASS_LOCATE)
b8a6e71996-09-25Fredrik Hübinette (Hubbe)  { if(check_for == a) {
0816292000-07-03Martin Stjernholm  gdb_gc_stop_here(a, weak);
b8a6e71996-09-25Fredrik Hübinette (Hubbe)  }
4a578f1997-01-27Fredrik Hübinette (Hubbe)  return 0;
b8a6e71996-09-25Fredrik Hübinette (Hubbe)  }
e942a72000-04-15Fredrik Hübinette (Hubbe) 
03c6602003-06-05Martin Stjernholm #if 0 fprintf (stderr, "Ref: %s %p -> %p%s\n",
e1a35e2003-09-08Martin Stjernholm  get_name_of_type (gc_found_in_type), gc_found_in, a, gc_found_place ? gc_found_place : "");
03c6602003-06-05Martin Stjernholm #endif
7bf6232000-04-23Martin Stjernholm  if (Pike_in_gc != GC_PASS_CHECK)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc check attempted in invalid pass.\n");
7bf6232000-04-23Martin Stjernholm  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");
b13ee62001-06-30Martin Stjernholm  if (m->saved_refs == -1) m->saved_refs = *(INT32 *)a; else if (m->saved_refs != *(INT32 *)a)
0816292000-07-03Martin Stjernholm  gc_fatal(a, 1, "Refs changed in gc check pass.\n");
ff322e2000-06-10Martin Stjernholm  if (m->refs + m->xrefs >= *(INT32 *) a) /* m->refs will be incremented by the caller. */
9fa1282004-04-04Martin Stjernholm  gc_fatal(a, 1, "Thing is getting more internal refs than refs " "(a pointer has probably been checked more than once).\n");
e2d9e62000-06-10Martin Stjernholm  checked++; return m; } #endif /* PIKE_DEBUG */
fa8c692000-11-30Fredrik Hübinette (Hubbe) PMOD_EXPORT INT32 real_gc_check(void *a)
e2d9e62000-06-10Martin Stjernholm { struct marker *m;
0816292000-07-03Martin Stjernholm  INT32 ret;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e1a35e2003-09-08Martin Stjernholm  if (gc_found_in_type == PIKE_T_UNKNOWN || !gc_found_in) gc_fatal (a, 0, "gc_check() called outside GC_ENTER.\n");
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_check()");
1e91212001-07-05Martin Stjernholm  }
0816292000-07-03Martin Stjernholm  if (!(m = gc_check_debug(a, 0))) return 0;
2200002000-04-23Martin Stjernholm #else m = get_marker(a);
b8a6e71996-09-25Fredrik Hübinette (Hubbe) #endif
0816292000-07-03Martin Stjernholm 
aad99b2001-03-28Fredrik Hübinette (Hubbe)  ret=m->refs; add_ref(m);
b13ee62001-06-30Martin Stjernholm  if (m->refs == *(INT32 *) a)
0816292000-07-03Martin Stjernholm  m->flags |= GC_NOT_REFERENCED; return ret;
e2d9e62000-06-10Martin Stjernholm }
e942a72000-04-15Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm INT32 real_gc_check_weak(void *a) { struct marker *m;
0816292000-07-03Martin Stjernholm  INT32 ret;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e1a35e2003-09-08Martin Stjernholm  if (gc_found_in_type == PIKE_T_UNKNOWN || !gc_found_in) gc_fatal (a, 0, "gc_check_weak() called outside GC_ENTER.\n");
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_check_weak()");
1e91212001-07-05Martin Stjernholm  }
0816292000-07-03Martin Stjernholm  if (!(m = gc_check_debug(a, 1))) return 0;
10c4a42000-08-17Martin Stjernholm  if (m->weak_refs < 0)
9326332000-06-12Martin Stjernholm  gc_fatal(a, 1, "Thing has already reached threshold for weak free.\n");
0816292000-07-03Martin Stjernholm  if (m->weak_refs >= *(INT32 *) a) gc_fatal(a, 1, "Thing has gotten more weak refs than refs.\n");
9326332000-06-12Martin Stjernholm  if (m->weak_refs > m->refs + 1) gc_fatal(a, 1, "Thing has gotten more weak refs than internal refs.\n");
e2d9e62000-06-10Martin Stjernholm #else m = get_marker(a);
ff322e2000-06-10Martin Stjernholm #endif
0816292000-07-03Martin Stjernholm  m->weak_refs++;
6d30f52000-07-11Martin Stjernholm  gc_ext_weak_refs++;
b13ee62001-06-30Martin Stjernholm  if (m->weak_refs == *(INT32 *) a)
0816292000-07-03Martin Stjernholm  m->weak_refs = -1;
aad99b2001-03-28Fredrik Hübinette (Hubbe)  ret=m->refs; add_ref(m);
b13ee62001-06-30Martin Stjernholm  if (m->refs == *(INT32 *) a)
0816292000-07-03Martin Stjernholm  m->flags |= GC_NOT_REFERENCED; return ret;
c94c371996-03-28Fredrik Hübinette (Hubbe) }
a12b8c2003-03-30Martin Stjernholm static void cleanup_markers (void) { #ifdef DO_PIKE_CLEANUP size_t e=0;
4fab5f2004-04-18Martin Stjernholm  if (gc_keep_markers) { /* Carry over any GC_CLEANUP_FREED flags but reinitialize them * otherwise. */ for(e=0;e<marker_hash_table_size;e++) { struct marker *m; for (m = marker_hash_table[e]; m; m = m->next) {
31a8682004-09-27Martin Stjernholm #ifdef PIKE_DEBUG
4fab5f2004-04-18Martin Stjernholm  m->flags &= GC_CLEANUP_FREED;
31a8682004-09-27Martin Stjernholm  m->xrefs = 0;
4fab5f2004-04-18Martin Stjernholm  m->saved_refs = -1;
31a8682004-09-27Martin Stjernholm #else m->flags = 0; #endif m->refs = m->weak_refs = 0;
4fab5f2004-04-18Martin Stjernholm  m->frame = 0; } } return; }
a12b8c2003-03-30Martin Stjernholm  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) static void init_gc(void) {
1e91212001-07-05Martin Stjernholm #ifdef PIKE_DEBUG if (!gc_is_watching) {
31a8682004-09-27Martin Stjernholm #endif #if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP)
a12b8c2003-03-30Martin Stjernholm  /* The marker hash table is left around after a previous gc if * gc_keep_markers is set. */ if (marker_hash_table) cleanup_markers();
4fab5f2004-04-18Martin Stjernholm  if (!marker_hash_table)
31a8682004-09-27Martin Stjernholm #endif
0429a32004-09-28Martin Stjernholm  low_init_marker_hash(num_objects);
1e91212001-07-05Martin Stjernholm  get_marker(rec_list.data); /* Used to simplify fencepost conditions. */ #ifdef PIKE_DEBUG } #endif
b51e6d1998-02-18Fredrik Hübinette (Hubbe) }
4fab5f2004-04-18Martin Stjernholm void exit_gc(void)
b51e6d1998-02-18Fredrik Hübinette (Hubbe) {
f3fa822004-01-13Henrik Grubbström (Grubba)  if (gc_evaluator_callback) { remove_callback(gc_evaluator_callback); gc_evaluator_callback = NULL; }
a12b8c2003-03-30Martin Stjernholm  if (!gc_keep_markers) cleanup_markers(); free_all_gc_frame_blocks(); #ifdef GC_VERBOSE num_gc_frames = 0;
1e91212001-07-05Martin Stjernholm #endif
a12b8c2003-03-30Martin Stjernholm 
1e91212001-07-05Martin Stjernholm #ifdef PIKE_DEBUG if (gc_is_watching) { fprintf(stderr, "## Exiting gc and resetting watches for %d things.\n", gc_is_watching); gc_is_watching = 0; }
45d87e2000-07-18Martin Stjernholm #endif
b51e6d1998-02-18Fredrik Hübinette (Hubbe) }
31a8682004-09-27Martin Stjernholm #ifdef PIKE_DEBUG
3b65672004-05-23Martin Nilsson void gc_check_zapped (void *a, TYPE_T type, const char *file, int line) { struct marker *m = find_marker (a); if (m && (m->flags & GC_CLEANUP_FREED)) fprintf (stderr, "Free of leaked %s %p from %s:%d, %d refs remaining\n", get_name_of_type (type), a, file, line, *(INT32 *)a - 1); } #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
0305412003-09-29Martin Stjernholm /* This function marks some known externals. The rest are handled by * callbacks added with add_gc_callback. */ static void mark_externals (void) { struct mapping *constants; if (master_object) gc_mark_external (master_object, " as master_object"); if ((constants = get_builtin_constants())) gc_mark_external (constants, " as global constants mapping"); }
b51e6d1998-02-18Fredrik Hübinette (Hubbe) void locate_references(void *a) {
7bf6232000-04-23Martin Stjernholm  int tmp, orig_in_gc = Pike_in_gc;
9fa1282004-04-04Martin Stjernholm  const char *orig_gc_found_place = gc_found_place;
ffb3902001-06-26Fredrik Hübinette (Hubbe)  int i=0; if(!marker_blocks) { i=1;
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  init_gc();
ffb3902001-06-26Fredrik Hübinette (Hubbe)  }
7bf6232000-04-23Martin Stjernholm  Pike_in_gc = GC_PASS_LOCATE;
9fa1282004-04-04Martin Stjernholm  gc_found_place = NULL;
7bf6232000-04-23Martin Stjernholm  /* Disable debug, this may help reduce recursion bugs */ tmp=d_flag; d_flag=0;
06ae272000-04-19Martin Stjernholm 
8c4cbb2001-12-16Martin Stjernholm  fprintf(stderr,"**Looking for references to %p:\n", a);
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  check_for=a;
884c122004-03-15Martin Stjernholm  found_ref_count = 0;
25d21c1998-02-24Per Hedbor 
04bbb72003-09-24Martin Stjernholm  GC_ENTER (NULL, PIKE_T_UNKNOWN) {
0305412003-09-29Martin Stjernholm  mark_externals(); call_callback(& gc_callbacks, NULL);
04bbb72003-09-24Martin Stjernholm  gc_check_all_arrays(); gc_check_all_multisets(); gc_check_all_mappings(); gc_check_all_programs(); gc_check_all_objects(); } GC_LEAVE;
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
884c122004-03-15Martin Stjernholm  fprintf(stderr,"**Done looking for references to %p, " "found %"PRINTSIZET"d refs.\n", a, found_ref_count);
8c4cbb2001-12-16Martin Stjernholm 
7bf6232000-04-23Martin Stjernholm  Pike_in_gc = orig_in_gc;
9fa1282004-04-04Martin Stjernholm  gc_found_place = orig_gc_found_place;
ffb3902001-06-26Fredrik Hübinette (Hubbe)  if(i) exit_gc();
7bf6232000-04-23Martin Stjernholm  d_flag=tmp;
b51e6d1998-02-18Fredrik Hübinette (Hubbe) }
1637c42000-02-01Fredrik Hübinette (Hubbe) 
c2be512001-03-21Fredrik Hübinette (Hubbe) void debug_gc_add_extra_ref(void *a)
c94c371996-03-28Fredrik Hübinette (Hubbe) {
c0df092001-06-29Martin Stjernholm  struct marker *m;
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_add_extra_ref()");
1e91212001-07-05Martin Stjernholm  }
c0df092001-06-29Martin Stjernholm  if (gc_debug) { m = find_marker(a); if ((!m || !(m->flags & GC_PRETOUCHED)) && !safe_debug_findstring((struct pike_string *) a)) gc_fatal(a, 0, "Doing gc_add_extra_ref() on invalid object.\n"); if (!m) m = get_marker(a); } else m = get_marker(a);
e2d9e62000-06-10Martin Stjernholm  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++;
9a6d002001-06-26Fredrik Hübinette (Hubbe)  add_ref( (struct ref_dummy *)a);
e2d9e62000-06-10Martin Stjernholm }
1637c42000-02-01Fredrik Hübinette (Hubbe) 
c2be512001-03-21Fredrik Hübinette (Hubbe) void debug_gc_free_extra_ref(void *a)
e2d9e62000-06-10Martin Stjernholm {
c0df092001-06-29Martin Stjernholm  struct marker *m;
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_free_extra_ref()");
1e91212001-07-05Martin Stjernholm  }
c0df092001-06-29Martin Stjernholm  if (gc_debug) { m = find_marker(a); if ((!m || !(m->flags & GC_PRETOUCHED)) && !safe_debug_findstring((struct pike_string *) a)) gc_fatal(a, 0, "Doing gc_add_extra_ref() on invalid object.\n"); if (!m) m = get_marker(a); } else m = get_marker(a);
e2d9e62000-06-10Martin Stjernholm  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--; }
c2be512001-03-21Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm int debug_gc_is_referenced(void *a) { struct marker *m;
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_is_referenced()");
1e91212001-07-05Martin Stjernholm  }
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
e2d9e62000-06-10Martin Stjernholm  if (Pike_in_gc != GC_PASS_MARK)
5aad932002-08-15Marcus Comstedt  Pike_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);
22aa2f2000-09-04Martin Stjernholm  if ((!m || !(m->flags & GC_PRETOUCHED)) &&
e2d9e62000-06-10Martin Stjernholm  !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)  }
7e697c2000-09-14Martin 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;
0816292000-07-03Martin Stjernholm  return !(m->flags & GC_NOT_REFERENCED);
c94c371996-03-28Fredrik Hübinette (Hubbe) }
e1a35e2003-09-08Martin Stjernholm int gc_mark_external (void *a, const char *place)
05c7cd1997-07-19Fredrik Hübinette (Hubbe) { struct marker *m;
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_mark_external()");
1e91212001-07-05Martin Stjernholm  }
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
7506fe2000-04-19Martin Stjernholm 
d9d6f02001-06-30Martin Stjernholm  if(Pike_in_gc == GC_PASS_LOCATE)
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  {
e1a35e2003-09-08Martin Stjernholm  if(a==check_for) { const char *orig_gc_found_place = gc_found_place; gc_found_place = place;
0816292000-07-03Martin Stjernholm  gdb_gc_stop_here(a, 0);
e1a35e2003-09-08Martin Stjernholm  gc_found_place = orig_gc_found_place;
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  } return 0; }
d9d6f02001-06-30Martin Stjernholm  if (Pike_in_gc != GC_PASS_CHECK)
e1a35e2003-09-08Martin Stjernholm  Pike_fatal("gc_mark_external() called in invalid gc pass.\n");
d9d6f02001-06-30Martin Stjernholm 
a12b8c2003-03-30Martin Stjernholm #ifdef DEBUG_MALLOC if (gc_external_refs_zapped) { fprintf (stderr, "One external ref to %p found%s.\n",
e1a35e2003-09-08Martin Stjernholm  a, place ? place : "");
4c6e552003-09-08Martin Stjernholm  if (gc_found_in) describe (gc_found_in);
a12b8c2003-03-30Martin Stjernholm  return 0; } #endif
424d9c1999-05-02Fredrik Hübinette (Hubbe)  m=get_marker(a);
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  m->xrefs++; m->flags|=GC_XREFERENCED;
0816292000-07-03Martin Stjernholm  if(Pike_in_gc == GC_PASS_CHECK && (m->refs + m->xrefs > *(INT32 *)a || (m->saved_refs != -1 && m->saved_refs != *(INT32 *)a)))
ff322e2000-06-10Martin Stjernholm  gc_fatal(a, 1, "Ref counts are wrong.\n");
05c7cd1997-07-19Fredrik Hübinette (Hubbe)  return 0; }
e2d9e62000-06-10Martin Stjernholm 
63709a2000-07-18Martin Stjernholm void debug_really_free_gc_frame(struct gc_frame *l) { if (l->frameflags & GC_LINK_FREED) gc_fatal(l->data, 0, "Freeing freed gc_frame.\n"); l->frameflags |= GC_LINK_FREED;
a609812000-08-03Henrik Grubbström (Grubba)  l->back = PREV(l) = NEXT(l) = (struct gc_frame *)(ptrdiff_t) -1;
63709a2000-07-18Martin Stjernholm  really_free_gc_frame(l); #ifdef GC_VERBOSE num_gc_frames--; #endif } #else /* PIKE_DEBUG */ #define debug_really_free_gc_frame(l) really_free_gc_frame(l) #endif /* PIKE_DEBUG */
e2d9e62000-06-10Martin Stjernholm int gc_do_weak_free(void *a) { struct marker *m;
63709a2000-07-18Martin Stjernholm #ifdef PIKE_DEBUG
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_do_weak_free()");
1e91212001-07-05Martin Stjernholm  }
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
22aa2f2000-09-04Martin Stjernholm  if (Pike_in_gc != GC_PASS_MARK && Pike_in_gc != GC_PASS_ZAP_WEAK)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc_do_weak_free() called in invalid gc pass.\n");
e2d9e62000-06-10Martin Stjernholm  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); if (m->weak_refs > m->refs) gc_fatal(a, 0, "More weak references than internal references.\n");
63709a2000-07-18Martin Stjernholm #else m = get_marker(a); #endif
e2d9e62000-06-10Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  if (Pike_in_gc != GC_PASS_ZAP_WEAK) {
2b8dde2000-09-15Martin Stjernholm  if (m->weak_refs < 0) goto should_free;
6d30f52000-07-11Martin Stjernholm  } else if (!(m->flags & GC_MARKED)) {
63709a2000-07-18Martin Stjernholm #ifdef PIKE_DEBUG
6d30f52000-07-11Martin Stjernholm  if (m->weak_refs <= 0) gc_fatal(a, 0, "Too many weak refs cleared to thing with external " "weak refs.\n");
63709a2000-07-18Martin Stjernholm #endif
6d30f52000-07-11Martin Stjernholm  m->weak_refs--;
2b8dde2000-09-15Martin Stjernholm  goto should_free;
6d30f52000-07-11Martin Stjernholm  } return 0;
2b8dde2000-09-15Martin Stjernholm  should_free: gc_ext_weak_refs--; #ifdef PIKE_DEBUG
1a12e82000-09-30Martin Stjernholm  m->saved_refs--;
2b8dde2000-09-15Martin Stjernholm  m->flags |= GC_WEAK_FREED; #endif if (*(INT32 *) a == 1) { /* Make sure the thing doesn't run out of refs, since we can't * handle cascading frees now. We'll do it in the free pass * instead. */ gc_add_extra_ref(a); m->flags |= GC_GOT_DEAD_REF;
d9d6f02001-06-30Martin Stjernholm #ifdef PIKE_DEBUG delayed_freed++; #endif
2b8dde2000-09-15Martin Stjernholm  } return 1;
e2d9e62000-06-10Martin Stjernholm }
05c7cd1997-07-19Fredrik Hübinette (Hubbe) 
b351292001-08-20Martin Stjernholm void gc_delayed_free(void *a, int type)
49bf8a2000-12-14Martin Stjernholm { struct marker *m; #ifdef PIKE_DEBUG
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_delayed_free()");
1e91212001-07-05Martin Stjernholm  }
49bf8a2000-12-14Martin Stjernholm  if (Pike_in_gc != GC_PASS_MARK && Pike_in_gc != GC_PASS_CYCLE && Pike_in_gc != GC_PASS_ZAP_WEAK)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc_delayed_free() called in invalid gc pass.\n");
49bf8a2000-12-14Martin Stjernholm  if (gc_debug) { if (!(m = find_marker(a))) gc_fatal(a, 0, "gc_delayed_free() got unknown object (missed by pretouch pass).\n"); } else m = get_marker(a); if (*(INT32 *) a != 1)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc_delayed_free() called for thing that haven't got a single ref.\n");
49bf8a2000-12-14Martin Stjernholm  debug_malloc_touch(a);
d9d6f02001-06-30Martin Stjernholm  delayed_freed++;
49bf8a2000-12-14Martin Stjernholm #else m = get_marker(a); #endif
fcb3222001-07-05Martin Stjernholm  if (m->flags & GC_MARKED) { /* Note that we can get marked things here, e.g. if the index in a * mapping with weak indices is removed in the zap weak pass, the * value will be zapped too, but it will still have a mark from * the mark pass. This means that the stuff referenced by the * value will only be refcount garbed, which can leave cyclic * garbage for the next gc round. * * Since the value has been marked we won't find it in the free * pass, so we have to keep special track of it. :P */ struct gc_frame *l = alloc_gc_frame(); l->data = a; l->u.free_extra_type = type; l->back = free_extra_list; l->frameflags = 0; free_extra_list = l; }
49bf8a2000-12-14Martin Stjernholm  gc_add_extra_ref(a); m->flags |= GC_GOT_DEAD_REF; }
c94c371996-03-28Fredrik Hübinette (Hubbe) int gc_mark(void *a) {
0816292000-07-03Martin Stjernholm  struct marker *m = get_marker(debug_malloc_pass(a));
c94c371996-03-28Fredrik Hübinette (Hubbe) 
87c7f92000-04-19Martin Stjernholm #ifdef PIKE_DEBUG
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && m && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_mark()");
1e91212001-07-05Martin Stjernholm  }
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
45d87e2000-07-18Martin Stjernholm  if (Pike_in_gc != GC_PASS_MARK && Pike_in_gc != GC_PASS_ZAP_WEAK)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc mark attempted in invalid pass.\n");
0816292000-07-03Martin Stjernholm  if (!*(INT32 *) a) gc_fatal(a, 0, "Marked a thing without refs.\n");
10c4a42000-08-17Martin Stjernholm  if (m->weak_refs < 0)
6d30f52000-07-11Martin Stjernholm  gc_fatal(a, 0, "Marking thing scheduled for weak free.\n");
87c7f92000-04-19Martin Stjernholm #endif
1a12e82000-09-30Martin Stjernholm  if (Pike_in_gc == GC_PASS_ZAP_WEAK) {
45d87e2000-07-18Martin Stjernholm  /* Things are visited in the zap weak pass through the mark * functions to free refs to internal things that only got weak * external references. That happens only when a thing also have * internal cyclic non-weak refs. */
1a12e82000-09-30Martin Stjernholm #ifdef PIKE_DEBUG if (!(m->flags & GC_MARKED)) gc_fatal(a, 0, "gc_mark() called for thing in zap weak pass " "that wasn't marked before.\n"); #endif
6d30f52000-07-11Martin Stjernholm  if (m->flags & GC_FREE_VISITED) return 0; else { m->flags |= GC_FREE_VISITED; return 1; }
1a12e82000-09-30Martin Stjernholm  }
6d30f52000-07-11Martin Stjernholm  else if (m->flags & GC_MARKED) { #ifdef PIKE_DEBUG if (m->weak_refs != 0) gc_fatal(a, 0, "weak_refs changed in marker already visited by gc_mark().\n"); #endif
c94c371996-03-28Fredrik Hübinette (Hubbe)  return 0;
6d30f52000-07-11Martin Stjernholm  } else { if (m->weak_refs) { gc_ext_weak_refs -= m->weak_refs; m->weak_refs = 0; }
0816292000-07-03Martin Stjernholm  m->flags = (m->flags & ~GC_NOT_REFERENCED) | GC_MARKED;
e2d9e62000-06-10Martin Stjernholm  DO_IF_DEBUG(marked++);
c94c371996-03-28Fredrik Hübinette (Hubbe)  return 1; } }
fa8c692000-11-30Fredrik Hübinette (Hubbe) PMOD_EXPORT void gc_cycle_enqueue(gc_cycle_check_cb *checkfn, void *data, int weak)
45d87e2000-07-18Martin Stjernholm { struct gc_frame *l = alloc_gc_frame();
1a12e82000-09-30Martin Stjernholm #ifdef PIKE_DEBUG
1e91212001-07-05Martin Stjernholm  { struct marker *m; if (gc_is_watching && (m = find_marker(data)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_cycle_enqueue()");
1e91212001-07-05Martin Stjernholm  } }
1a12e82000-09-30Martin Stjernholm  if (Pike_in_gc != GC_PASS_CYCLE) gc_fatal(data, 0, "Use of the gc frame stack outside the cycle check pass.\n"); #endif
45d87e2000-07-18Martin Stjernholm #ifdef GC_VERBOSE if (++num_gc_frames > max_gc_frames) max_gc_frames = num_gc_frames; #endif l->data = data; l->u.link.checkfn = checkfn; l->u.link.weak = weak; l->frameflags = 0; l->back = gc_rec_top; #ifdef GC_STACK_DEBUG fprintf(stderr, "enqueue %p [%p]: ", l, gc_rec_top); describe_gc_frame(l); fputc('\n', stderr); #endif gc_rec_top = l; } static struct gc_frame *gc_cycle_enqueue_pop(void *data) { struct gc_frame *l = alloc_gc_frame();
1a12e82000-09-30Martin Stjernholm #ifdef PIKE_DEBUG if (Pike_in_gc != GC_PASS_CYCLE) gc_fatal(data, 0, "Use of the gc frame stack outside the cycle check pass.\n"); #endif
45d87e2000-07-18Martin Stjernholm #ifdef GC_VERBOSE if (++num_gc_frames > max_gc_frames) max_gc_frames = num_gc_frames; #endif l->data = data; PREV(l) = gc_rec_last; NEXT(l) = 0; CYCLE(l) = 0; l->frameflags = GC_POP_FRAME; l->back = gc_rec_top; #ifdef GC_STACK_DEBUG fprintf(stderr, "enqueue %p [%p]: ", l, gc_rec_top); describe_gc_frame(l); fputc('\n', stderr); #endif gc_rec_top = l; return l; } void gc_cycle_run_queue() {
1a12e82000-09-30Martin Stjernholm #ifdef PIKE_DEBUG if (Pike_in_gc != GC_PASS_CYCLE)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Use of the gc frame stack outside the cycle check pass.\n");
1a12e82000-09-30Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm  while (gc_rec_top) { #ifdef GC_STACK_DEBUG fprintf(stderr, "dequeue %p [%p]: ", gc_rec_top, gc_rec_top->back); describe_gc_frame(gc_rec_top); fputc('\n', stderr); #endif if (gc_rec_top->frameflags & GC_POP_FRAME) { struct gc_frame *l = gc_rec_top->back; gc_cycle_pop(gc_rec_top->data); gc_rec_top = l; } else { struct gc_frame l = *gc_rec_top; #ifdef PIKE_DEBUG if (l.frameflags & GC_LINK_FREED) gc_fatal(l.data, 0, "Accessing freed gc_frame.\n"); #endif debug_really_free_gc_frame(gc_rec_top); gc_rec_top = l.back; l.u.link.checkfn(l.data, l.u.link.weak); } } }
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 { \
45d87e2000-07-18Martin Stjernholm  fprintf(stderr, "%*s%-35s %p [%p] ", gc_cycle_indent, "", \
af72c52000-07-02Martin Stjernholm  (TXT), (M) ? (M)->data : 0, gc_rec_last->data); \
996f872000-06-12Martin Stjernholm  describe_marker(M); \ } while (0) #else #define CYCLE_DEBUG_MSG(M, TXT) do {} while (0)
e2d9e62000-06-10Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm static void rotate_rec_list (struct gc_frame *beg, struct gc_frame *pos) /* Rotates the marker list and the cycle stack so the bit from pos
0db2c02003-02-14Martin Stjernholm  * down to the end gets before the bit from beg down to pos. The beg * pos might be moved further down the stack to avoid mixing cycles or * breaking strong link sequences. */
e2d9e62000-06-10Martin Stjernholm {
1e0b962003-05-12Martin Nilsson #ifdef GC_STACK_DEBUG
45d87e2000-07-18Martin Stjernholm  struct gc_frame *l;
1e0b962003-05-12Martin Nilsson #endif
0db2c02003-02-14Martin Stjernholm  CYCLE_DEBUG_MSG(find_marker(beg->data), "> rotate_rec_list, asked to begin at");
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
1a12e82000-09-30Martin Stjernholm  if (Pike_in_gc != GC_PASS_CYCLE)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Use of the gc frame stack outside the cycle check pass.\n");
45d87e2000-07-18Martin Stjernholm  CHECK_POP_FRAME(beg); CHECK_POP_FRAME(pos);
e2d9e62000-06-10Martin Stjernholm  if (beg == pos) gc_fatal(beg->data, 0, "Cycle already broken at requested position.\n");
45d87e2000-07-18Martin Stjernholm  if (NEXT(gc_rec_last)) gc_fatal(gc_rec_last->data, 0, "gc_rec_last not at end.\n");
e2d9e62000-06-10Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm #ifdef GC_STACK_DEBUG fprintf(stderr,"Stack before:\n"); for (l = gc_rec_top; l; l = l->back) { fprintf(stderr, " %p ", l); describe_gc_frame(l); fputc('\n', stderr); } #endif
0db2c02003-02-14Martin Stjernholm #if 0
45d87e2000-07-18Martin Stjernholm  if (CYCLE(beg)) { for (l = beg; CYCLE(PREV(l)) == CYCLE(beg); l = PREV(l)) CHECK_POP_FRAME(l); if (CYCLE(l) == CYCLE(pos)) {
af72c52000-07-02Martin Stjernholm  /* Breaking something previously marked as a cycle. Clear it
0db2c02003-02-14Martin Stjernholm  * since we're no longer sure it's an unambiguous cycle. */
45d87e2000-07-18Martin Stjernholm  unsigned cycle = CYCLE(l); for (; l && CYCLE(l) == cycle; l = NEXT(l)) { CHECK_POP_FRAME(l); #ifdef GC_CYCLE_DEBUG if (CYCLE(l)) CYCLE_DEBUG_MSG(find_marker(l->data), "> rotate_rec_list, clear cycle"); #endif CYCLE(l) = 0; }
af72c52000-07-02Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm  else beg = l; /* Keep the cycle continuous. */
e2d9e62000-06-10Martin Stjernholm  }
0db2c02003-02-14Martin Stjernholm #endif /* Always keep chains of strong refs continuous, or else we risk * breaking the order in a later rotation. */ for (; beg->frameflags & GC_STRONG_REF; beg = PREV(beg)) {}
e2d9e62000-06-10Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  CYCLE_DEBUG_MSG(find_marker(beg->data), "> rotate_rec_list, begin at");
46d4e72000-06-12Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  { struct gc_frame *b = beg, *p = pos, *old_rec_top; while (b->frameflags & GC_OFF_STACK) { if ((b = NEXT(b)) == pos) goto done; CHECK_POP_FRAME(b);
8e6d5c2001-07-02Martin Stjernholm  DO_IF_DEBUG(frame_rot++);
45d87e2000-07-18Martin Stjernholm  } while (p->frameflags & GC_OFF_STACK) { if (!(p = NEXT(p))) goto done; CHECK_POP_FRAME(p);
8e6d5c2001-07-02Martin Stjernholm  DO_IF_DEBUG(frame_rot++);
45d87e2000-07-18Martin Stjernholm  } old_rec_top = gc_rec_top; gc_rec_top = p->back; p->back = b->back; b->back = old_rec_top;
996f872000-06-12Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm done:
8e6d5c2001-07-02Martin Stjernholm  DO_IF_DEBUG(frame_rot++);
996f872000-06-12Martin Stjernholm  {
45d87e2000-07-18Martin Stjernholm  struct gc_frame *new_rec_last = PREV(pos); NEXT(PREV(beg)) = pos; PREV(pos) = PREV(beg); NEXT(gc_rec_last) = beg; PREV(beg) = gc_rec_last; gc_rec_last = new_rec_last; NEXT(gc_rec_last) = 0;
e2d9e62000-06-10Martin Stjernholm  }
af72c52000-07-02Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  if (beg->frameflags & GC_WEAK_REF) { beg->frameflags &= ~GC_WEAK_REF; pos->frameflags |= GC_WEAK_REF; CYCLE_DEBUG_MSG(get_marker(pos->data), "> rotate_rec_list, moved weak flag");
af72c52000-07-02Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm #ifdef GC_STACK_DEBUG fprintf(stderr,"Stack after:\n"); for (l = gc_rec_top; l; l = l->back) { fprintf(stderr, " %p ", l); describe_gc_frame(l); fputc('\n', stderr); } #endif
e2d9e62000-06-10Martin Stjernholm } int gc_cycle_push(void *x, struct marker *m, int weak)
c94c371996-03-28Fredrik Hübinette (Hubbe) {
45d87e2000-07-18Martin Stjernholm  struct marker *last = find_marker(gc_rec_last->data);
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && m && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_cycle_push()");
1e91212001-07-05Martin Stjernholm  }
9a6d002001-06-26Fredrik Hübinette (Hubbe)  debug_malloc_touch(x);
5aad932002-08-15Marcus Comstedt  if (!x) Pike_fatal("Got null pointer.\n"); if (m->data != x) Pike_fatal("Got wrong marker.\n");
e2d9e62000-06-10Martin Stjernholm  if (Pike_in_gc != GC_PASS_CYCLE)
5aad932002-08-15Marcus Comstedt  Pike_fatal("GC cycle push attempted in invalid pass.\n");
22aa2f2000-09-04Martin Stjernholm  if (gc_debug && !(m->flags & GC_PRETOUCHED))
e2d9e62000-06-10Martin Stjernholm  gc_fatal(x, 0, "gc_cycle_push() called for untouched thing.\n");
57cfbd2004-03-15Martin Stjernholm  if (!gc_destruct_everything) { if ((!(m->flags & GC_NOT_REFERENCED) || m->flags & GC_MARKED) && *(INT32 *) x) 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"); }
0db2c02003-02-14Martin Stjernholm  if (weak && gc_rec_last == &rec_list) gc_fatal(x, 1, "weak is %d when on top of stack.\n", weak); if (gc_debug > 1) {
e2d9e62000-06-10Martin Stjernholm  struct array *a; struct object *o; struct program *p; struct mapping *m; struct multiset *l;
cd451f2004-03-15Martin Stjernholm  for(a = gc_internal_array; a; a = a->next)
e2d9e62000-06-10Martin Stjernholm  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:
1f3b782000-06-16Fredrik Hübinette (Hubbe)  ; /* We must have a least one expression after a label! - Hubbe */
e2d9e62000-06-10Martin Stjernholm  } #endif
11649a2000-04-14Henrik Grubbström (Grubba) 
45d87e2000-07-18Martin Stjernholm  if (last->flags & GC_LIVE_RECURSE) {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
45d87e2000-07-18Martin Stjernholm  if (!(last->flags & GC_LIVE))
e2d9e62000-06-10Martin Stjernholm  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  }
e1be4f2001-07-01Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  else {
8ed8dc2001-07-01Martin Stjernholm  /* We'll get here eventually in the normal recursion. Pop off * the remaining live recurse frames for the last thing. */ CYCLE_DEBUG_MSG(m, "gc_cycle_push, no live recurse"); last->flags &= ~GC_LIVE_RECURSE; while (1) { struct gc_frame *l = gc_rec_top;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
8ed8dc2001-07-01Martin Stjernholm  if (!gc_rec_top)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Expected a gc_cycle_pop entry in gc_rec_top.\n");
8ed8dc2001-07-01Martin Stjernholm #endif gc_rec_top = l->back; if (l->frameflags & GC_POP_FRAME) { gc_rec_last = PREV(l);
45d87e2000-07-18Martin Stjernholm  debug_really_free_gc_frame(l);
8ed8dc2001-07-01Martin Stjernholm  break;
45d87e2000-07-18Martin Stjernholm  }
8ed8dc2001-07-01Martin Stjernholm  debug_really_free_gc_frame(l); } #ifdef GC_CYCLE_DEBUG gc_cycle_indent -= 2; CYCLE_DEBUG_MSG(m, "> gc_cycle_push, unwound live rec"); #endif
e2d9e62000-06-10Martin Stjernholm  } return 0; }
a595b92000-06-11Martin Stjernholm #ifdef PIKE_DEBUG
45d87e2000-07-18Martin Stjernholm  if (weak < 0 && gc_rec_last->frameflags & GC_FOLLOWED_NONSTRONG) gc_fatal(x, 0, "Followed strong link too late.\n"); if (weak >= 0) gc_rec_last->frameflags |= GC_FOLLOWED_NONSTRONG;
a595b92000-06-11Martin Stjernholm #endif
0db2c02003-02-14Martin Stjernholm  if (m->frame && !(m->frame->frameflags & GC_ON_KILL_LIST)) {
45d87e2000-07-18Martin Stjernholm  /* A cyclic reference is found. */
9326332000-06-12Martin Stjernholm #ifdef PIKE_DEBUG
45d87e2000-07-18Martin Stjernholm  if (gc_rec_last == &rec_list)
9326332000-06-12Martin Stjernholm  gc_fatal(x, 0, "Cyclic ref involves dummy rec_list marker.\n");
45d87e2000-07-18Martin Stjernholm  CHECK_POP_FRAME(gc_rec_last); CHECK_POP_FRAME(m->frame);
9326332000-06-12Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm  if (m != last) { struct gc_frame *p, *weak_ref = 0, *nonstrong_ref = 0;
e2d9e62000-06-10Martin Stjernholm  if (!weak) {
45d87e2000-07-18Martin Stjernholm  struct gc_frame *q;
af72c52000-07-02Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, search normal");
0db2c02003-02-14Martin Stjernholm  /* Find the last weakly linked thing and the one before the * first strongly linked thing. */
45d87e2000-07-18Martin Stjernholm  for (q = m->frame, p = NEXT(q);; q = p, p = NEXT(p)) { CHECK_POP_FRAME(p); if (p->frameflags & (GC_WEAK_REF|GC_STRONG_REF)) { if (p->frameflags & GC_WEAK_REF) weak_ref = p;
e2d9e62000-06-10Martin Stjernholm  else if (!nonstrong_ref) nonstrong_ref = q; } if (p == gc_rec_last) break; } } else if (weak < 0) {
af72c52000-07-02Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, search strong");
0db2c02003-02-14Martin Stjernholm  /* Find the last weakly linked thing and the last one which * isn't strongly linked. */
45d87e2000-07-18Martin Stjernholm  for (p = NEXT(m->frame);; p = NEXT(p)) { CHECK_POP_FRAME(p); if (p->frameflags & GC_WEAK_REF) weak_ref = p; if (!(p->frameflags & GC_STRONG_REF)) nonstrong_ref = p;
e2d9e62000-06-10Martin Stjernholm  if (p == gc_rec_last) break; } #ifdef PIKE_DEBUG
8ed8dc2001-07-01Martin Stjernholm  if (p == gc_rec_last && !nonstrong_ref) { fprintf(stderr, "Only strong links in cycle:\n");
14ff7a2001-07-02Martin Stjernholm  for (p = m->frame;; p = NEXT(p)) {
8ed8dc2001-07-01Martin Stjernholm  describe(p->data); locate_references(p->data); if (p == gc_rec_last) break; fprintf(stderr, "========= next =========\n"); } gc_fatal(0, 0, "Only strong links in cycle.\n"); }
e2d9e62000-06-10Martin Stjernholm #endif } else {
45d87e2000-07-18Martin Stjernholm  struct gc_frame *q;
af72c52000-07-02Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, search weak");
0db2c02003-02-14Martin Stjernholm  /* Find the thing before the first strongly linked one. */
45d87e2000-07-18Martin Stjernholm  for (q = m->frame, p = NEXT(q);; q = p, p = NEXT(p)) { CHECK_POP_FRAME(p); if (!(p->frameflags & GC_WEAK_REF) && !nonstrong_ref) nonstrong_ref = q;
e2d9e62000-06-10Martin Stjernholm  if (p == gc_rec_last) break; } }
45d87e2000-07-18Martin 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). */ CYCLE_DEBUG_MSG(find_marker(weak_ref->data), "gc_cycle_push, weak break"); rotate_rec_list(m->frame, weak_ref); }
e2d9e62000-06-10Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  else if (weak < 0) { /* The backward link is strong. Must break the cycle at the * last nonstrong link. */ CYCLE_DEBUG_MSG(find_marker(nonstrong_ref->data), "gc_cycle_push, nonstrong break"); rotate_rec_list(m->frame, nonstrong_ref);
0db2c02003-02-14Martin Stjernholm  NEXT(nonstrong_ref)->frameflags = (NEXT(nonstrong_ref)->frameflags & ~GC_WEAK_REF) | GC_STRONG_REF;
45d87e2000-07-18Martin Stjernholm  }
e2d9e62000-06-10Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  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->frame) { CYCLE_DEBUG_MSG(find_marker(nonstrong_ref->data), "gc_cycle_push, weaker break"); rotate_rec_list(m->frame, nonstrong_ref);
46d4e72000-06-12Martin Stjernholm  }
af72c52000-07-02Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm  else if (!weak) { /* A normal cycle which will be destructed in arbitrary * order. For reasons having to do with strong links we * can't mark weak cycles this way. */ unsigned cycle = CYCLE(m->frame) ? CYCLE(m->frame) : ++last_cycle; if (cycle == CYCLE(gc_rec_last)) CYCLE_DEBUG_MSG(m, "gc_cycle_push, old cycle"); else { CYCLE_DEBUG_MSG(m, "gc_cycle_push, cycle"); for (p = m->frame;; p = NEXT(p)) { CYCLE(p) = cycle; CYCLE_DEBUG_MSG(find_marker(p->data), "> gc_cycle_push, mark cycle"); if (p == gc_rec_last) break; }}}}} /* Mmm.. lisp ;) */
e2d9e62000-06-10Martin Stjernholm  else if (!(m->flags & GC_CYCLE_CHECKED)) {
51adb82003-01-12Martin Stjernholm  struct gc_frame *l;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG cycle_checked++;
45d87e2000-07-18Martin Stjernholm  if (m->frame) gc_fatal(x, 0, "Marker already got a frame.\n"); if (NEXT(gc_rec_last)) gc_fatal(gc_rec_last->data, 0, "Not at end of list.\n");
e2d9e62000-06-10Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm  NEXT(gc_rec_last) = m->frame = l = gc_cycle_enqueue_pop(x); m->flags |= GC_CYCLE_CHECKED | (last->flags & GC_LIVE);
9a6d002001-06-26Fredrik Hübinette (Hubbe)  debug_malloc_touch(x);
45d87e2000-07-18Martin Stjernholm  if (weak) { if (weak > 0) l->frameflags |= GC_WEAK_REF; else l->frameflags |= GC_STRONG_REF; }
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
45d87e2000-07-18Martin Stjernholm  gc_rec_last = l;
e2d9e62000-06-10Martin Stjernholm  return 1; } /* Should normally not recurse now, but got to do that anyway if we * must mark live things. */
45d87e2000-07-18Martin Stjernholm  if (!(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)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Shouldn't live recurse when there's nothing to do.\n");
e2d9e62000-06-10Martin Stjernholm #endif m->flags |= GC_LIVE|GC_LIVE_RECURSE;
9a6d002001-06-26Fredrik Hübinette (Hubbe)  debug_malloc_touch(x);
e2d9e62000-06-10Martin Stjernholm  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);
28a9672004-09-30Martin Stjernholm  if (!sub_ref ((struct ref_dummy *) x)) {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG gc_fatal(x, 0, "Thing got zero refs after removing the dead gc ref.\n"); #endif } }
45d87e2000-07-18Martin Stjernholm  { /* Recurse without linking onto rec_list. */ struct gc_frame *l = gc_cycle_enqueue_pop(x);
e2d9e62000-06-10Martin Stjernholm #ifdef GC_CYCLE_DEBUG
45d87e2000-07-18Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_push, live recurse"); gc_cycle_indent += 2;
e2d9e62000-06-10Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm  gc_rec_last = l; }
8e6d5c2001-07-02Martin Stjernholm #ifdef PIKE_DEBUG live_rec++; #endif
e2d9e62000-06-10Martin Stjernholm  return 1; }
45d87e2000-07-18Martin Stjernholm static void gc_cycle_pop(void *a)
e2d9e62000-06-10Martin Stjernholm {
45d87e2000-07-18Martin Stjernholm  struct marker *m = find_marker(a); struct gc_frame *here, *base, *p;
e2d9e62000-06-10Martin Stjernholm  #ifdef PIKE_DEBUG
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && m && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_cycle_pop()");
1e91212001-07-05Martin Stjernholm  }
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
e2d9e62000-06-10Martin Stjernholm  if (Pike_in_gc != GC_PASS_CYCLE)
5aad932002-08-15Marcus Comstedt  Pike_fatal("GC cycle pop attempted in invalid pass.\n");
e2d9e62000-06-10Martin Stjernholm  if (!(m->flags & GC_CYCLE_CHECKED)) gc_fatal(a, 0, "Marker being popped doesn't have GC_CYCLE_CHECKED.\n");
57cfbd2004-03-15Martin Stjernholm  if (!gc_destruct_everything) { if ((!(m->flags & GC_NOT_REFERENCED) || m->flags & GC_MARKED) && *(INT32 *) a) 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"); }
e2d9e62000-06-10Martin Stjernholm #endif #ifdef GC_CYCLE_DEBUG gc_cycle_indent -= 2; #endif
46d4e72000-06-12Martin Stjernholm  if (m->flags & GC_LIVE_RECURSE) {
e2d9e62000-06-10Martin Stjernholm  m->flags &= ~GC_LIVE_RECURSE;
45d87e2000-07-18Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_pop_live"); gc_rec_last = PREV(gc_rec_top); debug_really_free_gc_frame(gc_rec_top);
996f872000-06-12Martin Stjernholm  return;
e2d9e62000-06-10Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm  here = m->frame;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
45d87e2000-07-18Martin Stjernholm  if (!here || here->data != a) gc_fatal(a, 0, "Marker being popped has no or invalid frame.\n"); CHECK_POP_FRAME(here); CHECK_POP_FRAME(gc_rec_last); if (here->frameflags & GC_OFF_STACK)
46d4e72000-06-12Martin Stjernholm  gc_fatal(a, 0, "Marker being popped isn't on stack.\n");
a609812000-08-03Henrik Grubbström (Grubba)  here->back = (struct gc_frame *)(ptrdiff_t) -1;
9326332000-06-12Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm  here->frameflags |= GC_OFF_STACK;
e2d9e62000-06-10Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  for (base = PREV(here), p = here;; base = p, p = NEXT(p)) { if (base == here) { /* Part of a cycle; wait until the cycle is complete before * unlinking it from rec_list. */
a609812000-08-03Henrik Grubbström (Grubba)  DO_IF_DEBUG(m->frame->back = (struct gc_frame *)(ptrdiff_t) -1);
af72c52000-07-02Martin Stjernholm  CYCLE_DEBUG_MSG(m, "gc_cycle_pop, keep cycle"); return; }
45d87e2000-07-18Martin Stjernholm  CHECK_POP_FRAME(p); if (!(CYCLE(p) && CYCLE(p) == CYCLE(base)))
af72c52000-07-02Martin Stjernholm  break; }
45d87e2000-07-18Martin Stjernholm  gc_rec_last = base; while ((p = NEXT(base))) { struct marker *pm = find_marker(p->data);
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
45d87e2000-07-18Martin Stjernholm  if (pm->frame != p) gc_fatal(p->data, 0, "Bogus marker for thing being popped.\n");
e2d9e62000-06-10Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm  p->frameflags &= ~(GC_WEAK_REF|GC_STRONG_REF); if (pm->flags & GC_LIVE_OBJ) {
2b8dde2000-09-15Martin Stjernholm  /* This extra ref is taken away in the kill pass. Don't add one * if it got an extra ref already due to weak free. */ if (!(pm->flags & GC_GOT_DEAD_REF)) gc_add_extra_ref(p->data);
45d87e2000-07-18Martin Stjernholm  base = p;
0db2c02003-02-14Martin Stjernholm  p->frameflags |= GC_ON_KILL_LIST;
a609812000-08-03Henrik Grubbström (Grubba)  DO_IF_DEBUG(PREV(p) = (struct gc_frame *)(ptrdiff_t) -1);
45d87e2000-07-18Martin Stjernholm  CYCLE_DEBUG_MSG(pm, "gc_cycle_pop, put on kill list");
e2d9e62000-06-10Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm  else { if (!(pm->flags & GC_LIVE)) { /* Add an extra ref which is 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. */
2b8dde2000-09-15Martin Stjernholm  if (!(pm->flags & GC_GOT_DEAD_REF)) { gc_add_extra_ref(pm->data); pm->flags |= GC_GOT_DEAD_REF; } }
996f872000-06-12Martin Stjernholm #ifdef PIKE_DEBUG
2b8dde2000-09-15Martin Stjernholm  else
45d87e2000-07-18Martin Stjernholm  if (pm->flags & GC_GOT_DEAD_REF)
2b8dde2000-09-15Martin Stjernholm  gc_fatal(p->data, 0, "Didn't expect a dead extra ref.\n");
45d87e2000-07-18Martin Stjernholm #endif NEXT(base) = NEXT(p); CYCLE_DEBUG_MSG(pm, "gc_cycle_pop, pop off"); pm->frame = 0; debug_really_free_gc_frame(p);
996f872000-06-12Martin Stjernholm  }
8fb1e11998-04-05Fredrik Hübinette (Hubbe)  }
e2d9e62000-06-10Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  if (base != gc_rec_last) { NEXT(base) = kill_list; kill_list = NEXT(gc_rec_last); NEXT(gc_rec_last) = 0; }
e2d9e62000-06-10Martin Stjernholm } void do_gc_recurse_svalues(struct svalue *s, int num) { gc_recurse_svalues(s, num); }
1637c42000-02-01Fredrik Hübinette (Hubbe) 
b351292001-08-20Martin Stjernholm void do_gc_recurse_short_svalue(union anything *u, int type)
e2d9e62000-06-10Martin Stjernholm { 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
1e91212001-07-05Martin Stjernholm  if (gc_is_watching && (m = find_marker(a)) && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */
8e5a402004-03-16Martin Stjernholm  gc_watched_found (m, "gc_do_free()");
1e91212001-07-05Martin Stjernholm  }
5aad932002-08-15Marcus Comstedt  if (!a) Pike_fatal("Got null pointer.\n");
e2d9e62000-06-10Martin Stjernholm  if (Pike_in_gc != GC_PASS_FREE)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc free attempted in invalid pass.\n");
e2d9e62000-06-10Martin Stjernholm #endif m=find_marker(debug_malloc_pass(a)); if (!m) return 0; /* Object created after cycle pass. */
57cfbd2004-03-15Martin Stjernholm  if (gc_destruct_everything) { /* We don't actually free much in this mode, just destruct * objects. So when we normally would return nonzero we just * remove the extra ref again. */ if (!(m->flags & GC_LIVE)) { if (*(INT32 *) a == 1) return 1; else { gc_free_extra_ref (a);
28a9672004-09-30Martin Stjernholm  sub_ref ((struct ref_dummy *) a);
57cfbd2004-03-15Martin Stjernholm  } } return 0; }
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
0816292000-07-03Martin Stjernholm  if (*(INT32 *) a > !!(m->flags & GC_GOT_EXTRA_REF)) {
57cfbd2004-03-15Martin Stjernholm  if (!gc_destruct_everything && (!(m->flags & GC_NOT_REFERENCED) || m->flags & GC_MARKED))
0816292000-07-03Martin Stjernholm  gc_fatal(a, 0, "gc_do_free() called for referenced thing.\n"); if (gc_debug &&
22aa2f2000-09-04Martin Stjernholm  (m->flags & (GC_PRETOUCHED|GC_MARKED|GC_IS_REFERENCED)) == GC_PRETOUCHED)
0816292000-07-03Martin Stjernholm  gc_fatal(a, 0, "gc_do_free() called without prior call to " "gc_mark() or gc_is_referenced().\n"); }
57cfbd2004-03-15Martin Stjernholm  if(!gc_destruct_everything && (m->flags & (GC_MARKED|GC_XREFERENCED)) == GC_XREFERENCED)
be39f52000-07-03Martin Stjernholm  gc_fatal(a, 1, "Thing with external reference missed in gc mark pass.\n");
e2d9e62000-06-10Martin Stjernholm  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) 
0816292000-07-03Martin Stjernholm  return !(m->flags & GC_LIVE);
e2d9e62000-06-10Martin Stjernholm }
66ac542000-09-05Henrik Grubbström (Grubba) static void free_obj_arr(void *oa) { struct array *obj_arr = *((struct array **)oa); if (obj_arr) free_array(obj_arr); free(oa); }
51376d2002-12-07Henrik Grubbström (Grubba) /*! @class MasterObject */ /*! @decl void runtime_warning(string subsystem, string msg, mixed|void data) *! *! Called by the Pike runtime to warn about data inconsistencies. *! *! @param subsystem *! Runtime subsystem where the warning was generated. *! Currently the following subsystems may call this function: *! @string *! @value "gc" *! The garbage collector. *! @endstring *! *! @param msg *! Warning message. *! Currently the following messages may be generated: *! @string *! @value "bad_cycle" *! A cycle where the destruction order isn't deterministic *! was detected by the garbage collector. *! *! @[data] will in this case contain an array of the elements *! in the cycle. *! @endstring *! *! @param data *! Optional data that further describes the warning specified by @[msg]. */ /*! @endclass */
e2d9e62000-06-10Martin Stjernholm static void warn_bad_cycles() {
66ac542000-09-05Henrik Grubbström (Grubba)  /* The reason for the extra level of indirection, is that it might * be clobbered by the longjump() in SET_ONERROR otherwise. * (On some architectures longjump() might restore obj_arr's original * value (eg if obj_arr is in a register)). */ struct array **obj_arr_ = (struct array **)xalloc(sizeof(struct array *)); ONERROR tmp; *obj_arr_ = NULL; SET_ONERROR(tmp, free_obj_arr, obj_arr_);
d70a3e2000-07-07Martin Stjernholm 
66ac542000-09-05Henrik Grubbström (Grubba)  {
45d87e2000-07-18Martin Stjernholm  struct gc_frame *p;
e2d9e62000-06-10Martin Stjernholm  unsigned cycle = 0;
66ac542000-09-05Henrik Grubbström (Grubba)  *obj_arr_ = allocate_array(0);
4be85a2000-07-07Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  for (p = kill_list; p;) {
45d87e2000-07-18Martin Stjernholm  if ((cycle = CYCLE(p))) {
e2d9e62000-06-10Martin Stjernholm  push_object((struct object *) p->data);
50ea682003-03-14Henrik Grubbström (Grubba)  dmalloc_touch_svalue(Pike_sp-1);
9b150a2002-05-11Martin Nilsson  *obj_arr_ = append_array(*obj_arr_, --Pike_sp);
e2d9e62000-06-10Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm  p = NEXT(p);
7e8ea32000-08-13Henrik Grubbström (Grubba)  if (p ? ((unsigned)(CYCLE(p) != cycle)) : cycle) {
66ac542000-09-05Henrik Grubbström (Grubba)  if ((*obj_arr_)->size >= 2) {
e2d9e62000-06-10Martin Stjernholm  push_constant_text("gc"); push_constant_text("bad_cycle");
66ac542000-09-05Henrik Grubbström (Grubba)  push_array(*obj_arr_); *obj_arr_ = 0;
e2d9e62000-06-10Martin Stjernholm  SAFE_APPLY_MASTER("runtime_warning", 3); pop_stack();
66ac542000-09-05Henrik Grubbström (Grubba)  *obj_arr_ = allocate_array(0);
e2d9e62000-06-10Martin Stjernholm  }
66ac542000-09-05Henrik Grubbström (Grubba)  else *obj_arr_ = resize_array(*obj_arr_, 0);
e2d9e62000-06-10Martin Stjernholm  } if (!p) break; } }
d70a3e2000-07-07Martin Stjernholm 
66ac542000-09-05Henrik Grubbström (Grubba)  CALL_AND_UNSET_ONERROR(tmp);
e2d9e62000-06-10Martin Stjernholm }
51adb82003-01-12Martin Stjernholm size_t do_gc(void *ignored, int explicit_call)
6930181996-02-25Fredrik Hübinette (Hubbe) {
88ef972004-03-19Martin Stjernholm  ALLOC_COUNT_TYPE start_allocs;
e7fc302004-03-17Martin Stjernholm  size_t start_num_objs, unreferenced;
5ef9052003-01-13Martin Stjernholm  cpu_time_t gc_start_time;
e1be4f2001-07-01Martin Stjernholm  ptrdiff_t objs, pre_kill_objs;
8e5a402004-03-16Martin Stjernholm #if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP) unsigned destroy_count; #endif
db62dc2000-04-14Martin Stjernholm #ifdef PIKE_DEBUG
8e5a402004-03-16Martin Stjernholm  unsigned obj_count;
0c8b8f2001-05-19Martin Stjernholm  ONERROR uwp;
db62dc2000-04-14Martin Stjernholm #endif
6930181996-02-25Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm  if(Pike_in_gc) return 0;
51adb82003-01-12Martin Stjernholm 
0d9f932003-01-14Martin Stjernholm  if (gc_enabled <= 0 && (gc_enabled < 0 || !explicit_call)) {
51adb82003-01-12Martin Stjernholm  num_allocs = 0;
bbd8162003-01-15Martin Stjernholm  alloc_threshold = GC_MAX_ALLOC_THRESHOLD;
51adb82003-01-12Martin Stjernholm  if (gc_evaluator_callback) { remove_callback (gc_evaluator_callback); gc_evaluator_callback = NULL; } return 0; }
7386972001-06-30Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC if(debug_options & GC_RESET_DMALLOC) reset_debug_malloc(); #endif
7bf6232000-04-23Martin Stjernholm  init_gc();
9a6d002001-06-26Fredrik Hübinette (Hubbe)  gc_generation++;
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_PREPARE;
5ef9052003-01-13Martin Stjernholm  gc_start_time = get_cpu_time();
7bf6232000-04-23Martin Stjernholm  gc_debug = d_flag;
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
0c8b8f2001-05-19Martin Stjernholm  SET_ONERROR(uwp, fatal_on_error, "Shouldn't get an exception inside the gc.\n");
1e91212001-07-05Martin Stjernholm  if (gc_is_watching) fprintf(stderr, "## Doing gc while watching for %d things.\n", gc_is_watching);
7bf6232000-04-23Martin Stjernholm #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) 
50d97a2003-02-01Martin Stjernholm  if(GC_VERBOSE_DO(1 ||) gc_trace) {
e7fc302004-03-17Martin Stjernholm  if (gc_destruct_everything) fprintf (stderr, "Destructing all objects... "); else fprintf(stderr,"Garbage collecting... ");
e2d9e62000-06-10Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "\n"));
6bc62b2000-04-14Martin Stjernholm  }
51adb82003-01-12Martin Stjernholm #ifdef PIKE_DEBUG
06983f1996-09-22Fredrik Hübinette (Hubbe)  if(num_objects < 0)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Panic, less than zero objects!\n");
6930181996-02-25Fredrik Hübinette (Hubbe) #endif
0d9f932003-01-14Martin Stjernholm  last_gc=TIME(0);
51adb82003-01-12Martin Stjernholm  start_num_objs = num_objects; start_allocs = num_allocs;
51955c2003-01-11Martin Stjernholm  num_allocs = 0;
4452c12000-02-02Fredrik Hübinette (Hubbe) 
0455ff2003-03-30Martin Stjernholm  /* Object alloc/free and any reference changes are disallowed now. */
08679c2000-04-26Martin Stjernholm 
7bf6232000-04-23Martin Stjernholm #ifdef PIKE_DEBUG
d9d6f02001-06-30Martin Stjernholm  delayed_freed = weak_freed = checked = marked = cycle_checked = live_ref = 0;
8e6d5c2001-07-02Martin Stjernholm  live_rec = frame_rot = 0;
50d97a2003-02-01Martin Stjernholm #endif
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();
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
22aa2f2000-09-04Martin Stjernholm  gc_touch_all_strings();
50d97a2003-02-01Martin Stjernholm #endif
e2d9e62000-06-10Martin Stjernholm  if (n != (unsigned) num_objects)
5aad932002-08-15Marcus Comstedt  Pike_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  }
c94c371996-03-28Fredrik Hübinette (Hubbe) 
0305412003-09-29Martin Stjernholm  /* First we count internal references */
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_CHECK;
6d30f52000-07-11Martin Stjernholm  gc_ext_weak_refs = 0;
0305412003-09-29Martin Stjernholm  #ifdef PIKE_DEBUG mark_externals(); #endif call_callback(& gc_callbacks, NULL);
01c63f2003-04-28Martin Stjernholm  ACCEPT_UNFINISHED_TYPE_FIELDS { gc_check_all_arrays(); gc_check_all_multisets(); gc_check_all_mappings(); gc_check_all_programs(); gc_check_all_objects(); } END_ACCEPT_UNFINISHED_TYPE_FIELDS;
20513c2000-04-12Fredrik Hübinette (Hubbe) 
51adb82003-01-12Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| check: %u references in %d things, "
e1be4f2001-07-01Martin Stjernholm  "counted %"PRINTSIZET"u weak refs\n",
51adb82003-01-12Martin Stjernholm  checked, num_objects, gc_ext_weak_refs));
e2d9e62000-06-10Martin Stjernholm 
7bf6232000-04-23Martin Stjernholm  Pike_in_gc=GC_PASS_MARK;
e2d9e62000-06-10Martin Stjernholm 
49bf8a2000-12-14Martin Stjernholm  /* Anything after and including gc_internal_* in the linked lists
e2d9e62000-06-10Martin Stjernholm  * are considered to lack external references. The mark pass move * externally referenced things in front of these pointers. */
cd451f2004-03-15Martin Stjernholm  gc_internal_array = first_array;
e2d9e62000-06-10Martin Stjernholm  gc_internal_multiset = first_multiset; gc_internal_mapping = first_mapping; gc_internal_program = first_program; gc_internal_object = first_object;
57cfbd2004-03-15Martin Stjernholm  if (gc_destruct_everything) { GC_VERBOSE_DO(fprintf(stderr, "| mark pass skipped - will destruct all objects\n")); } else { /* Next we mark anything with external references. Note that we can * follow the same reference several times, e.g. with shared mapping * data blocks. */ ACCEPT_UNFINISHED_TYPE_FIELDS { gc_mark_all_arrays(); gc_mark_run_queue(); gc_mark_all_multisets(); gc_mark_run_queue(); gc_mark_all_mappings(); gc_mark_run_queue(); gc_mark_all_programs(); gc_mark_run_queue(); gc_mark_all_objects(); gc_mark_run_queue(); #ifdef PIKE_DEBUG if(gc_debug) gc_mark_all_strings();
03f0982000-09-04Henrik Grubbström (Grubba) #endif /* PIKE_DEBUG */
57cfbd2004-03-15Martin Stjernholm  } END_ACCEPT_UNFINISHED_TYPE_FIELDS;
e2d9e62000-06-10Martin Stjernholm 
57cfbd2004-03-15Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| mark: %u markers referenced, %u weak references freed,\n" "| %d things to free, " "got %"PRINTSIZET"u tricky weak refs\n", marked, weak_freed, delayed_freed, gc_ext_weak_refs)); }
c94c371996-03-28Fredrik Hübinette (Hubbe) 
1a12e82000-09-30Martin Stjernholm  {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
1a12e82000-09-30Martin Stjernholm  size_t orig_ext_weak_refs = gc_ext_weak_refs;
d9d6f02001-06-30Martin Stjernholm  obj_count = delayed_freed;
1a12e82000-09-30Martin Stjernholm  max_gc_frames = 0; #endif Pike_in_gc=GC_PASS_CYCLE; /* Now find all cycles in the internal structures. Note that we can * follow the same reference several times, just like in the mark * pass. */ /* 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
1a12e82000-09-30Martin Stjernholm  if (gc_rec_top)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc_rec_top not empty at end of cycle check pass.\n");
1a12e82000-09-30Martin Stjernholm  if (NEXT(&rec_list) || gc_rec_last != &rec_list || gc_rec_top)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Recurse list not empty or inconsistent after cycle check pass.\n");
1a12e82000-09-30Martin Stjernholm  if (gc_ext_weak_refs != orig_ext_weak_refs)
5aad932002-08-15Marcus Comstedt  Pike_fatal("gc_ext_weak_refs changed from %"PRINTSIZET"u "
e1be4f2001-07-01Martin Stjernholm  "to %"PRINTSIZET"u in cycle check pass.\n", orig_ext_weak_refs, gc_ext_weak_refs);
1a12e82000-09-30Martin Stjernholm #endif GC_VERBOSE_DO(fprintf(stderr, "| cycle: %u internal things visited, %u cycle ids used,\n"
d9d6f02001-06-30Martin Stjernholm  "| %u weak references freed, %d more things to free,\n"
8e6d5c2001-07-02Martin Stjernholm  "| %u live recursed frames, %u frame rotations,\n"
1a12e82000-09-30Martin Stjernholm  "| space for %u gc frames used\n", cycle_checked, last_cycle, weak_freed,
8e6d5c2001-07-02Martin Stjernholm  delayed_freed - obj_count, live_rec, frame_rot, max_gc_frames));
1a12e82000-09-30Martin Stjernholm  }
e2d9e62000-06-10Martin Stjernholm 
b13ee62001-06-30Martin Stjernholm  if (gc_ext_weak_refs) { size_t to_free = gc_ext_weak_refs; #ifdef PIKE_DEBUG
d9d6f02001-06-30Martin Stjernholm  obj_count = delayed_freed;
b13ee62001-06-30Martin Stjernholm #endif Pike_in_gc = GC_PASS_ZAP_WEAK; /* Zap weak references from external to internal things. That
3c36c52004-09-22Martin Stjernholm  * occurs when something has both external weak refs and nonweak * cyclic refs from internal things. */
b13ee62001-06-30Martin Stjernholm  gc_zap_ext_weak_refs_in_mappings(); gc_zap_ext_weak_refs_in_arrays();
5b15bb2001-12-10Martin Stjernholm  gc_zap_ext_weak_refs_in_multisets();
b13ee62001-06-30Martin Stjernholm  gc_zap_ext_weak_refs_in_objects(); gc_zap_ext_weak_refs_in_programs(); GC_VERBOSE_DO( fprintf(stderr,
e1be4f2001-07-01Martin Stjernholm  "| zap weak: freed %"PRINTPTRDIFFT"d external weak refs, " "%"PRINTSIZET"u internal still around,\n"
d9d6f02001-06-30Martin Stjernholm  "| %d more things to free\n",
e1be4f2001-07-01Martin Stjernholm  to_free - gc_ext_weak_refs, gc_ext_weak_refs, delayed_freed - obj_count));
b13ee62001-06-30Martin Stjernholm  }
22aa2f2000-09-04Martin Stjernholm  if (gc_debug) { unsigned n;
1e0b962003-05-12Martin Nilsson #ifdef DEBUG_MALLOC
22aa2f2000-09-04Martin Stjernholm  size_t i; struct marker *m;
1e0b962003-05-12Martin Nilsson #endif
22aa2f2000-09-04Martin Stjernholm  Pike_in_gc=GC_PASS_MIDDLETOUCH; 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();
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
22aa2f2000-09-04Martin Stjernholm  gc_touch_all_strings();
50d97a2003-02-01Martin Stjernholm #endif
22aa2f2000-09-04Martin Stjernholm  if (n != (unsigned) num_objects)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Object count wrong in gc; expected %d, got %d.\n", num_objects, n);
22aa2f2000-09-04Martin Stjernholm  get_marker(rec_list.data)->flags |= GC_MIDDLETOUCHED;
ffb3902001-06-26Fredrik Hübinette (Hubbe) #if 0 /* Temporarily disabled - Hubbe */
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
22aa2f2000-09-04Martin Stjernholm #ifdef DEBUG_MALLOC PTR_HASH_LOOP(marker, i, m) if (!(m->flags & (GC_MIDDLETOUCHED|GC_WEAK_FREED)) && dmalloc_is_invalid_memory_block(m->data)) { fprintf(stderr, "Found a stray marker after middletouch pass: "); describe_marker(m); fprintf(stderr, "Describing marker location(s):\n"); debug_malloc_dump_references(m, 2, 1, 0); fprintf(stderr, "Describing thing for marker:\n");
1d938c2001-04-18Martin Stjernholm  Pike_in_gc = 0;
22aa2f2000-09-04Martin Stjernholm  describe(m->data);
1d938c2001-04-18Martin Stjernholm  Pike_in_gc = GC_PASS_MIDDLETOUCH;
5aad932002-08-15Marcus Comstedt  Pike_fatal("Fatal in garbage collector.\n");
22aa2f2000-09-04Martin Stjernholm  }
ffb3902001-06-26Fredrik Hübinette (Hubbe) #endif
50d97a2003-02-01Martin Stjernholm #endif
22aa2f2000-09-04Martin Stjernholm #endif GC_VERBOSE_DO(fprintf(stderr, "| middletouch\n")); }
0455ff2003-03-30Martin Stjernholm  /* Object alloc/free and reference changes are allowed again now. */
e2d9e62000-06-10Martin Stjernholm 
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
49bf8a2000-12-14Martin Stjernholm  /* Now we free the unused stuff. The extra refs to gc_internal_* * added above are removed just before the calls so we'll get the * correct relative positions in them. */
a1b3872003-01-11Martin Stjernholm  unreferenced = 0;
cd451f2004-03-15Martin Stjernholm  if (gc_internal_array)
a1b3872003-01-11Martin Stjernholm  unreferenced += gc_free_all_unreferenced_arrays(); if (gc_internal_multiset) unreferenced += gc_free_all_unreferenced_multisets(); if (gc_internal_mapping) unreferenced += gc_free_all_unreferenced_mappings(); if (gc_internal_object) unreferenced += gc_free_all_unreferenced_objects();
0455ff2003-03-30Martin Stjernholm  /* Note: gc_free_all_unreferenced_objects needs to have the programs * around to handle the free (even when they aren't live). So it's * necessary to free the objects before the programs. */ if (gc_internal_program) unreferenced += gc_free_all_unreferenced_programs();
e2d9e62000-06-10Martin Stjernholm 
fcb3222001-07-05Martin Stjernholm  /* We might occasionally get things to gc_delayed_free that the free * calls above won't find. They're tracked in this list. */ while (free_extra_list) { struct gc_frame *next = free_extra_list->back; union anything u; u.refs = (INT32 *) free_extra_list->data; gc_free_extra_ref(u.refs); free_short_svalue(&u, free_extra_list->u.free_extra_type); debug_really_free_gc_frame(free_extra_list); free_extra_list = next; }
a1b3872003-01-11Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| free: %d unreferenced, %d really freed, " "%u left with live references\n", unreferenced, obj_count - num_objects, live_ref));
e2d9e62000-06-10Martin Stjernholm 
20513c2000-04-12Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
49bf8a2000-12-14Martin Stjernholm  gc_internal_array = (struct array *) (ptrdiff_t) -1; gc_internal_multiset = (struct multiset *) (ptrdiff_t) -1; gc_internal_mapping = (struct mapping *) (ptrdiff_t) -1; gc_internal_program = (struct program *) (ptrdiff_t) -1; gc_internal_object = (struct object *) (ptrdiff_t) -1;
5aad932002-08-15Marcus Comstedt  if(fatal_after_gc) Pike_fatal("%s", 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;
57cfbd2004-03-15Martin Stjernholm  if (last_cycle && Pike_interpreter.evaluator_stack && !gc_destruct_everything) {
e2d9e62000-06-10Martin Stjernholm  objs -= num_objects; warn_bad_cycles(); objs += num_objects; }
8e5a402004-03-16Martin Stjernholm #if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP)
e2d9e62000-06-10Martin Stjernholm  destroy_count = 0; #endif
fb5e412000-07-18Martin Stjernholm  while (kill_list) { struct gc_frame *next = NEXT(kill_list);
e2d9e62000-06-10Martin Stjernholm  struct object *o = (struct object *) kill_list->data; #ifdef PIKE_DEBUG
0db2c02003-02-14Martin Stjernholm  if (!(kill_list->frameflags & GC_ON_KILL_LIST)) gc_fatal(o, 0, "Kill list element hasn't got the proper flag.\n");
45d87e2000-07-18Martin Stjernholm  if ((get_marker(kill_list->data)->flags & (GC_LIVE|GC_LIVE_OBJ)) != (GC_LIVE|GC_LIVE_OBJ))
0db2c02003-02-14Martin Stjernholm  gc_fatal(o, 0, "Invalid object on kill list.\n");
f3c7152001-04-14Fredrik Hübinette (Hubbe)  if (o->prog && (o->prog->flags & PROGRAM_USES_PARENT) && PARENT_INFO(o)->parent && !PARENT_INFO(o)->parent->prog && get_marker(PARENT_INFO(o)->parent)->flags & GC_LIVE_OBJ)
45d87e2000-07-18Martin Stjernholm  gc_fatal(o, 0, "GC destructed parent prematurely.\n");
e2d9e62000-06-10Martin Stjernholm #endif
d9d6f02001-06-30Martin Stjernholm  GC_VERBOSE_DO( fprintf(stderr, "| Killing %p with %d refs", o, o->refs); if (o->prog) { INT32 line;
50edc82001-07-13Henrik Grubbström (Grubba)  struct pike_string *file = get_program_line (o->prog, &line); fprintf(stderr, ", prog %s:%d\n", file->str, line); free_string(file);
d9d6f02001-06-30Martin Stjernholm  } else fputs(", is destructed\n", stderr); );
e2d9e62000-06-10Martin Stjernholm  destruct(o); free_object(o); gc_free_extra_ref(o);
8e5a402004-03-16Martin Stjernholm #if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP)
e2d9e62000-06-10Martin Stjernholm  destroy_count++; #endif
63709a2000-07-18Martin Stjernholm  debug_really_free_gc_frame(kill_list);
fb5e412000-07-18Martin Stjernholm  kill_list = next;
e2d9e62000-06-10Martin Stjernholm  } 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  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();
0838862000-09-15Henrik Grubbström (Grubba)  /* gc_touch_all_strings(); */
e2d9e62000-06-10Martin Stjernholm  if (n != (unsigned) num_objects)
5aad932002-08-15Marcus Comstedt  Pike_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  }
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
60c15a2003-08-20Martin Stjernholm  if (gc_extra_refs) { size_t e; fprintf (stderr, "Lost track of %d extra refs to things in gc.\n" "Searching for marker(s) with extra refs:\n", gc_extra_refs);
57cfbd2004-03-15Martin Stjernholm  for (e = 0; e < marker_hash_table_size; e++) { struct marker *s = marker_hash_table[e], *m; for (m = s; m;) {
60c15a2003-08-20Martin Stjernholm  if (m->flags & GC_GOT_EXTRA_REF) { fprintf (stderr, "========================================\n" "Found marker with extra ref: "); describe_marker (m); fprintf (stderr, "Describing the thing pointed to:\n"); describe (m->data); }
57cfbd2004-03-15Martin Stjernholm  m = m->next; /* The marker might be moved to the head of the chain via * describe() above, so do this to avoid infinite recursion. * Some entries in the chain might be missed, but I don't want * to bother. */ if (m == s) break; } }
60c15a2003-08-20Martin Stjernholm  fprintf (stderr, "========================================\n" "Done searching for marker(s) with extra refs.\n");
5aad932002-08-15Marcus Comstedt  Pike_fatal("Lost track of %d extra refs to things in gc.\n", gc_extra_refs);
60c15a2003-08-20Martin Stjernholm  }
5aad932002-08-15Marcus Comstedt  if(fatal_after_gc) Pike_fatal("%s", fatal_after_gc);
7bf6232000-04-23Martin Stjernholm #endif Pike_in_gc=0;
b51e6d1998-02-18Fredrik Hübinette (Hubbe)  exit_gc();
06983f1996-09-22Fredrik Hübinette (Hubbe) 
51adb82003-01-12Martin Stjernholm  /* Calculate the next alloc_threshold. */ { double multiplier, new_threshold;
5ef9052003-01-13Martin Stjernholm  cpu_time_t last_non_gc_time, last_gc_time;
51adb82003-01-12Martin Stjernholm  /* If we're at an automatic and timely gc then start_allocs == * alloc_threshold and we're using gc_average_slowness in the * decaying average calculation. Otherwise this is either an * explicit call (start_allocs < alloc_threshold) or the gc has * been delayed past its due time (start_allocs > * alloc_threshold), and in those cases we adjust the multiplier
e7fc302004-03-17Martin Stjernholm  * to give the appropriate weight to this last instance. */
51adb82003-01-12Martin Stjernholm  multiplier=pow(gc_average_slowness, (double) start_allocs / (double) alloc_threshold); /* Comparisons to avoid that overflows mess up the statistics. */ if (gc_start_time > last_gc_end_time) { last_non_gc_time = gc_start_time - last_gc_end_time; non_gc_time = non_gc_time * multiplier + last_non_gc_time * (1.0 - multiplier); }
dd25062003-02-09Martin Stjernholm  else last_non_gc_time = (cpu_time_t) -1;
bbd8162003-01-15Martin Stjernholm  last_gc_end_time = get_cpu_time();
51adb82003-01-12Martin Stjernholm  if (last_gc_end_time > gc_start_time) { last_gc_time = last_gc_end_time - gc_start_time; gc_time = gc_time * multiplier + last_gc_time * (1.0 - multiplier); }
dd25062003-02-09Martin Stjernholm  else last_gc_time = (cpu_time_t) -1;
51adb82003-01-12Martin Stjernholm  /* At this point, unreferenced contains the number of things that * were without external references during the check and mark * passes. In the process of freeing them, destroy functions might * have been called which means anything might have happened. * Therefore we use that figure instead of the difference between * the number of allocated things to measure the amount of * garbage. */ last_garbage_ratio = (double) unreferenced / start_num_objs; objects_alloced = objects_alloced * multiplier + start_allocs * (1.0 - multiplier); objects_freed = objects_freed * multiplier + unreferenced * (1.0 - multiplier);
dd25062003-02-09Martin Stjernholm  if (last_non_gc_time == (cpu_time_t) -1 || gc_time / non_gc_time <= gc_time_ratio) {
51adb82003-01-12Martin Stjernholm  /* Calculate the new threshold by adjusting the average * threshold (objects_alloced) with the ratio between the wanted * garbage at the next gc (gc_garbage_ratio_low * * start_num_objs) and the actual average garbage * (objects_freed). (Where the +1.0's come from I don't know. * Perhaps they're to avoid division by zero. /mast) */ new_threshold = (objects_alloced+1.0) * (gc_garbage_ratio_low * start_num_objs) / (objects_freed+1.0); last_garbage_strategy = GARBAGE_RATIO_LOW; } else { new_threshold = (objects_alloced+1.0) * (gc_garbage_ratio_high * start_num_objs) / (objects_freed+1.0); last_garbage_strategy = GARBAGE_RATIO_HIGH; }
6930181996-02-25Fredrik Hübinette (Hubbe) 
51955c2003-01-11Martin Stjernholm #if 0
51adb82003-01-12Martin Stjernholm  /* Afaics this is to limit the growth of the threshold to avoid * that a single sudden allocation spike causes a very long gc * interval the next time. Now when the bug in the decaying * average calculation is fixed there should be no risk for that, * at least not in any case when this would help. /mast */ if(alloc_threshold + start_allocs < new_threshold) new_threshold = (double)(alloc_threshold + start_allocs);
51955c2003-01-11Martin Stjernholm #endif
6acd502000-05-01Fredrik Noring 
51adb82003-01-12Martin Stjernholm  if(new_threshold < GC_MIN_ALLOC_THRESHOLD)
e7fc302004-03-17Martin Stjernholm  alloc_threshold = GC_MIN_ALLOC_THRESHOLD;
51adb82003-01-12Martin Stjernholm  else if(new_threshold > GC_MAX_ALLOC_THRESHOLD)
e7fc302004-03-17Martin Stjernholm  alloc_threshold = GC_MAX_ALLOC_THRESHOLD; else
88ef972004-03-19Martin Stjernholm  alloc_threshold = (ALLOC_COUNT_TYPE) new_threshold;
51adb82003-01-12Martin Stjernholm 
dd25062003-02-09Martin Stjernholm  if (!explicit_call && last_gc_time != (cpu_time_t) -1) {
9699fc2003-02-10Martin Stjernholm #if CPU_TIME_IS_THREAD_LOCAL == PIKE_YES
0431312003-02-15Henrik Grubbström (Grubba)  Pike_interpreter.thread_state->auto_gc_time += last_gc_time;
9699fc2003-02-10Martin Stjernholm #elif CPU_TIME_IS_THREAD_LOCAL == PIKE_NO
f4a9952003-02-08Martin Stjernholm  auto_gc_time += last_gc_time; #endif }
50d97a2003-02-01Martin Stjernholm  if(GC_VERBOSE_DO(1 ||) gc_trace)
51adb82003-01-12Martin Stjernholm  {
e7fc302004-03-17Martin Stjernholm  char timestr[40];
dd25062003-02-09Martin Stjernholm  if (last_gc_time != (cpu_time_t) -1)
e7fc302004-03-17Martin Stjernholm  sprintf (timestr, ", %ld ms", (long) (last_gc_time / (CPU_TIME_TICKS / 1000)));
51adb82003-01-12Martin Stjernholm  else
e7fc302004-03-17Martin Stjernholm  timestr[0] = 0; #ifdef DO_PIKE_CLEANUP if (gc_destruct_everything) fprintf(stderr, "done (%"PRINTSIZET"d was destructed)%s\n", destroy_count, timestr); else #endif
5ef9052003-01-13Martin Stjernholm  fprintf(stderr, "done (%"PRINTSIZET"d of %"PRINTSIZET"d "
e7fc302004-03-17Martin Stjernholm  "was unreferenced)%s\n", unreferenced, start_num_objs, timestr);
51adb82003-01-12Martin Stjernholm  } }
6930181996-02-25Fredrik Hübinette (Hubbe) 
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
0c8b8f2001-05-19Martin Stjernholm  UNSET_ONERROR (uwp);
8e6d5c2001-07-02Martin Stjernholm  if (max_gc_frames > max_tot_gc_frames) max_tot_gc_frames = max_gc_frames; tot_cycle_checked += cycle_checked; tot_live_rec += live_rec, tot_frame_rot += frame_rot;
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 
8e5a402004-03-16Martin Stjernholm #ifdef DO_PIKE_CLEANUP if (gc_destruct_everything) return destroy_count; #endif
a1b3872003-01-11Martin Stjernholm  return unreferenced;
6930181996-02-25Fredrik Hübinette (Hubbe) }
323e2b2002-11-25Martin Nilsson /*! @decl mapping(string:int|float) gc_status() *! @belongs Debug
7c0df72001-02-06Henrik Grubbström (Grubba)  *! *! Get statistics from the garbage collector. *! *! @returns *! A mapping with the following content will be returned: *! @mapping *! @member int "num_objects"
5ef9052003-01-13Martin Stjernholm  *! Number of arrays, mappings, multisets, objects and programs.
7c0df72001-02-06Henrik Grubbström (Grubba)  *! @member int "num_allocs"
5ef9052003-01-13Martin Stjernholm  *! Number of memory allocations since the last gc run.
7c0df72001-02-06Henrik Grubbström (Grubba)  *! @member int "alloc_threshold"
5ef9052003-01-13Martin Stjernholm  *! Threshold for "num_allocs" when another automatic gc run is *! scheduled.
51adb82003-01-12Martin Stjernholm  *! @member float "projected_garbage" *! Estimation of the current amount of garbage.
7c0df72001-02-06Henrik Grubbström (Grubba)  *! @member int "objects_alloced"
5ef9052003-01-13Martin Stjernholm  *! Decaying average over the number of allocated objects *! between gc runs.
7c0df72001-02-06Henrik Grubbström (Grubba)  *! @member int "objects_freed"
5ef9052003-01-13Martin Stjernholm  *! Decaying average over the number of freed objects in each gc *! run.
51adb82003-01-12Martin Stjernholm  *! @member float "last_garbage_ratio" *! Garbage ratio in the last gc run. *! @member int "non_gc_time"
5ef9052003-01-13Martin Stjernholm  *! Decaying average over the CPU milliseconds spent outside the *! garbage collector.
51adb82003-01-12Martin Stjernholm  *! @member int "gc_time"
5ef9052003-01-13Martin Stjernholm  *! Decaying average over the CPU milliseconds spent inside the *! garbage collector.
51adb82003-01-12Martin Stjernholm  *! @member string "last_garbage_strategy"
5ef9052003-01-13Martin Stjernholm  *! The garbage accumulation goal that the gc aimed for when *! setting "alloc_threshold" in the last run. The value is *! either "garbage_ratio_low" or "garbage_ratio_high", which *! corresponds to the gc parameters with the same names in *! @[Pike.gc_parameters].
0d9f932003-01-14Martin Stjernholm  *! @member int "last_gc" *! Time when the garbage-collector last ran.
7c0df72001-02-06Henrik Grubbström (Grubba)  *! @endmapping *! *! @seealso
51adb82003-01-12Martin Stjernholm  *! @[gc()], @[Pike.gc_parameters()]
7c0df72001-02-06Henrik Grubbström (Grubba)  */
1637c42000-02-01Fredrik Hübinette (Hubbe) void f__gc_status(INT32 args) {
8e6d5c2001-07-02Martin Stjernholm  int size = 0;
1637c42000-02-01Fredrik Hübinette (Hubbe)  pop_n_elems(args); push_constant_text("num_objects"); push_int(num_objects);
8e6d5c2001-07-02Martin Stjernholm  size++;
1637c42000-02-01Fredrik Hübinette (Hubbe)  push_constant_text("num_allocs");
e7fc302004-03-17Martin Stjernholm  push_int64(num_allocs);
8e6d5c2001-07-02Martin Stjernholm  size++;
1637c42000-02-01Fredrik Hübinette (Hubbe)  push_constant_text("alloc_threshold");
905e0c2000-08-11Henrik Grubbström (Grubba)  push_int64(alloc_threshold);
8e6d5c2001-07-02Martin Stjernholm  size++;
1637c42000-02-01Fredrik Hübinette (Hubbe) 
51adb82003-01-12Martin Stjernholm  push_constant_text("projected_garbage"); push_float(DO_NOT_WARN((FLOAT_TYPE)(objects_freed * (double) num_allocs / (double) alloc_threshold))); size++;
1637c42000-02-01Fredrik Hübinette (Hubbe)  push_constant_text("objects_alloced");
a5cd6a2001-09-24Henrik Grubbström (Grubba)  push_int64(DO_NOT_WARN((INT64)objects_alloced));
8e6d5c2001-07-02Martin Stjernholm  size++;
1637c42000-02-01Fredrik Hübinette (Hubbe)  push_constant_text("objects_freed");
a5cd6a2001-09-24Henrik Grubbström (Grubba)  push_int64(DO_NOT_WARN((INT64)objects_freed));
8e6d5c2001-07-02Martin Stjernholm  size++;
1637c42000-02-01Fredrik Hübinette (Hubbe) 
51adb82003-01-12Martin Stjernholm  push_constant_text("last_garbage_ratio"); push_float(DO_NOT_WARN((FLOAT_TYPE) last_garbage_ratio));
8e6d5c2001-07-02Martin Stjernholm  size++;
1637c42000-02-01Fredrik Hübinette (Hubbe) 
51adb82003-01-12Martin Stjernholm  push_constant_text("non_gc_time"); push_int64(DO_NOT_WARN((INT64) non_gc_time)); size++; push_constant_text("gc_time"); push_int64(DO_NOT_WARN((INT64) gc_time)); size++; push_constant_text ("last_garbage_strategy"); switch (last_garbage_strategy) { case GARBAGE_RATIO_LOW: push_constant_text ("garbage_ratio_low"); break; case GARBAGE_RATIO_HIGH: push_constant_text ("garbage_ratio_high"); break; #ifdef PIKE_DEBUG default: Pike_fatal ("Unknown last_garbage_strategy %d\n", last_garbage_strategy); #endif }
8e6d5c2001-07-02Martin Stjernholm  size++;
1637c42000-02-01Fredrik Hübinette (Hubbe) 
0d9f932003-01-14Martin Stjernholm  push_constant_text("last_gc"); push_int64(last_gc); size++;
8e6d5c2001-07-02Martin Stjernholm  f_aggregate_mapping(size * 2);
1637c42000-02-01Fredrik Hübinette (Hubbe) }
5da0872000-08-22Henrik Grubbström (Grubba) 
51adb82003-01-12Martin Stjernholm void dump_gc_info(void) { fprintf(stderr,"Current number of things : %d\n",num_objects);
88ef972004-03-19Martin Stjernholm  fprintf(stderr,"Allocations since last gc : "PRINT_ALLOC_COUNT_TYPE"\n", num_allocs); fprintf(stderr,"Threshold for next gc : "PRINT_ALLOC_COUNT_TYPE"\n", alloc_threshold);
51adb82003-01-12Martin Stjernholm  fprintf(stderr,"Projected current garbage : %f\n", objects_freed * (double) num_allocs / (double) alloc_threshold); fprintf(stderr,"Avg allocs between gc : %f\n",objects_alloced); fprintf(stderr,"Avg frees per gc : %f\n",objects_freed); fprintf(stderr,"Garbage ratio in last gc : %f\n", last_garbage_ratio);
bbd8162003-01-15Martin Stjernholm  fprintf(stderr,"Avg cpu "CPU_TIME_UNIT" between gc : %f\n", non_gc_time); fprintf(stderr,"Avg cpu "CPU_TIME_UNIT" in gc : %f\n", gc_time);
51adb82003-01-12Martin Stjernholm  fprintf(stderr,"Avg time ratio in gc : %f\n", gc_time / non_gc_time); fprintf(stderr,"Garbage strategy in last gc: %s\n", last_garbage_strategy == GARBAGE_RATIO_LOW ? "garbage_ratio_low" : last_garbage_strategy == GARBAGE_RATIO_HIGH ? "garbage_ratio_high" : "???"); #ifdef PIKE_DEBUG fprintf(stderr,"Max used gc frames : %u\n", max_tot_gc_frames); fprintf(stderr,"Live recursed ratio : %g\n", (double) tot_live_rec / tot_cycle_checked); fprintf(stderr,"Frame rotation ratio : %g\n", (double) tot_frame_rot / tot_cycle_checked); #endif fprintf(stderr,"in_gc : %d\n", Pike_in_gc); }
5da0872000-08-22Henrik Grubbström (Grubba) void cleanup_gc(void) { #ifdef PIKE_DEBUG if (gc_evaluator_callback) { remove_callback(gc_evaluator_callback); gc_evaluator_callback = NULL; } #endif /* PIKE_DEBUG */ }