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.
4195ac2008-07-24Martin Stjernholm || $Id: gc.c,v 1.322 2008/07/24 20:02:43 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"
6930181996-02-25Fredrik Hübinette (Hubbe) #include "gc.h" #include "main.h"
c095962008-05-11Martin Stjernholm 
dc296b1997-10-21Fredrik Hübinette (Hubbe) #include <math.h>
c095962008-05-11Martin Stjernholm #include <assert.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 
5b12752007-05-23Martin Stjernholm /* The gc will free all things with no external nonweak references * that isn't referenced by live objects. An object is considered * "live" if it contains code that must be executed when it is * destructed; see gc_object_is_live for details. 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:
e2d9e62000-06-10Martin Stjernholm  * * 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
e7634f2007-05-13Martin Stjernholm  * the cycle is resolved by disregarding the weaker reference, and * A is therefore destructed before B. * o If a cycle is resolved through disregarding a weaker reference * according to the preceding rule, and there is another cycle * without weak references which also gets resolved through * disregarding the same reference, then the other cycle won't be * resolved by disregarding some other reference.
e2d9e62000-06-10Martin Stjernholm  * 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 */
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. */
4195ac2008-07-24Martin Stjernholm int got_unlinked_things;
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
e7634f2007-05-13Martin Stjernholm size_t gc_ext_weak_refs;
4452c12000-02-02Fredrik Hübinette (Hubbe) 
e7634f2007-05-13Martin Stjernholm static double objects_alloced = 0.0; static double objects_freed = 0.0; static double gc_time = 0.0, non_gc_time = 0.0; static cpu_time_t last_gc_end_time = 0;
247f732007-06-10Martin Stjernholm #ifdef CPU_TIME_MIGHT_NOT_BE_THREAD_LOCAL
e7634f2007-05-13Martin Stjernholm cpu_time_t auto_gc_time = 0; #endif
1bad5c2005-04-14Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm struct link_frame /* See cycle checking blurb below. */
1bad5c2005-04-14Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  void *data; struct link_frame *prev; /* Previous frame in the link stack. */ gc_cycle_check_cb *checkfn; /* Function to call to recurse the thing. */ int weak; /* Weak flag to checkfn. */
1bad5c2005-04-14Martin Stjernholm };
e7634f2007-05-13Martin Stjernholm struct gc_rec_frame /* See cycle checking blurb below. */
1bad5c2005-04-14Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  void *data; int rf_flags;
3b7f9f2007-06-17Martin Stjernholm  struct gc_rec_frame *prev; /* The previous frame in the recursion stack. * NULL for frames not in the stack (i.e. on a * cycle piece list or in the kill list). */ struct gc_rec_frame *next; /* The next frame in the recursion stack or the * kill list. Undefined for frames on cycle * piece lists. */ struct gc_rec_frame *cycle_id;/* For a frame in the recursion stack: The * cycle identifier frame. * For a frame on a cycle piece list: The frame * in the recursion stack whose cycle piece * list this frame is in. */ struct gc_rec_frame *cycle_piece;/* The start of the cycle piece list for * frames on the recursion stack, or the next * frame in the list for frames in cycle piece * lists. */
e7634f2007-05-13Martin Stjernholm  union {
3b7f9f2007-06-17Martin Stjernholm  struct link_frame *link_top;/* The top of the link stack for frames on the * recursion stack. */ struct gc_rec_frame *last_cycle_piece;/* In the first frame on a cycle * piece list, this is used to point to the * last frame in the list. */
e7634f2007-05-13Martin Stjernholm  } u;
1bad5c2005-04-14Martin Stjernholm };
e7634f2007-05-13Martin Stjernholm /* rf_flags bits. */
e30c812008-05-13Martin Stjernholm #define GC_PREV_WEAK 0x0001 #define GC_PREV_STRONG 0x0002 #define GC_PREV_BROKEN 0x0004 #define GC_MARK_LIVE 0x0008 #define GC_ON_KILL_LIST 0x0010
e7634f2007-05-13Martin Stjernholm #ifdef PIKE_DEBUG
e30c812008-05-13Martin Stjernholm #define GC_ON_CYCLE_PIECE_LIST 0x0020 #define GC_FRAME_FREED 0x0040 #define GC_FOLLOWED_NONSTRONG 0x0080 #define GC_IS_VALID_CP_CYCLE_ID 0x0100
e7634f2007-05-13Martin Stjernholm #endif static struct gc_rec_frame sentinel_frame = { (void *) (ptrdiff_t) -1, 0, (struct gc_rec_frame *) (ptrdiff_t) -1, (struct gc_rec_frame *) (ptrdiff_t) -1, &sentinel_frame, /* Recognize as cycle id frame. */ (struct gc_rec_frame *) (ptrdiff_t) -1, {(struct link_frame *) (ptrdiff_t) -1}
1bad5c2005-04-14Martin Stjernholm };
e7634f2007-05-13Martin Stjernholm static struct gc_rec_frame *stack_top = &sentinel_frame; static struct gc_rec_frame *kill_list = &sentinel_frame; /* Cycle checking * * When a thing is recursed into, a gc_rec_frame is pushed onto the * recursion stack whose top pointer is stack_top. After that the * links emanating from that thing are collected through the
c095962008-05-11Martin Stjernholm  * gc_cycle_check_* functions and pushed as link_frames onto a link
e7634f2007-05-13Martin Stjernholm  * stack that is specific to the rec frame. gc_rec_frame.u.link_top is * the top pointer of that stack. The link frames are then popped off * again one by one. If the thing that the link points to hasn't been * visited already then it's recursed, which means that the link frame * is popped off the link stack and a new rec frame is pushed onto the * main stack instead. * * When a reference is followed to a thing which has a rec frame * (either on the stack or on a cycle piece list - see below), we have * a cycle. However, if that reference is weak (or becomes weak after * rotation - see below), it's still not regarded as a cycle since * weak refs always are eligible to be broken to resolve cycles. *
3b7f9f2007-06-17Martin Stjernholm  * A sequence of frames on the recursion stack forms a cycle iff they * have the same value in gc_rec_frame.cycle_id. A cycle is always * continuous on the stack. * * Furthermore, the cycle_ids always point to the first (deepest) * frame on the stack that is part of the cycle. That frame is called * the "cycle identifier frame" since all frames in the cycle will end * up there if the cycle pointers are followed transitively. The * cycle_id pointer in the cycle identifier frame points to itself. * Every frame is initially treated as a cycle containing only itself.
e7634f2007-05-13Martin Stjernholm  * * When the recursion leaves a thing, the rec frame is popped off the * stack. If the frame is part of a cycle that isn't finished at that * point, it's not freed but instead linked onto the cycle piece list * in gc_rec_frame.cycle_piece of the parent rec frame (which * necessarily is part of the same cycle). That is done to detect * cyclic refs that end up at the popped frame later on. * * The cycle_id pointers for frames on cycle piece lists point back * towards the rec frame that still is on the stack, but not past it * to the cycle id frame (which might be further back in the stack). * Whenever cycle_id pointer chains are traversed to find the root of * a cycle piece list, they are compacted to avoid O(n) complexity. * * The current tentative destruct order is described by the order on * the stack and the attached cycle piece lists: The thing that's
3b7f9f2007-06-17Martin Stjernholm  * deepest in the stack is destructed first and the recursion stack * has precedence over the cycle piece list (the reason for that is * explained later). To illustrate:
e7634f2007-05-13Martin Stjernholm  * ,- stack_top * v
3b7f9f2007-06-17Martin Stjernholm  * t1 <=> t2 <=> ... <=> t3 * | | `-> t4 -> ... -> t5 * | `-> t6 -> ... -> t7 * `-> t8 -> ... -> t9
e7634f2007-05-13Martin Stjernholm  * * Here <=> represents links on the recursion stack and -> links in * the cycle piece lists. The tentative destruct order for these * things is the same as the numbering above. * * Since we strive to keep the refs intact during destruction, the * above means that the refs which have priority to be kept intact * should point towards the top of the stack and towards the end of * the cycle piece lists. * * To allow rotations, the recursion stack is a double linked list * using gc_rec_frame.prev and gc_rec_frame.next. Rotations are the * operation used to manipulate the order to avoid getting a * prioritized link pointing in the wrong direction: * ,- stack_top * weak v * t1 <=> ... <=> t2 <=> ... <=> t3 <-> t4 <=> ... <=> t5 *
3b7f9f2007-06-17Martin Stjernholm  * If a nonweak backward pointer from t5 to t2 is encountered here, we * should prefer to break(*) the weak ref between t3 and t4. The stack * is therefore rotated to become:
e7634f2007-05-13Martin Stjernholm  * ,- stack_top * broken v * t1 <=> ... <#> t4 <=> ... <=> t5 <=> t2 <=> ... <=> t3 * * The section to rotate always ends at the top of the stack. * * The strength of the refs along the stack links are represented as * follows: * * o Things with a strong ref between them are kept next to each * other, and the second (the one being referenced by the strong * ref) has the GC_PREV_STRONG bit set. A rotation never breaks the * list inside a sequence of strong refs. * * o The GC_PREV_WEAK bit is set in the next frame for every link on * the stack where no preceding frame reference any following frame * with anything but weak refs. * * o GC_PREV_BROKEN is set in frames that are rotated back, i.e. t4 * in the example above. This is used to break later cycles in the * same position when they can't be broken at a weak link. *
3b7f9f2007-06-17Martin Stjernholm  * If a nonweak backward pointer is found and there are no weak refs * on the stack to break at, the section from the top of the stack * down to the thing referenced by the backward pointer is marked up * as a cycle (possibly extending the cycle which that thing already * belongs to). Therefore weak refs never occur inside cycles. *
e7634f2007-05-13Martin Stjernholm  * Several separate cycles may be present on the stack simultaneously. * That happens when a subcycle which is referenced one way from an * earlier cycle is encountered. E.g. * * L--. L--. * t1 t2 -> t3 t4 * `--7 `--7 * * where the visit order is t1, t2, t3 and then t4. Because of the * stack which causes a subcycle to always be added to the top, it can
3b7f9f2007-06-17Martin Stjernholm  * be handled independently of the earlier cycles, and those earlier * cycles can also be extended later on when the subcycle has been * popped off. If a ref from the subcycle to an earlier cycle is * found, that means that both are really the same cycle, and the * frames in the former subcycle will instead become a cycle piece * list on a frame in the former preceding cycle. * * Cycles are always kept continuous on the recursion stack. Since * breaking a weak ref doesn't mark up a cycle, it's necessary to * rotate between whole cycles when a weak ref is broken. I.e: * * weak * ... <=> t1a <=> t1b <=> t1c <=> ... <=> t2 <-> t3 <=> ... <=> t4 * * Here all the t1 things are members of a cycle, with t1a being the * first and t1c the last. Let's say a nonweak pointer is found from * t4 to t1b, and the weak link between t2 and t3 is chosen to be * broken. In this case the whole t1 cycle is rotated up: * * broken * ... <#> t3 <=> ... <=> t4 <=> t1a <=> t1b <=> t1c <=> ... <=> t2 * * This way the t1 cycle can continue to be processed independently * and possibly be popped off separately from the segment between t3 * and t4.
e7634f2007-05-13Martin Stjernholm  * * Since the link frames are kept in substacks attached to the rec * frames, they get rotated with the rec frames. This has the effect * that the links from the top rec frame on the stack always are * tested first. That is necessary to avoid clobbering weak ref * partitions. Example: * * weak weak * t1 <=> t2 <-> t3 <=> t4 <-> t5 *
3b7f9f2007-06-17Martin Stjernholm  * A nonweak ref is found from t5 to t2. We get this after rotation * (assuming t1 and t2 aren't part of the same cycle):
e7634f2007-05-13Martin Stjernholm  * * broken weak * t1 <#> t5 <=> t2 <-> t3 <=> t4 * * Now, if we would continue to follow the links from t5 and encounter * a new thing t7, we'd have to add it to the top. If that ref isn't * weak we'd have to blank out the weak flag which could be used in * other rotations above t5 (e.g. if a normal ref from t4 to t2 is * encountered). To avoid this we do the t4 links instead and continue * with t5 when t4, t3 and t2 are done. * * As said earlier, rec frames are moved to cycle piece lists when * they are popped off while being part of unfinished cycles. Since * there are no more outgoing refs at that point, there can be no more * rotations that affect the order between the rec frame and its * predecessor. Therefore the order on a cycle piece list is optimal * (in as far as the gc destruct order policy goes). Any further * rotations can move the predecessor around, but it can always be
3b7f9f2007-06-17Martin Stjernholm  * treated as one unit together with its cycle piece list.
e7634f2007-05-13Martin Stjernholm  * * If the preceding frame already has a cycle piece list when a rec * frame should be added to it, the rec frame (and its attached cycle * piece list) is linked in before that list. That since the rec frame * might have refs to the earlier cycle piece list, but the opposite * can't happen. * * When a cycle identifier frame is popped off the stack, the frame * together with its cycle piece list represent the complete cycle, * and the list holds an optimal order for destructing it. The frames * are freed at that point, except for the ones which correspond to * live objects, which instead are linked in order into the beginning * of the kill list. That list, whose beginning is pointed to by * kill_list, holds the final destruct order for all live objects. * * Note that the complete cycle has to be added to the kill list at * once since all live objects that are referenced single way from the * cycle should be destructed later and must therefore be put on the * kill list before the cycle. * * The cycle check functions might recurse another round through the * frames that have been recursed already, to propagate the GC_LIVE * flag to things that have been found to be referenced from live * objects. In this mode a single dummy rec frame with the * GC_MARK_LIVE bit is pushed on the recursion stack, and all link * frames are stacked in it, regardless of the things they originate
3b7f9f2007-06-17Martin Stjernholm  * from. Nothing else happens while this is done, i.e. no rotations * and so forth, so the dummy frame always stays at the top until it's * removed again.
e7634f2007-05-13Martin Stjernholm  * * *) Here "breaking" a ref doesn't mean that it actually gets * zeroed out. It's only disregarded to resolve the cycle to * produce an optimal destruct order. I.e. it will still be intact * when the first object in the cycle is destructed, and it will * only be zeroed when the thing it points to has been destructed. */
1bad5c2005-04-14Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm /* The free extra list. See note in gc_delayed_free. */ struct free_extra_frame
45d87e2000-07-18Martin Stjernholm { void *data;
e7634f2007-05-13Martin Stjernholm  struct free_extra_frame *next; /* Next pointer. */
1bad5c2005-04-14Martin Stjernholm  int type; /* The type of the thing. */ };
e7634f2007-05-13Martin Stjernholm static struct free_extra_frame *free_extra_list = NULL;
1bad5c2005-04-14Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm #ifdef PIKE_DEBUG static unsigned delayed_freed, weak_freed, checked, marked, cycle_checked, live_ref; static unsigned mark_live, frame_rot, link_search; static unsigned gc_extra_refs = 0; static unsigned tot_cycle_checked = 0, tot_mark_live = 0, tot_frame_rot = 0; static unsigned gc_rec_frame_seq_max; #endif static unsigned rec_frames, link_frames, free_extra_frames; static unsigned max_rec_frames, max_link_frames; static unsigned tot_max_rec_frames = 0, tot_max_link_frames = 0, tot_max_free_extra_frames = 0; #undef INIT_BLOCK #define INIT_BLOCK(f) do { \ if (++rec_frames > max_rec_frames) \ max_rec_frames = rec_frames; \ } while (0) #undef EXIT_BLOCK #define EXIT_BLOCK(f) do { \ DO_IF_DEBUG ({ \ if (f->rf_flags & GC_FRAME_FREED) \ gc_fatal (f->data, 0, "Freeing gc_rec_frame twice.\n"); \ f->rf_flags |= GC_FRAME_FREED; \ f->u.link_top = (struct link_frame *) (ptrdiff_t) -1; \ f->prev = f->next = f->cycle_id = f->cycle_piece = \ (struct gc_rec_frame *) (ptrdiff_t) -1; \ }); \ rec_frames--; \ } while (0) BLOCK_ALLOC_FILL_PAGES (gc_rec_frame, 2) /* Link and free_extra frames are approximately the same size, so let * them share block_alloc area. */ struct ba_mixed_frame
1bad5c2005-04-14Martin Stjernholm {
45d87e2000-07-18Martin Stjernholm  union {
e7634f2007-05-13Martin Stjernholm  struct link_frame link; struct free_extra_frame free_extra; struct ba_mixed_frame *next; /* For block_alloc internals. */
45d87e2000-07-18Martin Stjernholm  } u; }; #undef BLOCK_ALLOC_NEXT
1bad5c2005-04-14Martin Stjernholm #define BLOCK_ALLOC_NEXT u.next
e7634f2007-05-13Martin Stjernholm #undef INIT_BLOCK #define INIT_BLOCK(f) #undef EXIT_BLOCK #define EXIT_BLOCK(f)
45d87e2000-07-18Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm BLOCK_ALLOC_FILL_PAGES (ba_mixed_frame, 2)
1bad5c2005-04-14Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm static INLINE struct link_frame *alloc_link_frame()
1bad5c2005-04-14Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  struct ba_mixed_frame *f = alloc_ba_mixed_frame(); if (++link_frames > max_link_frames) max_link_frames = link_frames; return (struct link_frame *) f;
1bad5c2005-04-14Martin Stjernholm }
e7634f2007-05-13Martin Stjernholm static INLINE struct free_extra_frame *alloc_free_extra_frame()
1bad5c2005-04-14Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  struct ba_mixed_frame *f = alloc_ba_mixed_frame(); free_extra_frames++; return (struct free_extra_frame *) f;
1bad5c2005-04-14Martin Stjernholm }
e7634f2007-05-13Martin Stjernholm static INLINE void really_free_link_frame (struct link_frame *f)
1bad5c2005-04-14Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  link_frames--; really_free_ba_mixed_frame ((struct ba_mixed_frame *) f);
1bad5c2005-04-14Martin Stjernholm }
e7634f2007-05-13Martin Stjernholm static INLINE void really_free_free_extra_frame (struct free_extra_frame *f)
1bad5c2005-04-14Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  free_extra_frames--; really_free_ba_mixed_frame ((struct ba_mixed_frame *) f);
1bad5c2005-04-14Martin Stjernholm }
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,
e7634f2007-05-13Martin Stjernholm  void *arg, callback_func free_func)
4a578f1997-01-27Fredrik Hübinette (Hubbe) { return add_to_callback(&gc_callbacks, call, arg, free_func); }
1e91212001-07-05Martin Stjernholm static void init_gc(void);
e7634f2007-05-13Martin Stjernholm static void gc_cycle_pop();
45d87e2000-07-18Martin Stjernholm  #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 #undef get_marker #define get_marker debug_get_marker #undef find_marker #define find_marker debug_find_marker
c095962008-05-11Martin Stjernholm PTR_HASH_ALLOC_FIXED_FILL_PAGES(marker,2)
c94c371996-03-28Fredrik Hübinette (Hubbe) 
11a5af2006-08-06Martin 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))) PMOD_EXPORT struct marker *pmod_get_marker (void *p) { return debug_get_marker (p); } PMOD_EXPORT struct marker *pmod_find_marker (void *p) { return debug_find_marker (p); }
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;
a5a3342006-07-05Martin Stjernholm PMOD_EXPORT int gc_external_refs_zapped = 0;
3b65672004-05-23Martin Nilsson #endif
e7634f2007-05-13Martin Stjernholm #if defined (PIKE_DEBUG) || defined (GC_CYCLE_DEBUG)
3b7f9f2007-06-17Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm static void describe_rec_frame (struct gc_rec_frame *f) { fprintf (stderr, "data=%p rf_flags=0x%02x prev=%p next=%p " "cycle_id=%p cycle_piece=%p link_top/last_cycle_piece=%p", f->data, f->rf_flags, f->prev, f->next, f->cycle_id, f->cycle_piece, f->u.link_top); }
3b7f9f2007-06-17Martin Stjernholm  /* If p* isn't NULL then p*_name will be written out next to the * matching frame in the stack, if any is found. */ static void describe_rec_stack (struct gc_rec_frame *p1, const char *p1_name, struct gc_rec_frame *p2, const char *p2_name, struct gc_rec_frame *p3, const char *p3_name) {
e30c812008-05-13Martin Stjernholm  struct gc_rec_frame *l, *cp;
3b7f9f2007-06-17Martin Stjernholm  size_t longest;
e30c812008-05-13Martin Stjernholm 
3b7f9f2007-06-17Martin Stjernholm  if (p1) longest = strlen (p1_name); if (p2) {size_t l = strlen (p2_name); if (l > longest) longest = l;} if (p3) {size_t l = strlen (p3_name); if (l > longest) longest = l;} longest++;
e30c812008-05-13Martin Stjernholm  /* Note: Stack is listed from top to bottom, but cycle piece lists * are lists from first to last, i.e. reverse order. */
3b7f9f2007-06-17Martin Stjernholm  for (l = stack_top; l != &sentinel_frame; l = l->prev) { size_t c = 0;
e30c812008-05-13Martin Stjernholm 
3b7f9f2007-06-17Martin Stjernholm  if (!l) {fputs (" <broken prev link in rec stack>\n", stderr); break;} fprintf (stderr, " %p", l);
e30c812008-05-13Martin Stjernholm 
3b7f9f2007-06-17Martin Stjernholm  if (l == p1) {fprintf (stderr, " %s", p1_name); c += strlen (p1_name) + 1;} if (l == p2) {fprintf (stderr, " %s", p2_name); c += strlen (p2_name) + 1;} if (l == p3) {fprintf (stderr, " %s", p3_name); c += strlen (p3_name) + 1;}
e6f6de2007-10-12Martin Stjernholm  fprintf (stderr, ": %*s", c < longest ? (int) (longest - c) : 0, "");
e30c812008-05-13Martin Stjernholm 
3b7f9f2007-06-17Martin Stjernholm  describe_rec_frame (l); fputc ('\n', stderr);
e30c812008-05-13Martin Stjernholm  for (cp = l->cycle_piece; cp; cp = cp->cycle_piece) { fprintf (stderr, " %p", cp); c = 0; if (cp == p1) {fprintf (stderr, " %s", p1_name); c += strlen (p1_name)+1;} if (cp == p2) {fprintf (stderr, " %s", p2_name); c += strlen (p2_name)+1;} if (cp == p3) {fprintf (stderr, " %s", p3_name); c += strlen (p3_name)+1;} fprintf (stderr, ": %*s", c < longest ? (int) (longest - c) : 0, ""); describe_rec_frame (cp); fputc ('\n', stderr); }
3b7f9f2007-06-17Martin Stjernholm  } }
e7634f2007-05-13Martin Stjernholm #endif
71f3a21998-11-22Fredrik Hübinette (Hubbe) #ifdef PIKE_DEBUG
1ca3ba1997-10-13Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm int gc_in_cycle_check = 0;
8e6d5c2001-07-02Martin Stjernholm 
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 */
2ac3f52005-04-06Henrik Grubbström (Grubba)  fprintf(stderr,"%*s **In p->constants[%"PRINTPTRDIFFT"d] "
2d76f22005-05-20Martin Stjernholm  "(%"PRINTPTRDIFFT"d)\n",indent,"",
4ea54f2004-05-29Henrik Grubbström (Grubba)  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, "");
e6f6de2007-10-12Martin Stjernholm  safe_print_svalue (stderr, low_use_multiset_index (node, ind));
5b15bb2001-12-10Martin Stjernholm  fputc ('\n', stderr); break; } else if (indval && &node->iv.val == (struct svalue *) location) { fprintf(stderr, "%*s **In value with index ", indent, "");
e6f6de2007-10-12Martin Stjernholm  safe_print_svalue (stderr, low_use_multiset_index (node, ind));
5b15bb2001-12-10Martin Stjernholm  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, "");
e6f6de2007-10-12Martin Stjernholm  safe_print_svalue (stderr, &k->ind);
d9d6f02001-06-30Martin Stjernholm  fputc('\n', stderr); break; } else if (&k->val == (struct svalue *) location) { fprintf(stderr, "%*s **In value with index ", indent, "");
e6f6de2007-10-12Martin Stjernholm  safe_print_svalue (stderr, &k->ind);
d9d6f02001-06-30Martin Stjernholm  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) }
e7634f2007-05-13Martin Stjernholm static void describe_link_frame (struct link_frame *f)
45d87e2000-07-18Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  fprintf (stderr, "data=%p prev=%p checkfn=%p weak=%d", f->data, f->prev, f->checkfn, f->weak);
45d87e2000-07-18Martin Stjernholm }
e2d9e62000-06-10Martin Stjernholm static void describe_marker(struct marker *m) {
45d87e2000-07-18Martin Stjernholm  if (m) {
e7634f2007-05-13Martin Stjernholm  fprintf(stderr, "marker at %p: flags=0x%05lx refs=%d weak=%d " "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); if (m->frame) { fputs(" [", stderr);
e7634f2007-05-13Martin Stjernholm  describe_rec_frame (m->frame);
45d87e2000-07-18Martin Stjernholm  putc(']', stderr); } putc('\n', stderr); }
e2d9e62000-06-10Martin Stjernholm  else fprintf(stderr, "no marker\n"); }
50d97a2003-02-01Martin Stjernholm #endif /* PIKE_DEBUG */
eb4aba2007-05-26Martin Stjernholm static void debug_gc_fatal_va (void *a, int flags, const char *fmt, va_list args)
e2d9e62000-06-10Martin Stjernholm {
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  (void) VFPRINTF(stderr, fmt, args);
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
8ed8dc2001-07-01Martin Stjernholm  if (a) {
0285372006-02-28Martin Stjernholm  /* Temporarily jumping out of gc to avoid being caught in debug
8ed8dc2001-07-01Martin Stjernholm  * 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
3b7f9f2007-06-17Martin Stjernholm  { d_flag = 0; /* The instruction backlog is never of any use here. */ debug_fatal (NULL); }
e2d9e62000-06-10Martin Stjernholm }
eb4aba2007-05-26Martin Stjernholm void debug_gc_fatal (void *a, int flags, const char *fmt, ...) { va_list args; va_start (args, fmt); debug_gc_fatal_va (a, flags, fmt, args); va_end (args); } static void dloc_gc_fatal (const char *file, int line, void *a, int flags, const char *fmt, ...) { va_list args; fprintf (stderr, "%s:%d: GC fatal:\n", file, line); va_start (args, fmt); debug_gc_fatal_va (a, flags, fmt, args); va_end (args); }
3b7f9f2007-06-17Martin Stjernholm static void rec_stack_fatal (struct gc_rec_frame *err, const char *err_name, struct gc_rec_frame *p1, const char *p1n, struct gc_rec_frame *p2, const char *p2n, const char *file, int line, const char *fmt, ...) { va_list args; va_start (args, fmt); fprintf (stderr, msg_fatal_error, file, line); (void) VFPRINTF (stderr, fmt, args);
818b192007-06-17Martin Stjernholm #if defined (PIKE_DEBUG) || defined (GC_CYCLE_DEBUG)
3b7f9f2007-06-17Martin Stjernholm  fputs ("Recursion stack:\n", stderr); describe_rec_stack (err, err_name, p1, p1n, p2, p2n); if (err) { fprintf (stderr, "Describing frame %p: ", err); describe_rec_frame (err); fputc ('\n', stderr); }
818b192007-06-17Martin Stjernholm #endif
6543f92007-06-17Martin Stjernholm  d_flag = 0; /* The instruction backlog is never of any use here. */
3b7f9f2007-06-17Martin Stjernholm  debug_fatal (NULL); va_end (args); }
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;
cb55012008-03-29Martin Stjernholm  if (((struct object *)a)->prog) { 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, ""); safe_print_short_svalue (stderr, (union anything *) &inh->name, T_STRING); 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  }
cb55012008-03-29Martin Stjernholm  for (var_idx = 0; var_idx < p2->num_variable_index; var_idx++) { struct identifier *id = p2->identifiers + p2->variable_index[var_idx]; void *ptr;
5a484d2003-09-09Martin Stjernholm 
cb55012008-03-29Martin Stjernholm  fprintf (stderr, "%*s**%*srtt: %-8s name: ", indent, "", inh->inherit_level + 1, "", get_name_of_type (id->run_time_type));
5a484d2003-09-09Martin Stjernholm 
cb55012008-03-29Martin Stjernholm  if (id->name->size_shift) safe_print_short_svalue (stderr, (union anything *) &id->name, T_STRING); else fprintf (stderr, "%-20s", id->name->str);
5a484d2003-09-09Martin Stjernholm 
cb55012008-03-29Martin Stjernholm  fprintf (stderr, " off: %4"PRINTPTRDIFFT"d value: ", inh->storage_offset + id->func.offset);
5a484d2003-09-09Martin Stjernholm 
cb55012008-03-29Martin Stjernholm  ptr = PIKE_OBJ_STORAGE ((struct object *) a) + inh->storage_offset + id->func.offset; if (id->run_time_type == T_MIXED) safe_print_svalue_compact (stderr, (struct svalue *) ptr); else safe_print_short_svalue_compact (stderr, (union anything *) ptr, id->run_time_type);
5a484d2003-09-09Martin Stjernholm 
cb55012008-03-29Martin Stjernholm  fputc ('\n', stderr); var_count++; }
5a484d2003-09-09Martin Stjernholm  }
cb55012008-03-29Martin Stjernholm  if (!var_count) fprintf (stderr, "%*s** (none)\n", indent, ""); }
5a484d2003-09-09Martin Stjernholm 
60c15a2003-08-20Martin Stjernholm  fprintf(stderr,"%*s**Describing program %p of object:\n",indent,"", p);
505e3e2000-09-30Martin Stjernholm #ifdef DEBUG_MALLOC
2ac3f52005-04-06Henrik Grubbström (Grubba)  if ((INT32)(ptrdiff_t) 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, "");
e6f6de2007-10-12Martin Stjernholm  safe_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, "");
e6f6de2007-10-12Martin Stjernholm  safe_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  }
bf34e02007-10-12Martin Stjernholm #if 0 /* Can be illuminating to see these too.. */
c905ff2003-09-24Martin Stjernholm  if (id_ref->id_flags & ID_HIDDEN || (id_ref->id_flags & (ID_INHERITED|ID_PRIVATE)) == (ID_INHERITED|ID_PRIVATE)) continue;
bf34e02007-10-12Martin Stjernholm #endif
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 
60492a2007-09-29Henrik Grubbström (Grubba)  if (IDENTIFIER_IS_ALIAS (id->identifier_flags)) type = "alias"; else if (IDENTIFIER_IS_PIKE_FUNCTION (id->identifier_flags)) type = "fun";
c905ff2003-09-24Martin Stjernholm  else if (IDENTIFIER_IS_FUNCTION (id->identifier_flags)) type = "cfun"; else if (IDENTIFIER_IS_CONSTANT (id->identifier_flags)) type = "const"; 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");
7546522008-06-29Martin Nilsson  if (!(id_ref->id_flags & ID_PROTECTED)) strcat (prot, ",!pro");
c905ff2003-09-24Martin Stjernholm  } else
7546522008-06-29Martin Nilsson  if (id_ref->id_flags & ID_PROTECTED) strcat (prot, ",pro");
ab0d472007-12-28Martin Nilsson  if (id_ref->id_flags & ID_FINAL) strcat (prot, ",fin");
c905ff2003-09-24Martin Stjernholm  if (id_ref->id_flags & ID_PUBLIC) strcat (prot, ",pub"); if (id_ref->id_flags & ID_INLINE) strcat (prot, ",inl"); if (id_ref->id_flags & ID_OPTIONAL) strcat (prot, ",opt");
bf34e02007-10-12Martin Stjernholm  if (id_ref->id_flags & ID_HIDDEN) strcat (prot, ",hid"); if (id_ref->id_flags & ID_INHERITED) strcat (prot, ",inh");
c905ff2003-09-24Martin Stjernholm  if (id_ref->id_flags & ID_EXTERN) strcat (prot, ",ext"); if (id_ref->id_flags & ID_VARIANT) strcat (prot, ",var");
3422fc2008-05-29Martin Stjernholm  if (id_ref->id_flags & ID_USED) strcat (prot, ",use");
c905ff2003-09-24Martin Stjernholm  sprintf (descr, "%s: %s", type, prot + 1);
bf34e02007-10-12Martin Stjernholm  fprintf (stderr, "%*s**%*s%-3"PRINTPTRDIFFT"d %-18s name: ", indent, "", id_inh->inherit_level + 1, "", id_idx, descr);
c905ff2003-09-24Martin Stjernholm 
99cee92004-04-03Martin Stjernholm  if (id->name->size_shift)
e6f6de2007-10-12Martin Stjernholm  safe_print_short_svalue (stderr, (union anything *) &id->name, T_STRING);
c905ff2003-09-24Martin Stjernholm  else fprintf (stderr, "%-20s", id->name->str);
60492a2007-09-29Henrik Grubbström (Grubba)  if (IDENTIFIER_IS_ALIAS(id->identifier_flags)) { fprintf(stderr, " depth: %d id: %d", id->func.ext_ref.depth, id->func.ext_ref.id); } else if (id->identifier_flags & IDENTIFIER_C_FUNCTION)
c905ff2003-09-24Martin Stjernholm  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);
e6f6de2007-10-12Martin Stjernholm  safe_print_svalue_compact ( stderr, &id_inh->prog->constants[id->func.offset].sval);
c905ff2003-09-24Martin Stjernholm  } 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", \
2d76f22005-05-20Martin Stjernholm  indent, "", p->NAME, (size_t)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;
2ac3f52005-04-06Henrik Grubbström (Grubba)  fprintf(stderr,"%*s**size_shift: %d, " "len: %"PRINTPTRDIFFT"d, " "hash: %"PRINTSIZET"x\n", indent,"", s->size_shift, s->len, 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 
38da522007-03-31Henrik Grubbström (Grubba)  case PIKE_T_TYPE: { fprintf(stderr, "%*s**type: ", indent, ""); simple_describe_type((struct pike_type *)a); fprintf(stderr, "\n"); 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:
97a7332008-03-30Martin Stjernholm  fprintf(stderr, "%*s**Cannot describe block of type %s (%d)\n", indent, "", get_name_of_type (t), 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
2ac3f52005-04-06Henrik Grubbström (Grubba)  if (((INT32)(ptrdiff_t)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);
03cc2c2005-04-06Henrik Grubbström (Grubba)  if ( #ifdef DO_PIKE_CLEANUP !gc_keep_markers && #endif m && !(m->flags & (GC_PRETOUCHED
50d97a2003-02-01Martin Stjernholm #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;
a3574b2007-05-13Martin Stjernholm  case GC_PASS_POSTTOUCH: {
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");
e7634f2007-05-13Martin Stjernholm  if (gc_destruct_everything && (m->flags & GC_MARKED)) gc_fatal (a, 1, "Thing got marked in gc_destruct_everything mode.\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
a3574b2007-05-13Martin Stjernholm  m->flags |= GC_POSTTOUCHED;
22aa2f2000-09-04Martin Stjernholm  break;
b13ee62001-06-30Martin Stjernholm  }
22aa2f2000-09-04Martin Stjernholm  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
c095962008-05-11Martin 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. */
ad8d052008-05-02Martin Stjernholm  gc_fatal (a, 1, "Thing is getting more internal refs (%d + %d) " "than refs (%d) (a pointer has probably been checked " "more than once).\n", m->refs, m->xrefs, *(INT32 *) a);
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) 
ad8d052008-05-02Martin Stjernholm PMOD_EXPORT INT32 real_gc_check_weak(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_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) {
97a7332008-03-30Martin Stjernholm  /* Carry over any GC_CLEANUP_LEAKED flags but reinitialize them
4fab5f2004-04-18Martin Stjernholm  * 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
97a7332008-03-30Martin Stjernholm  m->flags &= GC_CLEANUP_LEAKED;
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 #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();
e7634f2007-05-13Martin Stjernholm  free_all_gc_rec_frame_blocks(); free_all_ba_mixed_frame_blocks();
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
cb55012008-03-29Martin Stjernholm 
a5a3342006-07-05Martin Stjernholm PMOD_EXPORT void gc_check_zapped (void *a, TYPE_T type, const char *file, int line)
3b65672004-05-23Martin Nilsson { struct marker *m = find_marker (a);
97a7332008-03-30Martin Stjernholm  if (m && (m->flags & GC_CLEANUP_LEAKED))
3b65672004-05-23Martin Nilsson  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); }
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();
97a7332008-03-30Martin Stjernholm  gc_check_all_types();
04bbb72003-09-24Martin Stjernholm  } 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, "
ad8d052008-05-02Martin Stjernholm  "found %"PRINTSIZET"u 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 
eb4aba2007-05-26Martin Stjernholm #define LOW_CHECK_REC_FRAME(f, file, line) do { \ if (f->rf_flags & GC_FRAME_FREED) \ dloc_gc_fatal (file, line, f->data, 0, \ "Accessing freed gc_stack_frame %p.\n", f); \ if (f->cycle_id->rf_flags & GC_FRAME_FREED) { \
e442722007-06-09Martin Stjernholm  fprintf (stderr, "Cycle id frame %p is freed. It is: ", f->cycle_id); \
eb4aba2007-05-26Martin Stjernholm  describe_rec_frame (f->cycle_id); \ fputc ('\n', stderr); \ dloc_gc_fatal (file, line, f->data, 0, "Cycle id frame is freed.\n"); \ } \ } while (0) static void check_rec_stack_frame (struct gc_rec_frame *f,
3b7f9f2007-06-17Martin Stjernholm  struct gc_rec_frame *p1, const char *p1n, struct gc_rec_frame *p2, const char *p2n,
eb4aba2007-05-26Martin Stjernholm  const char *file, int line) {
3b7f9f2007-06-17Martin Stjernholm  /* To allow this function to be used after a stack rotation but * before cycle_id markup, there are no checks here for cycle_id * consistency wrt other frames on the rec stack. */
eb4aba2007-05-26Martin Stjernholm  LOW_CHECK_REC_FRAME (f, file, line); if (f->rf_flags & (GC_ON_CYCLE_PIECE_LIST|GC_ON_KILL_LIST))
3b7f9f2007-06-17Martin Stjernholm  rec_stack_fatal (f, "err", p1, p1n, p2, p2n, file, line, "Frame %p is not on the rec stack (according to flags).\n", f);
eb4aba2007-05-26Martin Stjernholm  if (!f->prev)
3b7f9f2007-06-17Martin Stjernholm  rec_stack_fatal (f, "err", p1, p1n, p2, p2n, file, line, "Prev pointer not set for rec stack frame %p.\n", f);
eb4aba2007-05-26Martin Stjernholm  if (f->prev->next != f)
3b7f9f2007-06-17Martin Stjernholm  rec_stack_fatal (f, "err", p1, p1n, p2, p2n, file, line, "Rec stack pointers are inconsistent before %p.\n", f);
eb4aba2007-05-26Martin Stjernholm  if (f->cycle_id &&
3b7f9f2007-06-17Martin Stjernholm  f->cycle_id->rf_flags & (GC_ON_CYCLE_PIECE_LIST|GC_ON_KILL_LIST)) /* p2 and p2n gets lost here. No bother. */ rec_stack_fatal (f->cycle_id, "cycle id", f, "err", p1, p1n, file, line, "Cycle id frame %p for %p not on the rec stack " "(according to flags).\n", f->cycle_id, f); if ((f->rf_flags & GC_MARK_LIVE) && f != stack_top) rec_stack_fatal (f, "err", p1, p1n, p2, p2n, file, line, "GC_MARK_LIVE frame %p found that " "isn't on the stack top.\n", f); if ((f->rf_flags & GC_PREV_STRONG) && (f->rf_flags & (GC_PREV_WEAK|GC_PREV_BROKEN))) rec_stack_fatal (f, "err", p1, p1n, p2, p2n, file, line, "GC_PREV_STRONG set together with " "GC_PREV_WEAK or GC_PREV_BROKEN in %p.\n", f);
eb4aba2007-05-26Martin Stjernholm  if (f->cycle_piece && (!f->cycle_piece->u.last_cycle_piece || f->cycle_piece->u.last_cycle_piece->cycle_piece))
3b7f9f2007-06-17Martin Stjernholm  rec_stack_fatal (f, "err", p1, p1n, p2, p2n, file, line, "Bogus last_cycle_piece %p is %p " "in cycle piece top %p in %p.\n", f->cycle_piece->u.last_cycle_piece, f->cycle_piece->u.last_cycle_piece ? f->cycle_piece->u.last_cycle_piece->cycle_piece : NULL, f->cycle_piece, f);
eb4aba2007-05-26Martin Stjernholm } #define CHECK_REC_STACK_FRAME(f) \
3b7f9f2007-06-17Martin Stjernholm  do check_rec_stack_frame ((f), NULL, NULL, NULL, NULL, __FILE__, __LINE__); \ while (0)
eb4aba2007-05-26Martin Stjernholm  static void check_cycle_piece_frame (struct gc_rec_frame *f, const char *file, int line) { LOW_CHECK_REC_FRAME (f, file, line); if ((f->rf_flags & (GC_ON_CYCLE_PIECE_LIST|GC_ON_KILL_LIST)) != GC_ON_CYCLE_PIECE_LIST) dloc_gc_fatal (file, line, f->data, 0,
3b7f9f2007-06-17Martin Stjernholm  "Frame is not on a cycle piece list " "(according to flags).\n");
eb4aba2007-05-26Martin Stjernholm  if (f->prev) dloc_gc_fatal (file, line, f->data, 0, "Prev pointer set for frame on cycle piece list.\n"); } #define CHECK_CYCLE_PIECE_FRAME(f) \ do check_cycle_piece_frame ((f), __FILE__, __LINE__); while (0) static void check_kill_list_frame (struct gc_rec_frame *f, const char *file, int line) { LOW_CHECK_REC_FRAME (f, file, line); if ((f->rf_flags & (GC_ON_CYCLE_PIECE_LIST|GC_ON_KILL_LIST)) != GC_ON_KILL_LIST)
3b7f9f2007-06-17Martin Stjernholm  dloc_gc_fatal (file, line, f->data, 0, "Frame is not on kill list (according to flags).\n");
eb4aba2007-05-26Martin Stjernholm  if (f->prev) dloc_gc_fatal (file, line, f->data, 0, "Prev pointer set for frame on kill list.\n"); } #define CHECK_KILL_LIST_FRAME(f) \ do check_kill_list_frame ((f), __FILE__, __LINE__); while (0)
3b7f9f2007-06-17Martin Stjernholm static void check_rec_stack (struct gc_rec_frame *p1, const char *p1n, struct gc_rec_frame *p2, const char *p2n, const char *file, int line) {
f2849b2008-05-16Martin Stjernholm  /* This debug check is disabled during the final cleanup since this * is O(n^2) on the stack size, and the stack gets a lot larger then. */ if (gc_debug && !gc_destruct_everything) {
3b7f9f2007-06-17Martin Stjernholm  struct gc_rec_frame *l, *last_cycle_id; for (l = &sentinel_frame; l != stack_top;) { l = l->next; check_rec_stack_frame (l, p1, p1n, p2, p2n, file, line); if (l->cycle_id == l) last_cycle_id = l; else if (l->cycle_id != last_cycle_id) rec_stack_fatal (l, "err", p1, p1n, p2, p2n, file, line, "Unexpected cycle id for frame %p.\n", l); else if (l->rf_flags & GC_PREV_WEAK) rec_stack_fatal (l, "err", p1, p1n, p2, p2n, file, line, "Unexpected weak ref before %p inside a cycle.\n", l);
e30c812008-05-13Martin Stjernholm  if (l->rf_flags & GC_IS_VALID_CP_CYCLE_ID) rec_stack_fatal (l, "err", p1, p1n, p2, p2n, file, line, "Frame %p got stray " "GC_IS_VALID_CP_CYCLE_ID flag.\n", l); if (l->cycle_piece) { struct gc_rec_frame *cp = l->cycle_piece; l->rf_flags |= GC_IS_VALID_CP_CYCLE_ID; while (1) { if (!cp->cycle_id || !(cp->cycle_id->rf_flags & GC_IS_VALID_CP_CYCLE_ID)) rec_stack_fatal (cp, "err", p1, p1n, p2, p2n, file, line, "Unexpected cycle id for frame %p " "on cycle piece list.\n", cp); if (cp->rf_flags & GC_IS_VALID_CP_CYCLE_ID) rec_stack_fatal (cp, "err", p1, p1n, p2, p2n, file, line, "Frame %p got stray " "GC_IS_VALID_CP_CYCLE_ID flag.\n", cp); cp->rf_flags |= GC_IS_VALID_CP_CYCLE_ID; check_cycle_piece_frame (cp, file, line); if (!cp->cycle_piece) break; cp = cp->cycle_piece; } if (l->cycle_piece->u.last_cycle_piece != cp) rec_stack_fatal (l->cycle_piece, "err", p1, p1n, p2, p2n, file, line, "last_cycle_piece is wrong for frame %p, " "expected %p.\n", l->cycle_piece, cp); l->rf_flags &= ~GC_IS_VALID_CP_CYCLE_ID; cp = l->cycle_piece; do { cp->rf_flags &= ~GC_IS_VALID_CP_CYCLE_ID; cp = cp->cycle_piece; } while (cp); }
3b7f9f2007-06-17Martin Stjernholm  } } } #define CHECK_REC_STACK(p1, p1n, p2, p2n) \ do check_rec_stack ((p1), (p1n), (p2), (p2n), __FILE__, __LINE__); while (0)
eb4aba2007-05-26Martin Stjernholm #else /* !PIKE_DEBUG */ #define CHECK_REC_STACK_FRAME(f) do {} while (0) #define CHECK_CYCLE_PIECE_FRAME(f) do {} while (0) #define CHECK_KILL_LIST_FRAME(f) do {} while (0)
3b7f9f2007-06-17Martin Stjernholm #define CHECK_REC_STACK(p1, p1n, p2, p2n) do {} while (0)
eb4aba2007-05-26Martin Stjernholm #endif /* !PIKE_DEBUG */
63709a2000-07-18Martin Stjernholm 
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 */
e7634f2007-05-13Martin Stjernholm  struct free_extra_frame *l = alloc_free_extra_frame();
fcb3222001-07-05Martin Stjernholm  l->data = a;
1bad5c2005-04-14Martin Stjernholm  l->type = type;
e7634f2007-05-13Martin Stjernholm  l->next = free_extra_list;
fcb3222001-07-05Martin Stjernholm  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) {
28d6b72006-03-10Martin Stjernholm  struct marker *m; #ifdef PIKE_DEBUG
c095962008-05-11Martin Stjernholm  if (Pike_in_gc == GC_PASS_ZAP_WEAK && !find_marker (a))
28d6b72006-03-10Martin Stjernholm  gc_fatal (a, 0, "gc_mark() called for for thing without marker "
c095962008-05-11Martin Stjernholm  "in zap weak pass.\n");
28d6b72006-03-10Martin Stjernholm #endif m = get_marker (a);
c94c371996-03-28Fredrik Hübinette (Hubbe) 
ee204c2008-05-04Martin Stjernholm  /* Note: m->refs and m->xrefs are useless already here due to how * gc_free_(short_)svalue works. */
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");
c095962008-05-11Martin Stjernholm  if (Pike_in_gc != GC_PASS_MARK && Pike_in_gc != GC_PASS_ZAP_WEAK)
ad8d052008-05-02Martin Stjernholm  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");
c095962008-05-11Martin 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
c095962008-05-11Martin Stjernholm  if (Pike_in_gc == GC_PASS_ZAP_WEAK) { /* 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 nonweak refs. */
1a12e82000-09-30Martin Stjernholm #ifdef PIKE_DEBUG
c095962008-05-11Martin Stjernholm  if (!(m->flags & GC_MARKED)) gc_fatal(a, 0, "gc_mark() called for thing in zap weak pass " "that wasn't marked before.\n");
1a12e82000-09-30Martin Stjernholm #endif
c095962008-05-11Martin Stjernholm  if (m->flags & GC_FREE_VISITED) { debug_malloc_touch (a); return 0; } else { debug_malloc_touch (a); m->flags |= GC_FREE_VISITED; return 1; } }
ad8d052008-05-02Martin Stjernholm 
c095962008-05-11Martin Stjernholm  else if (m->flags & GC_MARKED) { debug_malloc_touch (a);
6d30f52000-07-11Martin Stjernholm #ifdef PIKE_DEBUG
c095962008-05-11Martin Stjernholm  if (m->weak_refs != 0) gc_fatal (a, 0, "weak_refs changed in marker " "already visited by gc_mark().\n");
6d30f52000-07-11Martin Stjernholm #endif
c095962008-05-11Martin Stjernholm  return 0; }
ad8d052008-05-02Martin Stjernholm 
c095962008-05-11Martin Stjernholm  else { debug_malloc_touch (a); if (m->weak_refs) { gc_ext_weak_refs -= m->weak_refs; m->weak_refs = 0; } m->flags = (m->flags & ~GC_NOT_REFERENCED) | GC_MARKED; DO_IF_DEBUG(marked++); return 1;
c94c371996-03-28Fredrik Hübinette (Hubbe)  } }
8eaec82006-02-18Martin Stjernholm void gc_move_marker (void *old, void *new) {
28d6b72006-03-10Martin Stjernholm  struct marker *m = find_marker (old);
8eaec82006-02-18Martin Stjernholm  #ifdef PIKE_DEBUG
28d6b72006-03-10Martin Stjernholm  if (!Pike_in_gc || Pike_in_gc >= GC_PASS_FREE) Pike_fatal ("gc move mark attempted in invalid pass.\n"); if (!old) Pike_fatal ("Got null pointer in old.\n"); if (!new) Pike_fatal ("Got null pointer in new.\n");
8eaec82006-02-18Martin Stjernholm  if (!m) Pike_fatal ("Have no marker for old block %p.\n", old); if (find_marker (new)) Pike_fatal ("New block %p already got a marker.\n", new); #endif
0569d12006-02-25Martin Stjernholm  move_marker (m, debug_malloc_pass (new));
8eaec82006-02-18Martin Stjernholm }
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 {
e7634f2007-05-13Martin Stjernholm  struct link_frame *l = alloc_link_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");
e7634f2007-05-13Martin Stjernholm  if (stack_top == &sentinel_frame) gc_fatal (data, 0, "No thing on rec stack to follow links from.\n");
45d87e2000-07-18Martin Stjernholm #endif l->data = data;
1bad5c2005-04-14Martin Stjernholm  l->checkfn = checkfn; l->weak = weak;
e7634f2007-05-13Martin Stjernholm  l->prev = stack_top->u.link_top;
45d87e2000-07-18Martin Stjernholm #ifdef GC_STACK_DEBUG
e7634f2007-05-13Martin Stjernholm  fprintf (stderr, "push link %p [%p in %p]: ", l, stack_top->u.link_top, stack_top); describe_link_frame (l);
45d87e2000-07-18Martin Stjernholm  fputc('\n', stderr); #endif
e7634f2007-05-13Martin Stjernholm  stack_top->u.link_top = l;
45d87e2000-07-18Martin Stjernholm }
e7634f2007-05-13Martin Stjernholm static struct gc_rec_frame *gc_cycle_enqueue_rec (void *data)
45d87e2000-07-18Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  struct gc_rec_frame *r = alloc_gc_rec_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");
e7634f2007-05-13Martin Stjernholm  r->next = (struct gc_rec_frame *) (ptrdiff_t) -1;
1a12e82000-09-30Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  r->data = data; r->u.link_top = NULL; r->prev = stack_top; r->cycle_id = r; r->cycle_piece = NULL;
45d87e2000-07-18Martin Stjernholm #ifdef GC_STACK_DEBUG
e7634f2007-05-13Martin Stjernholm  fprintf (stderr, "push rec %p [%p]: ", r, stack_top); describe_rec_frame (r);
45d87e2000-07-18Martin Stjernholm  fputc('\n', stderr); #endif
e7634f2007-05-13Martin Stjernholm  stack_top->next = r; stack_top = r; return r;
45d87e2000-07-18Martin Stjernholm } 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
cde9da2005-04-15Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  while (stack_top != &sentinel_frame) { while (stack_top->u.link_top) { struct link_frame l = *stack_top->u.link_top;
45d87e2000-07-18Martin Stjernholm #ifdef GC_STACK_DEBUG
e7634f2007-05-13Martin Stjernholm  fprintf (stderr, "pop link %p [%p in %p]: ", stack_top->u.link_top, l.prev, stack_top); describe_link_frame (stack_top->u.link_top); fputc ('\n', stderr); #endif really_free_link_frame (stack_top->u.link_top); stack_top->u.link_top = l.prev; l.checkfn (l.data, l.weak); /* Might change stack_top. */
cde9da2005-04-15Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm #ifdef GC_STACK_DEBUG fprintf (stderr, "pop rec %p [%p]: ", stack_top, stack_top->prev); describe_rec_frame (stack_top); fputc ('\n', stderr);
45d87e2000-07-18Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  CHECK_REC_STACK_FRAME (stack_top); #ifdef PIKE_DEBUG { struct gc_rec_frame *old_stack_top = stack_top; gc_cycle_pop(); if (stack_top == old_stack_top) fatal ("gc_cycle_pop didn't pop the stack.\n");
45d87e2000-07-18Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm #else gc_cycle_pop(); #endif
45d87e2000-07-18Martin Stjernholm  } }
e2d9e62000-06-10Martin Stjernholm #ifdef GC_CYCLE_DEBUG static int gc_cycle_indent = 0;
e7634f2007-05-13Martin Stjernholm #define CYCLE_DEBUG_MSG(REC, TXT) do { \ struct gc_rec_frame *r_ = (REC); \ fprintf (stderr, "%*s%-35s %p [%p] ", gc_cycle_indent, "", \ (TXT), r_ ? r_->data : NULL, stack_top->data); \ if (r_) describe_rec_frame (r_); \ putc ('\n', stderr); \ } while (0)
996f872000-06-12Martin Stjernholm #else
e7634f2007-05-13Martin Stjernholm #define CYCLE_DEBUG_MSG(REC, TXT) do {} while (0)
e2d9e62000-06-10Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm static struct gc_rec_frame *rotate_rec_stack (struct gc_rec_frame *beg, struct gc_rec_frame *pos) /* Performs a rotation of the recursion stack so the part from pos * down to the end gets before the part from beg down to pos. The beg
e442722007-06-09Martin Stjernholm  * position might be moved further back the list to avoid breaking * strong link sequences. Returns the actual beg position. Example:
e7634f2007-05-13Martin Stjernholm  * * strong * a1 <=> ... <=> a2 <=> b1 <*> b2 <=> ... <=> b3 <=> c1 <=> ... <=> c2 * ^ beg ^ pos * * becomes * * broken strong * a1 <=> ... <=> a2 <#> c1 <=> ... <=> c2 <=> b1 <*> b2 <=> ... <=> b3 * ^ pos ^ ^ beg * returned * * Note: The part from pos down to the end is assumed to not contain * any weak refs. (If it does they must be cleared, unless the link * before beg is weak.) */
e2d9e62000-06-10Martin Stjernholm {
e7634f2007-05-13Martin Stjernholm  CYCLE_DEBUG_MSG (beg, "> rotate_rec_stack, requested beg");
0db2c02003-02-14Martin Stjernholm 
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");
e7634f2007-05-13Martin Stjernholm  CHECK_REC_STACK_FRAME (beg); CHECK_REC_STACK_FRAME (pos);
e2d9e62000-06-10Martin Stjernholm  if (beg == pos)
e7634f2007-05-13Martin Stjernholm  gc_fatal (beg->data, 0, "Cycle already broken at requested position.\n");
e2d9e62000-06-10Martin Stjernholm #endif
45d87e2000-07-18Martin Stjernholm #ifdef GC_STACK_DEBUG fprintf(stderr,"Stack before:\n");
3b7f9f2007-06-17Martin Stjernholm  describe_rec_stack (beg, "beg", pos, "pos", NULL, NULL);
45d87e2000-07-18Martin Stjernholm #endif
0db2c02003-02-14Martin Stjernholm  /* Always keep chains of strong refs continuous, or else we risk * breaking the order in a later rotation. */
e7634f2007-05-13Martin Stjernholm  for (; beg->rf_flags & GC_PREV_STRONG; beg = beg->prev) CYCLE_DEBUG_MSG (beg, "> rotate_rec_stack, skipping strong"); #ifdef PIKE_DEBUG if (beg == &sentinel_frame) fatal ("Strong ref chain ended up off stack.\n"); #endif CYCLE_DEBUG_MSG (beg, "> rotate_rec_stack, actual beg");
46d4e72000-06-12Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  {
e7634f2007-05-13Martin Stjernholm  struct gc_rec_frame *new_stack_top = pos->prev;
996f872000-06-12Martin Stjernholm 
1bad5c2005-04-14Martin Stjernholm  beg->prev->next = pos; pos->prev = beg->prev;
e7634f2007-05-13Martin Stjernholm  stack_top->next = beg; beg->prev = stack_top; stack_top = new_stack_top; #ifdef PIKE_DEBUG stack_top->next = (struct gc_rec_frame *) (ptrdiff_t) -1; #endif
e2d9e62000-06-10Martin Stjernholm  }
af72c52000-07-02Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm #ifdef PIKE_DEBUG frame_rot++; #endif pos->rf_flags |= GC_PREV_BROKEN;
45d87e2000-07-18Martin Stjernholm #ifdef GC_STACK_DEBUG fprintf(stderr,"Stack after:\n");
3b7f9f2007-06-17Martin Stjernholm  describe_rec_stack (beg, "ret", pos, "pos", NULL, NULL);
45d87e2000-07-18Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  return beg;
e2d9e62000-06-10Martin Stjernholm }
e7634f2007-05-13Martin Stjernholm int gc_cycle_push(void *data, struct marker *m, int weak)
c94c371996-03-28Fredrik Hübinette (Hubbe) {
e7634f2007-05-13Martin Stjernholm  struct marker *pm;
45d87e2000-07-18Martin Stjernholm 
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) 
e7634f2007-05-13Martin Stjernholm  debug_malloc_touch (data);
9a6d002001-06-26Fredrik Hübinette (Hubbe) 
e7634f2007-05-13Martin Stjernholm  if (!data) Pike_fatal ("Got null pointer.\n"); if (m->data != data) 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))
e7634f2007-05-13Martin Stjernholm  gc_fatal (data, 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) &&
e7634f2007-05-13Martin Stjernholm  *(INT32 *) data) gc_fatal (data, 1, "Got a referenced marker to gc_cycle_push.\n");
57cfbd2004-03-15Martin Stjernholm  if (m->flags & GC_XREFERENCED)
e7634f2007-05-13Martin Stjernholm  gc_fatal (data, 1, "Doing cycle check in externally referenced thing " "missed in mark pass.\n");
57cfbd2004-03-15Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm  if (weak && stack_top == &sentinel_frame) gc_fatal (data, 1, "weak is %d when stack is empty.\n", weak);
0db2c02003-02-14Martin Stjernholm  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)
e7634f2007-05-13Martin Stjernholm  if(a == (struct array *) data) goto on_gc_internal_lists;
e2d9e62000-06-10Martin Stjernholm  for(o = gc_internal_object; o; o = o->next)
e7634f2007-05-13Martin Stjernholm  if(o == (struct object *) data) goto on_gc_internal_lists;
e2d9e62000-06-10Martin Stjernholm  for(p = gc_internal_program; p; p = p->next)
e7634f2007-05-13Martin Stjernholm  if(p == (struct program *) data) goto on_gc_internal_lists;
e2d9e62000-06-10Martin Stjernholm  for(m = gc_internal_mapping; m; m = m->next)
e7634f2007-05-13Martin Stjernholm  if(m == (struct mapping *) data) goto on_gc_internal_lists;
e2d9e62000-06-10Martin Stjernholm  for(l = gc_internal_multiset; l; l = l->next)
e7634f2007-05-13Martin Stjernholm  if(l == (struct multiset *) data) goto on_gc_internal_lists; gc_fatal (data, 0, "gc_cycle_check() called for thing not on gc_internal lists.\n");
e2d9e62000-06-10Martin Stjernholm  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) 
e7634f2007-05-13Martin Stjernholm  if (stack_top->rf_flags & GC_MARK_LIVE) { /* Only recurse through things already handled; we'll get to the * other later in the normal recursion. */ if (m->flags & GC_CYCLE_CHECKED && !(m->flags & GC_LIVE)) { CYCLE_DEBUG_MSG (m->frame, "gc_cycle_push, mark live"); goto mark_live; } CYCLE_DEBUG_MSG (m->frame, "gc_cycle_push, no mark live"); return 0; } if (stack_top == &sentinel_frame) pm = NULL; else { pm = find_marker (stack_top->data);
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  if (!pm) gc_fatal (stack_top->data, 0, "No marker for thing on top of the stack.\n");
e2d9e62000-06-10Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  }
1637c42000-02-01Fredrik Hübinette (Hubbe) 
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  if (weak < 0 && stack_top->rf_flags & GC_FOLLOWED_NONSTRONG) gc_fatal (data, 0, "Followed strong link too late.\n"); if (weak >= 0) stack_top->rf_flags |= GC_FOLLOWED_NONSTRONG;
e2d9e62000-06-10Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  if (m->frame) { /* A cyclic ref or a ref to something on the kill list is found. */ struct gc_rec_frame *cycle_frame = m->frame; if (cycle_frame->rf_flags & GC_ON_KILL_LIST) CYCLE_DEBUG_MSG (cycle_frame, "gc_cycle_push, ref to kill list"); else if (cycle_frame == stack_top) CYCLE_DEBUG_MSG (cycle_frame, "gc_cycle_push, self-ref"); else if (weak > 0) /* Ignore weak refs since they always are eligible to be broken anyway. */ CYCLE_DEBUG_MSG (cycle_frame, "gc_cycle_push, weak cyclic ref");
e1be4f2001-07-01Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  else {
e7634f2007-05-13Martin Stjernholm  struct gc_rec_frame *weakly_refd = NULL; struct gc_rec_frame *brokenly_refd = NULL; struct gc_rec_frame *nonstrongly_refd = NULL;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  if (stack_top == &sentinel_frame) gc_fatal (data, 0, "Cyclic ref involves dummy sentinel frame.\n"); CHECK_REC_STACK_FRAME (stack_top);
8ed8dc2001-07-01Martin Stjernholm #endif
cde9da2005-04-15Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  CYCLE_DEBUG_MSG (cycle_frame, "gc_cycle_push, cyclic ref");
cde9da2005-04-15Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  /* Find the corresponding frame still on the stack and compress * indirect cycle_id links. */ { struct gc_rec_frame *r; for (r = cycle_frame; !r->prev; r = r->cycle_id) CHECK_CYCLE_PIECE_FRAME (r); while (cycle_frame != r) { struct gc_rec_frame *next = cycle_frame->cycle_id; cycle_frame->cycle_id = r; cycle_frame = next;
45d87e2000-07-18Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm  CHECK_REC_STACK_FRAME (cycle_frame);
8ed8dc2001-07-01Martin Stjernholm  }
9326332000-06-12Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  if (!weak) {
e7634f2007-05-13Martin Stjernholm  struct gc_rec_frame *r; CYCLE_DEBUG_MSG (cycle_frame, "gc_cycle_push, search normal"); /* Find the last weakly linked thing and the last thing whose * normal ref already has been broken. */ for (r = stack_top; r != cycle_frame; r = r->prev) { CHECK_REC_STACK_FRAME (r);
cde9da2005-04-15Martin Stjernholm  DO_IF_DEBUG (link_search++);
e7634f2007-05-13Martin Stjernholm  if (r->rf_flags & GC_PREV_WEAK) { CYCLE_DEBUG_MSG (r, "> gc_cycle_push, found weak"); weakly_refd = r; break;
e2d9e62000-06-10Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm  if (!brokenly_refd && (r->rf_flags & GC_PREV_BROKEN)) { CYCLE_DEBUG_MSG (r, "> gc_cycle_push, found broken"); brokenly_refd = r; } else CYCLE_DEBUG_MSG (r, "> gc_cycle_push, search");
e2d9e62000-06-10Martin Stjernholm  } }
7f3d542007-06-11Martin Stjernholm  else if (weak < 0) {
e7634f2007-05-13Martin Stjernholm  struct gc_rec_frame *r; CYCLE_DEBUG_MSG (cycle_frame, "gc_cycle_push, search strong");
0db2c02003-02-14Martin Stjernholm  /* Find the last weakly linked thing and the last one which * isn't strongly linked. */
e7634f2007-05-13Martin Stjernholm  for (r = stack_top; r != cycle_frame; r = r->prev) { CHECK_REC_STACK_FRAME (r);
cde9da2005-04-15Martin Stjernholm  DO_IF_DEBUG (link_search++);
e7634f2007-05-13Martin Stjernholm  if (r->rf_flags & GC_PREV_WEAK) { CYCLE_DEBUG_MSG (r, "> gc_cycle_push, found weak"); weakly_refd = r; break; } if (!nonstrongly_refd && !(r->rf_flags & GC_PREV_STRONG)) { nonstrongly_refd = r; CYCLE_DEBUG_MSG (r, "> gc_cycle_push, found nonstrong"); } if (!brokenly_refd && (r->rf_flags & GC_PREV_BROKEN)) { CYCLE_DEBUG_MSG (r, "> gc_cycle_push, found broken"); brokenly_refd = r; } #ifdef GC_CYCLE_DEBUG else if (r != nonstrongly_refd) CYCLE_DEBUG_MSG (r, "> gc_cycle_push, search"); #endif
e2d9e62000-06-10Martin Stjernholm  } #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  if (weak && r == cycle_frame && !nonstrongly_refd) {
8ed8dc2001-07-01Martin Stjernholm  fprintf(stderr, "Only strong links in cycle:\n");
e7634f2007-05-13Martin Stjernholm  for (r = cycle_frame;; r = r->next) { describe (r->data); locate_references (r->data); if (r == stack_top) break;
8ed8dc2001-07-01Martin Stjernholm  fprintf(stderr, "========= next =========\n"); } gc_fatal(0, 0, "Only strong links in cycle.\n"); }
e2d9e62000-06-10Martin Stjernholm #endif }
e7634f2007-05-13Martin Stjernholm  if (weakly_refd) { /* 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 avoid having to clobber the others after the * rotation). */ CYCLE_DEBUG_MSG (weakly_refd, "gc_cycle_push, weak break");
3b7f9f2007-06-17Martin Stjernholm  /* If the backward link points into a cycle, we rotate the * whole cycle up the stack. See the "cycle checking" blurb * above for rationale. */ rotate_rec_stack (cycle_frame->cycle_id, weakly_refd); CHECK_REC_STACK (cycle_frame, "cycle_frame", weakly_refd, "weakly_refd");
e2d9e62000-06-10Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm  else { struct gc_rec_frame *cycle_id = cycle_frame->cycle_id; struct gc_rec_frame *break_pos; if (brokenly_refd) { /* Found a link that already has been broken once, so we * prefer to break at it again. */ CYCLE_DEBUG_MSG (brokenly_refd, "gc_cycle_push, break at broken"); break_pos = brokenly_refd; } else if (!weak) { CYCLE_DEBUG_MSG (cycle_frame, "gc_cycle_push, no break spot found"); break_pos = NULL; } else { /* weak < 0 */ /* The backward link is strong. Must break the cycle at the * last nonstrong link. */ CYCLE_DEBUG_MSG (nonstrongly_refd, "gc_cycle_push, nonstrong break"); break_pos = nonstrongly_refd; }
e2d9e62000-06-10Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  if (break_pos) { struct gc_rec_frame *rot_beg; rot_beg = rotate_rec_stack (cycle_frame, break_pos);
3d03502008-05-14Martin Stjernholm  rot_beg->rf_flags &= ~(GC_PREV_WEAK|GC_PREV_BROKEN); if (weak >= 0) rot_beg->rf_flags |= GC_PREV_STRONG;
e7634f2007-05-13Martin Stjernholm  if (rot_beg->cycle_id != break_pos->prev->cycle_id) /* Ensure that the cycle id frame is kept deepest in the * stack: Since there's no already marked cycle that * continues past the beginning of the rotated portion * (rot_beg and break_pos->prev were previously next to * each other), break_pos is now the deepest frame in the * cycle. */ cycle_id = break_pos;
46d4e72000-06-12Martin Stjernholm  }
45d87e2000-07-18Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  /* Mark the cycle. NB: This causes O(n^2) complexity for some * kinds of data structures. */ CHECK_REC_STACK_FRAME (cycle_id); { struct gc_rec_frame *r, *bottom = break_pos ? break_pos : cycle_frame; CYCLE_DEBUG_MSG (cycle_id, "gc_cycle_push, cycle"); for (r = stack_top;; r = r->prev) { r->cycle_id = cycle_id;
e442722007-06-09Martin Stjernholm  CHECK_REC_STACK_FRAME (r);
e7634f2007-05-13Martin Stjernholm  CYCLE_DEBUG_MSG (r, "> gc_cycle_push, mark cycle 1"); if (r == bottom) break;
e442722007-06-09Martin Stjernholm  } }
3b7f9f2007-06-17Martin Stjernholm  CHECK_REC_STACK (cycle_frame, "cycle_frame", break_pos, "break_pos");
e442722007-06-09Martin Stjernholm  } } }
e2d9e62000-06-10Martin Stjernholm  else if (!(m->flags & GC_CYCLE_CHECKED)) {
e7634f2007-05-13Martin Stjernholm  struct gc_rec_frame *r;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG cycle_checked++;
45d87e2000-07-18Martin Stjernholm  if (m->frame)
e7634f2007-05-13Martin Stjernholm  gc_fatal (data, 0, "Marker already got a frame.\n");
e2d9e62000-06-10Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  m->flags |= GC_CYCLE_CHECKED | (pm ? pm->flags & GC_LIVE : 0); m->frame = r = gc_cycle_enqueue_rec (data); debug_malloc_touch (data);
45d87e2000-07-18Martin Stjernholm  if (weak) {
e7634f2007-05-13Martin Stjernholm  if (weak > 0) r->rf_flags = GC_PREV_WEAK; else r->rf_flags = GC_PREV_STRONG;
45d87e2000-07-18Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm  else r->rf_flags = 0;
e2d9e62000-06-10Martin Stjernholm  #ifdef GC_CYCLE_DEBUG
e7634f2007-05-13Martin Stjernholm  if (weak > 0) CYCLE_DEBUG_MSG (r, "gc_cycle_push, recurse weak"); else if (weak < 0) CYCLE_DEBUG_MSG (r, "gc_cycle_push, recurse strong"); else CYCLE_DEBUG_MSG (r, "gc_cycle_push, recurse");
e2d9e62000-06-10Martin Stjernholm  gc_cycle_indent += 2; #endif
3b7f9f2007-06-17Martin Stjernholm  CHECK_REC_STACK (NULL, NULL, NULL, NULL);
e2d9e62000-06-10Martin Stjernholm  return 1; } /* Should normally not recurse now, but got to do that anyway if we
e7634f2007-05-13Martin Stjernholm  * must propagate GC_LIVE flags. */ if (!pm || !(pm->flags & GC_LIVE) || m->flags & GC_LIVE) { CYCLE_DEBUG_MSG (m->frame ? m->frame : NULL, "gc_cycle_push, no recurse");
e2d9e62000-06-10Martin Stjernholm  return 0; }
e7634f2007-05-13Martin Stjernholm  /* Initialize mark live recursion. */ gc_cycle_enqueue_rec (NULL)->rf_flags = GC_MARK_LIVE; #ifdef GC_CYCLE_DEBUG CYCLE_DEBUG_MSG (m->frame ? m->frame : NULL, "gc_cycle_push, mark live begins"); gc_cycle_indent += 2; #endif mark_live:
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG if (m->flags & GC_LIVE)
e7634f2007-05-13Martin Stjernholm  Pike_fatal("Shouldn't mark live recurse when there's nothing to do.\n");
e2d9e62000-06-10Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  m->flags |= GC_LIVE; debug_malloc_touch (data);
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(). */
e7634f2007-05-13Martin Stjernholm  gc_free_extra_ref (data); if (!sub_ref ((struct ref_dummy *) data)) {
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  gc_fatal (data, 0, "Thing got zero refs after removing the dead gc ref.\n");
e2d9e62000-06-10Martin Stjernholm #endif } }
e7634f2007-05-13Martin Stjernholm  /* Visit links without pushing a rec frame. */
8e6d5c2001-07-02Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  mark_live++;
8e6d5c2001-07-02Martin Stjernholm #endif
e2d9e62000-06-10Martin Stjernholm  return 1; }
e7634f2007-05-13Martin Stjernholm static void gc_cycle_pop()
e2d9e62000-06-10Martin Stjernholm { #ifdef PIKE_DEBUG if (Pike_in_gc != GC_PASS_CYCLE)
5aad932002-08-15Marcus Comstedt  Pike_fatal("GC cycle pop attempted in invalid pass.\n");
e7634f2007-05-13Martin Stjernholm  if (stack_top->u.link_top) gc_fatal (stack_top->data, 0, "Link list not empty for popped rec frame.\n");
e2d9e62000-06-10Martin Stjernholm #endif #ifdef GC_CYCLE_DEBUG gc_cycle_indent -= 2; #endif
e7634f2007-05-13Martin Stjernholm  if (stack_top->rf_flags & GC_MARK_LIVE) { struct gc_rec_frame *r = stack_top->prev; CYCLE_DEBUG_MSG (stack_top, "gc_cycle_pop, mark live ends"); really_free_gc_rec_frame (stack_top); stack_top = r;
e2d9e62000-06-10Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm  else { struct gc_rec_frame *popped = stack_top;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  { void *data = popped->data; struct marker *m = find_marker (data); if (gc_is_watching && m && m->flags & GC_WATCHED) { /* This is useful to set breakpoints on. */ gc_watched_found (m, "gc_cycle_pop()"); } if (!(m->flags & GC_CYCLE_CHECKED)) gc_fatal (data, 0, "Marker being popped doesn't have GC_CYCLE_CHECKED.\n"); if (!gc_destruct_everything) { if ((!(m->flags & GC_NOT_REFERENCED) || m->flags & GC_MARKED) && *(INT32 *) data) gc_fatal (data, 1, "Got a referenced marker to gc_cycle_pop.\n"); if (m->flags & GC_XREFERENCED) gc_fatal (data, 1, "Doing cycle check in externally referenced thing " "missed in mark pass.\n"); } if (popped->next != (struct gc_rec_frame *) (ptrdiff_t) -1) gc_fatal (data, 0, "Popped rec frame got stuff in the next pointer.\n"); }
9326332000-06-12Martin Stjernholm #endif
e2d9e62000-06-10Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  stack_top = popped->prev; #ifdef PIKE_DEBUG if (stack_top != &sentinel_frame) CHECK_REC_STACK_FRAME (stack_top); CHECK_REC_STACK_FRAME (popped); #endif
5b12752007-05-23Martin Stjernholm  popped->prev = NULL;
af72c52000-07-02Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  if (popped->cycle_id != popped) { /* Part of a cycle that extends further back - move to the cycle * piece list of the previous frame. */ struct gc_rec_frame *this_list_last = popped->cycle_piece ? popped->cycle_piece->u.last_cycle_piece : popped;
e2d9e62000-06-10Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  if (this_list_last->cycle_piece) gc_fatal (this_list_last->data, 0, "This frame should be last on the cycle piece list.\n"); popped->rf_flags |= GC_ON_CYCLE_PIECE_LIST; CHECK_CYCLE_PIECE_FRAME (this_list_last);
e2d9e62000-06-10Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  CYCLE_DEBUG_MSG (popped, "gc_cycle_pop, keep cycle piece"); if (!stack_top->cycle_piece) popped->u.last_cycle_piece = this_list_last; else { /* Link in the popped frame and its cycle piece list before * the one that the previous frame has. */ struct gc_rec_frame *up_list_first = stack_top->cycle_piece; struct gc_rec_frame *up_list_last = up_list_first->u.last_cycle_piece; #ifdef PIKE_DEBUG CHECK_CYCLE_PIECE_FRAME (up_list_last); if (up_list_last->cycle_piece) gc_fatal (up_list_last->data, 0, "This frame should be last on the cycle piece list.\n"); #endif CYCLE_DEBUG_MSG (up_list_first, "> gc_cycle_pop, inserted before"); this_list_last->cycle_piece = up_list_first; popped->u.last_cycle_piece = up_list_last; } stack_top->cycle_piece = popped; popped->cycle_id = stack_top;
3b7f9f2007-06-17Martin Stjernholm #ifdef PIKE_DEBUG popped->next = (void *) (ptrdiff_t) -1; #endif
e7634f2007-05-13Martin Stjernholm  CHECK_CYCLE_PIECE_FRAME (popped); CHECK_REC_STACK_FRAME (stack_top);
e2d9e62000-06-10Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm 
45d87e2000-07-18Martin Stjernholm  else {
e7634f2007-05-13Martin Stjernholm  /* Free or move to the kill list the popped frame and its cycle * piece list. */ struct gc_rec_frame **kill_list_ptr = &kill_list; struct gc_rec_frame *cycle_id = NULL; #ifdef PIKE_DEBUG { struct gc_rec_frame *r; for (r = popped->cycle_piece; r; r = r->cycle_piece) /* Can't do this while the list is being freed below. */ CHECK_CYCLE_PIECE_FRAME (r);
2b8dde2000-09-15Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm #endif CYCLE_DEBUG_MSG (popped, "gc_cycle_pop, popping cycle"); do { struct marker *m = find_marker (popped->data); struct gc_rec_frame *next = popped->cycle_piece; if (m->flags & GC_LIVE_OBJ) { /* Move to the kill list. */ #ifdef PIKE_DEBUG popped->rf_flags &= ~GC_ON_CYCLE_PIECE_LIST; popped->cycle_piece = popped->u.last_cycle_piece = (struct gc_rec_frame *) (ptrdiff_t) -1; #endif popped->next = *kill_list_ptr; *kill_list_ptr = popped; kill_list_ptr = &popped->next; popped->rf_flags |= GC_ON_KILL_LIST; /* Ensure that the frames on the kill list have a valid * cycle id frame and that every frame is linked directly to * it. This is only for the sake of warn_bad_cycles. */ if (!cycle_id) cycle_id = popped; popped->cycle_id = cycle_id; /* 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 (!(m->flags & GC_GOT_DEAD_REF)) gc_add_extra_ref (popped->data); CHECK_KILL_LIST_FRAME (popped); CYCLE_DEBUG_MSG (popped, "> gc_cycle_pop, move to kill list"); } else { if (!(m->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. */ if (!(m->flags & GC_GOT_DEAD_REF)) { gc_add_extra_ref (popped->data); m->flags |= GC_GOT_DEAD_REF; } }
996f872000-06-12Martin Stjernholm #ifdef PIKE_DEBUG
e7634f2007-05-13Martin Stjernholm  else if (m->flags & GC_GOT_DEAD_REF) gc_fatal (popped->data, 0, "Didn't expect a dead extra ref.\n");
45d87e2000-07-18Martin Stjernholm #endif
e2d9e62000-06-10Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm  CYCLE_DEBUG_MSG (popped, "> gc_cycle_pop, free"); m->frame = NULL; really_free_gc_rec_frame (popped); } popped = next; } while (popped); }
45d87e2000-07-18Martin Stjernholm  }
cde9da2005-04-15Martin Stjernholm 
e7634f2007-05-13Martin Stjernholm #ifdef PIKE_DEBUG stack_top->next = (struct gc_rec_frame *) (ptrdiff_t) -1; #endif
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 */
0ca86e2005-04-09Henrik Grubbström (Grubba) static void warn_bad_cycles(void)
e2d9e62000-06-10Martin Stjernholm {
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 
e7634f2007-05-13Martin Stjernholm #if 0
66ac542000-09-05Henrik Grubbström (Grubba)  {
1bad5c2005-04-14Martin Stjernholm  struct gc_pop_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;) {
1bad5c2005-04-14Martin Stjernholm  if ((cycle = p->cycle)) {
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  }
1bad5c2005-04-14Martin Stjernholm  p = p->next; if (p ? ((unsigned)(p->cycle != 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; } }
e7634f2007-05-13Martin Stjernholm #endif
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;
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;
e7634f2007-05-13Martin Stjernholm  mark_live = frame_rot = link_search = 0;
50d97a2003-02-01Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  rec_frames = link_frames = free_extra_frames = 0; max_rec_frames = max_link_frames = 0;
7bf6232000-04-23Martin Stjernholm  if (gc_debug) {
e2d9e62000-06-10Martin Stjernholm  unsigned n;
7bf6232000-04-23Martin Stjernholm  Pike_in_gc = GC_PASS_PRETOUCH; n = gc_touch_all_arrays(); n += gc_touch_all_multisets(); n += gc_touch_all_mappings(); n += gc_touch_all_programs(); n += gc_touch_all_objects();
50d97a2003-02-01Martin Stjernholm #ifdef PIKE_DEBUG
22aa2f2000-09-04Martin Stjernholm  gc_touch_all_strings();
50d97a2003-02-01Martin Stjernholm #endif
dda7592008-07-24Martin Stjernholm  if (n != (unsigned) num_objects && !got_unlinked_things)
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();
fec15e2007-04-25Martin Stjernholm #if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP)
cd9dfa2008-03-29Martin Stjernholm  gc_check_all_types();
fec15e2007-04-25Martin Stjernholm #endif
01c63f2003-04-28Martin Stjernholm  } 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 
ee204c2008-05-04Martin Stjernholm  /* Object alloc/free are still disallowed, but refs might be lowered * by gc_free_(short_)svalue. */
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 #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
e7634f2007-05-13Martin Stjernholm  if (stack_top != &sentinel_frame)
cde9da2005-04-15Martin Stjernholm  Pike_fatal("Frame stack not empty at end of 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,
e7634f2007-05-13Martin Stjernholm  "| cycle: %u internal things visited,\n"
d9d6f02001-06-30Martin Stjernholm  "| %u weak references freed, %d more things to free,\n"
e7634f2007-05-13Martin Stjernholm  "| %u mark live visits, %u frame rotations,\n" "| %u links searched, used max %u link frames,\n" "| %u rec frames and %u free extra frames\n", cycle_checked, weak_freed, delayed_freed - obj_count, mark_live, frame_rot, link_search, max_link_frames, max_rec_frames, free_extra_frames)); #ifdef PIKE_DEBUG if (link_frames) fatal ("Leaked %u link frames.\n", link_frames); #endif
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
a3574b2007-05-13Martin Stjernholm  Pike_in_gc=GC_PASS_POSTTOUCH;
22aa2f2000-09-04Martin Stjernholm  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
dda7592008-07-24Martin Stjernholm  if (n != (unsigned) num_objects && !got_unlinked_things)
5aad932002-08-15Marcus Comstedt  Pike_fatal("Object count wrong in gc; expected %d, got %d.\n", num_objects, n);
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)
a3574b2007-05-13Martin Stjernholm  if (!(m->flags & (GC_POSTTOUCHED|GC_WEAK_FREED)) &&
22aa2f2000-09-04Martin Stjernholm  dmalloc_is_invalid_memory_block(m->data)) {
a3574b2007-05-13Martin Stjernholm  fprintf(stderr, "Found a stray marker after posttouch pass: ");
22aa2f2000-09-04Martin Stjernholm  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);
a3574b2007-05-13Martin Stjernholm  Pike_in_gc = GC_PASS_POSTTOUCH;
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
a3574b2007-05-13Martin Stjernholm  GC_VERBOSE_DO(fprintf(stderr, "| posttouch\n"));
22aa2f2000-09-04Martin Stjernholm  }
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 
e7634f2007-05-13Martin Stjernholm  if (free_extra_frames > tot_max_free_extra_frames) tot_max_free_extra_frames = free_extra_frames;
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) {
e7634f2007-05-13Martin Stjernholm  struct free_extra_frame *next = free_extra_list->next;
fcb3222001-07-05Martin Stjernholm  union anything u; u.refs = (INT32 *) free_extra_list->data;
1bad5c2005-04-14Martin Stjernholm  gc_free_extra_ref (u.refs); free_short_svalue (&u, free_extra_list->type);
e7634f2007-05-13Martin Stjernholm  really_free_free_extra_frame (free_extra_list);
fcb3222001-07-05Martin Stjernholm  free_extra_list = next; }
e7634f2007-05-13Martin Stjernholm #ifdef PIKE_DEBUG if (free_extra_frames) fatal ("Leaked %u free extra frames.\n", free_extra_frames); #endif GC_VERBOSE_DO(fprintf(stderr, "| free: %"PRINTSIZET"u unreferenced, " "%d really freed, %u left with live references\n",
a1b3872003-01-11Martin Stjernholm  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;
e7634f2007-05-13Martin Stjernholm 
e2d9e62000-06-10Martin Stjernholm  /* Destruct the live objects in cycles, but first warn about any bad * cycles. */ pre_kill_objs = num_objects;
e7634f2007-05-13Martin Stjernholm  if (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
e7634f2007-05-13Martin Stjernholm 
09f2882005-02-09Martin Stjernholm  { enum object_destruct_reason reason = #ifdef DO_PIKE_CLEANUP gc_destruct_everything ? DESTRUCT_CLEANUP : #endif DESTRUCT_GC;
e7634f2007-05-13Martin Stjernholm  #ifdef PIKE_DEBUG { struct gc_rec_frame *r; for (r = kill_list; r != &sentinel_frame; r = r->next) /* Can't do this while the list is being freed below. */ CHECK_KILL_LIST_FRAME (r); } #endif while (kill_list != &sentinel_frame) { struct gc_rec_frame *next = kill_list->next;
09f2882005-02-09Martin Stjernholm  struct object *o = (struct object *) kill_list->data;
e7634f2007-05-13Martin Stjernholm 
09f2882005-02-09Martin Stjernholm #ifdef PIKE_DEBUG if ((get_marker(kill_list->data)->flags & (GC_LIVE|GC_LIVE_OBJ)) != (GC_LIVE|GC_LIVE_OBJ)) gc_fatal(o, 0, "Invalid object on kill list.\n"); 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) gc_fatal(o, 0, "GC destructed parent prematurely.\n"); #endif
e7634f2007-05-13Martin Stjernholm 
09f2882005-02-09Martin Stjernholm  GC_VERBOSE_DO( fprintf(stderr, "| Killing %p with %d refs", o, o->refs); if (o->prog) { INT32 line; struct pike_string *file = get_program_line (o->prog, &line); fprintf(stderr, ", prog %s:%d\n", file->str, line); free_string(file); } else fputs(", is destructed\n", stderr); );
e7634f2007-05-13Martin Stjernholm 
09f2882005-02-09Martin Stjernholm  destruct_object (o, reason); free_object(o); gc_free_extra_ref(o);
8e5a402004-03-16Martin Stjernholm #if defined (PIKE_DEBUG) || defined (DO_PIKE_CLEANUP)
09f2882005-02-09Martin Stjernholm  destroy_count++;
e2d9e62000-06-10Martin Stjernholm #endif
e7634f2007-05-13Martin Stjernholm  really_free_gc_rec_frame (kill_list);
09f2882005-02-09Martin Stjernholm  kill_list = next; }
e2d9e62000-06-10Martin Stjernholm  }
e7634f2007-05-13Martin Stjernholm #ifdef PIKE_DEBUG if (rec_frames) fatal ("Leaked %u rec frames.\n", rec_frames); #endif GC_VERBOSE_DO(fprintf(stderr, "| kill: %u objects killed, " "%"PRINTSIZET"u things really freed\n",
e2d9e62000-06-10Martin Stjernholm  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 
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
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) {
247f732007-06-10Martin Stjernholm #ifdef CPU_TIME_MIGHT_BE_THREAD_LOCAL
e0587b2008-06-30Henrik Grubbström (Grubba)  if (cpu_time_is_thread_local #ifdef PIKE_DEBUG /* At high debug levels, the gc may get called before * the threads are initialized. */ && Pike_interpreter.thread_state #endif )
247f732007-06-10Martin Stjernholm  Pike_interpreter.thread_state->auto_gc_time += last_gc_time; else #endif { #ifdef CPU_TIME_MIGHT_NOT_BE_THREAD_LOCAL auto_gc_time += last_gc_time;
70ef1d2007-06-10Martin Stjernholm #endif
247f732007-06-10Martin Stjernholm  }
f4a9952003-02-08Martin Stjernholm  }
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)
daf2ac2006-01-24Martin Stjernholm  fprintf(stderr, "done (%u %s destructed)%s\n", destroy_count, destroy_count == 1 ? "was" : "were", timestr);
e7fc302004-03-17Martin Stjernholm  else #endif
ad8d052008-05-02Martin Stjernholm  fprintf(stderr, "done (%"PRINTSIZET"u of %"PRINTSIZET"u "
daf2ac2006-01-24Martin Stjernholm  "%s unreferenced)%s\n", unreferenced, start_num_objs, unreferenced == 1 ? "was" : "were", 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  tot_cycle_checked += cycle_checked;
e7634f2007-05-13Martin Stjernholm  tot_mark_live += mark_live, tot_frame_rot += frame_rot;
6930181996-02-25Fredrik Hübinette (Hubbe) #endif
e7634f2007-05-13Martin Stjernholm  if (max_rec_frames > tot_max_rec_frames) tot_max_rec_frames = max_rec_frames; if (max_link_frames > tot_max_link_frames) tot_max_link_frames = max_link_frames;
a29e021996-10-15Fredrik Hübinette (Hubbe) 
a3574b2007-05-13Martin Stjernholm  Pike_in_gc=0; exit_gc();
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++;
e7634f2007-05-13Martin Stjernholm #ifdef PIKE_DEBUG push_constant_text ("max_rec_frames"); push_int64 (DO_NOT_WARN ((INT64) tot_max_rec_frames)); push_constant_text ("max_link_frames"); push_int64 (DO_NOT_WARN ((INT64) tot_max_link_frames)); push_constant_text ("max_free_extra_frames"); push_int64 (DO_NOT_WARN ((INT64) tot_max_free_extra_frames)); #endif
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
e7634f2007-05-13Martin Stjernholm  fprintf(stderr,"Max used recursion frames : %u\n", tot_max_rec_frames); fprintf(stderr,"Max used link frames : %u\n", tot_max_link_frames); fprintf(stderr,"Max used free extra frames : %u\n", tot_max_free_extra_frames); fprintf(stderr,"Marked live ratio : %g\n", (double) tot_mark_live / tot_cycle_checked);
51adb82003-01-12Martin Stjernholm  fprintf(stderr,"Frame rotation ratio : %g\n", (double) tot_frame_rot / tot_cycle_checked); #endif fprintf(stderr,"in_gc : %d\n", Pike_in_gc); }
c095962008-05-11Martin Stjernholm void cleanup_gc(void) { #ifdef PIKE_DEBUG if (gc_evaluator_callback) { remove_callback(gc_evaluator_callback); gc_evaluator_callback = NULL; } #endif /* PIKE_DEBUG */ } /* Visit things API */ PMOD_EXPORT visit_ref_cb *visit_ref = NULL; /* Be careful if extending this with internal types like * T_MAPPING_DATA and T_MULTISET_DATA; there's code that assumes * type_from_visit_fn only returns types that fit in a TYPE_FIELD. */ PMOD_EXPORT visit_thing_fn *const visit_fn_from_type[MAX_REF_TYPE + 1] = { (visit_thing_fn *) &visit_array, (visit_thing_fn *) &visit_mapping, (visit_thing_fn *) &visit_multiset, (visit_thing_fn *) &visit_object, /* visit_function must be called with a whole svalue, so it's not * included here. */ (visit_thing_fn *) (ptrdiff_t) -1, (visit_thing_fn *) &visit_program, (visit_thing_fn *) &visit_string, (visit_thing_fn *) &visit_type, }; PMOD_EXPORT TYPE_T type_from_visit_fn (visit_thing_fn *fn) { /* Since the array to search is so small, linear search is probably * fastest. */ unsigned t; for (t = 0; t < NELEM (visit_fn_from_type); t++) if (visit_fn_from_type[t] == fn) return (TYPE_T) t; return PIKE_T_UNKNOWN; }
c4d2032008-05-11Martin Stjernholm /* Memory counting
c095962008-05-11Martin Stjernholm  * * This mode is used by f_count_memory, and it's recognized by a
c4d2032008-05-11Martin Stjernholm  * nonzero value in mc_pass.
c095962008-05-11Martin Stjernholm  * * The basic idea is to follow and count all refs from the starting * point things given to f_count_memory. Whenever the counted refs add * up to the refcount for a thing, that thing is known to have only * internal refs, and so it's memory counted and then all its refs are * followed too. * * To cope with internal cyclic refs, there's a "lookahead" algorithm * which recurses through more things in the hope of finding cycles * that otherwise would make us miss internal refs. This lookahead is * limited by mc_lookahead and mc_block_lookahead. * * All things are categorized as follows: * * o Internal things: These are known to have only internal * references and are memory counted. The things given to * f_count_memory as starting points are initially asserted to be * internal regardless of how many refs they got. * * o Lookahead things: A lookahead thing is one that has been found * by following refs from an internal thing. * * Every lookahead thing has a distance which is the number of refs * that were followed from an internal thing to reach it. If a * lookahead thing later on is found through another path with * fewer refs, its distance is lowered so that it eventually * reflects the shortest path. The traversal stops when the * distance reaches mc_lookahead (or if the type is blocked by * mc_block_lookahead). * * Lookahead things are further divided into three categories: * * o Incomplete: Things whose refcounts (still) are higher than * all refs coming to them from both internal and lookahead * things. * o Complete: Things whose refs from internal and lookahead * things equal their refcounts. I.e. we've found all refs going * to these. * o Indirectly incomplete: In MC_PASS_MARK_EXTERNAL, these are * all the complete things found to be referenced by incomplete * things. * * These sets are tracked through three double linked lists, * mc_incomplete, mc_complete, and mc_indirect respectively. * * o Unvisited things: Everything else that hasn't been visited yet. * * For every visited thing we record the number of refs from internal * things (int_refs) and from lookahead things (la_refs). * * The basic algorithm for finding all internal things works like * this: * * First the starting point things are labelled internal and put into * the work list (mc_work_list). * * mc_pass is set to MC_PASS_LOOKAHEAD: * * We do a breadth-first recursion through the things in the work list * until we reach the mc_lookahead distance. * * Every time we visit something we calculate its distance as either * the same as the distance of the source thing (if the target is * found to be internal or if the followed ref is REF_TYPE_INTERNAL), * or the next greater distance (otherwise). If the distance is lower * than mc_lookahead and the thing is either new or its current * distance is greater, it's added to the work list. * * Since new things always are added to the work list at the same or * the next greater distance, it will never hold things at more than * two distances at once. Thus we can simply enqueue things at the * same distance first and those at the next distance last. * * We might however need to dequeue something at the greater distance * to be able to reenqueue it at the same distance. mc_work_list is * double linked to be able to dequeue quickly. * * int_refs and la_refs are updated when things are visited. They * become internal if int_refs add up to the refcount. Otherwise they * are put in the incomplete or complete sets as appropriate. * * mc_pass is set to MC_PASS_MARK_EXTERNAL: * * At this point the set of lookahead things is complete (as far as we * are concerned), and it's divided into complete and incomplete * lookahead things. All references in the incomplete list are * followed to build up the set of indirectly incomplete things. The * incomplete and indirectly incomplete things are referenced * externally and should not be memory counted. * * If there's anything left in the complete list then it's internal * cyclic stuff. In that case we put those things into the work list * at distance zero, move the indirectly incomplete list back to * complete and repeat MC_PASS_LOOKAHEAD. Otherwise we're done. */ /* #define MEMORY_COUNT_DEBUG */ PMOD_EXPORT int mc_pass; PMOD_EXPORT size_t mc_counted_bytes; static unsigned mc_lookahead; static TYPE_FIELD mc_block_lookahead; static TYPE_FIELD mc_block_lookahead_default = BIT_PROGRAM|BIT_STRING; /* Strings are blocked because they don't contain refs. */ static unsigned mc_ext_toggle_bias = 0; #define MC_PASS_LOOKAHEAD 1 #define MC_PASS_MARK_EXTERNAL 2 /* Set in when the refs emanating from a thing have been counted. */ #define MC_FLAG_REFCOUNTED 0x01 /* Set when a thing has become internal. */ #define MC_FLAG_INTERNAL 0x02 /* Set when a thing has been called with VISIT_COUNT_BYTES (after the * visit function has returned). */ #define MC_FLAG_MEMCOUNTED 0x04 /* A toggle flag to mark external (i.e. incomplete and indirectly * incomplete) things in MC_PASS_MARK_EXTERNAL so that we don't * recurse them repeatedly. If mc_ext_toggle_bias is zero then it's * external if this is set. If mc_ext_toggle_bias is one then it's * external if this is cleared. mc_ext_toggle_bias toggles every time * we leave MC_PASS_MARK_EXTERNAL, thus we avoid the work to go * through the externals clear the flag for the next round. */ #define MC_FLAG_EXT_TOGGLE 0x08 #define IS_EXTERNAL(M) \ (((M)->flags ^ mc_ext_toggle_bias) & MC_FLAG_EXT_TOGGLE) #define INIT_CLEARED_EXTERNAL(M) do { \ struct mc_marker *_m = (M); \ if (mc_ext_toggle_bias) _m->flags |= MC_FLAG_EXT_TOGGLE; \ } while (0) #define FLAG_EXTERNAL(M) do { \ struct mc_marker *_m = (M); \ assert (!IS_EXTERNAL (_m)); \ _m->flags ^= MC_FLAG_EXT_TOGGLE; \ } while (0) #define TOGGLE_EXT_FLAGS() do { \ mc_ext_toggle_bias ^= MC_FLAG_EXT_TOGGLE; \ } while (0) struct mc_marker { struct mc_marker *hash_next; /* Used by PTR_HASH_ALLOC. */ struct mc_marker *wl_prev; /* Work list pointers. wl_next is NULL for */ struct mc_marker *wl_next; /* things not on the work list. */ struct mc_marker *dl_prev; /* For the mc_incomplete, mc_complete and */ struct mc_marker *dl_next; /* mc_indirect lists. Used iff not internal.*/ void *thing; /* Referenced thing. */ visit_thing_fn *visit_fn; /* Visit function for it */ void *extra; /* and its extra data. */ INT32 int_refs; /* These refcounts are bogus */ INT32 la_refs; /* for internal things. */ unsigned INT32 dist; /* Distance. */ unsigned INT16 flags; }; #undef BLOCK_ALLOC_NEXT #undef BLOCK_ALLOC_NEXT #define BLOCK_ALLOC_NEXT hash_next #undef PTR_HASH_ALLOC_DATA #define PTR_HASH_ALLOC_DATA thing #undef INIT_BLOCK #define INIT_BLOCK(f) #undef EXIT_BLOCK #define EXIT_BLOCK(f) PTR_HASH_ALLOC_FILL_PAGES (mc_marker, 2) static struct mc_marker *my_make_mc_marker (void *thing, visit_thing_fn *visit_fn, void *extra) { struct mc_marker *m = make_mc_marker (thing); assert (thing); assert (visit_fn); m->thing = thing; m->visit_fn = visit_fn; m->extra = extra; m->int_refs = m->la_refs = m->flags = 0; INIT_CLEARED_EXTERNAL (m); m->wl_next = NULL; #ifdef PIKE_DEBUG m->wl_prev = m->dl_prev = m->dl_next = (void *) (ptrdiff_t) -1; m->dist = MAX_UINT32; #endif return m; } #if defined (PIKE_DEBUG) || defined (MEMORY_COUNT_DEBUG) static void describe_mc_marker (struct mc_marker *m) {
d9c3e72008-05-11Martin Stjernholm  fprintf (stderr, "%s %p: refs %d, int %d, la %d, dist %u",
c095962008-05-11Martin Stjernholm  get_name_of_type (type_from_visit_fn (m->visit_fn)), m->thing, *(INT32 *) m->thing, m->int_refs, m->la_refs, m->dist); if (m->flags & MC_FLAG_REFCOUNTED) fputs (", RC", stderr); if (m->flags & MC_FLAG_INTERNAL) fputs (", INT", stderr); if (m->flags & MC_FLAG_MEMCOUNTED) fputs (", MC", stderr); if (IS_EXTERNAL (m)) fputs (", EXT", stderr); if (m->wl_next) fputs (", on wl", stderr); } #endif static struct mc_marker mc_work_list = { /* Sentinel. The work list starts at work_list.wl_next. */ (void *) (ptrdiff_t) -1, &mc_work_list, &mc_work_list, (void *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1,
d3d02c2008-05-11Martin Stjernholm  (void *) (ptrdiff_t) -1, (visit_thing_fn *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, -1, -1, MAX_UINT32, (unsigned INT16) -1
c095962008-05-11Martin Stjernholm }; #define WL_ADD_FIRST(M) do { \ struct mc_marker *_m = (M); \ struct mc_marker *_list_next = mc_work_list.wl_next; \ DO_IF_DEBUG (assert (_m->wl_prev == (void *) (ptrdiff_t) -1)); \ assert (_m->wl_next == NULL); \ _m->wl_prev = &mc_work_list; \ _m->wl_next = _list_next; \ mc_work_list.wl_next = _list_next->wl_prev = _m; \ } while (0) #define WL_ADD_LAST(M) do { \ struct mc_marker *_m = (M); \ struct mc_marker *_list_prev = mc_work_list.wl_prev; \ DO_IF_DEBUG (assert (_m->wl_prev == (void *) (ptrdiff_t) -1)); \ assert (_m->wl_next == NULL); \ _m->wl_prev = _list_prev; \ _m->wl_next = &mc_work_list; \ mc_work_list.wl_prev = _list_prev->wl_next = _m; \ } while (0) #define WL_REMOVE(M) do { \ struct mc_marker *_m = (M); \ struct mc_marker *_list_prev = _m->wl_prev; \ struct mc_marker *_list_next = _m->wl_next; \ assert (_m->wl_prev != (void *) (ptrdiff_t) -1); \ assert (_m->wl_next != (void *) (ptrdiff_t) -1); \ _list_prev->wl_next = _list_next; \ _list_next->wl_prev = _list_prev; \ DO_IF_DEBUG (_m->wl_prev = (void *) (ptrdiff_t) -1); \ _m->wl_next = NULL; \ } while (0) static INLINE void mc_wl_enqueue_first (struct mc_marker *m) { if (m->wl_next) WL_REMOVE (m); WL_ADD_FIRST (m); } static INLINE void mc_wl_enqueue_last (struct mc_marker *m) { /* Note: Does not try to remove from the queue first. */ WL_ADD_LAST (m); } static INLINE struct mc_marker *mc_wl_dequeue() { struct mc_marker *m = mc_work_list.wl_next; if (m != &mc_work_list) { WL_REMOVE (m); return m; } return NULL; } static struct mc_marker mc_incomplete = { /* Sentinel for the incomplete lookaheads list. */ (void *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, &mc_incomplete, &mc_incomplete,
d3d02c2008-05-11Martin Stjernholm  (void *) (ptrdiff_t) -1, (visit_thing_fn *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, -1, -1, MAX_UINT32, (unsigned INT16) -1
c095962008-05-11Martin Stjernholm }; static struct mc_marker mc_complete = { /* Sentinel for the complete lookaheads list. */ (void *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, &mc_complete, &mc_complete,
d3d02c2008-05-11Martin Stjernholm  (void *) (ptrdiff_t) -1, (visit_thing_fn *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, -1, -1, MAX_UINT32, (unsigned INT16) -1
c095962008-05-11Martin Stjernholm }; static struct mc_marker mc_indirect = { /* Sentinel for the indirectly incomplete lookaheads list. */ (void *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, &mc_indirect, &mc_indirect,
d3d02c2008-05-11Martin Stjernholm  (void *) (ptrdiff_t) -1, (visit_thing_fn *) (ptrdiff_t) -1, (void *) (ptrdiff_t) -1, -1, -1, MAX_UINT32, (unsigned INT16) -1
c095962008-05-11Martin Stjernholm }; #define DL_IS_EMPTY(LIST) (LIST.dl_next == &LIST) #define DL_ADD(LIST, M) do { \ struct mc_marker *_m = (M); \ struct mc_marker *_list_next = LIST.dl_next; \ DO_IF_DEBUG ( \ assert (_m->dl_prev == (void *) (ptrdiff_t) -1); \ assert (_m->dl_next == (void *) (ptrdiff_t) -1); \ ); \ _m->dl_prev = &LIST; \ _m->dl_next = _list_next; \ LIST.dl_next = _list_next->dl_prev = _m; \ } while (0) #define DL_REMOVE(M) do { \ struct mc_marker *_m = (M); \ struct mc_marker *_list_prev = _m->dl_prev; \ struct mc_marker *_list_next = _m->dl_next; \ assert (_m->dl_prev != (void *) (ptrdiff_t) -1); \ assert (_m->dl_next != (void *) (ptrdiff_t) -1); \ _list_prev->dl_next = _list_next; \ _list_next->dl_prev = _list_prev; \ DO_IF_DEBUG (_m->dl_prev = _m->dl_next = (void *) (ptrdiff_t) -1); \ } while (0) #define DL_MOVE(FROM_LIST, TO_LIST) do { \ assert (TO_LIST.dl_prev == &TO_LIST); \ assert (TO_LIST.dl_next == &TO_LIST); \ if (FROM_LIST.dl_next != &FROM_LIST) { \ TO_LIST.dl_prev = FROM_LIST.dl_prev; \ TO_LIST.dl_next = FROM_LIST.dl_next; \ FROM_LIST.dl_prev->dl_next = &TO_LIST; \ FROM_LIST.dl_next->dl_prev = &TO_LIST; \ FROM_LIST.dl_prev = FROM_LIST.dl_next = &FROM_LIST; \ } \ } while (0) #define DL_MAKE_EMPTY(LIST) do { \ LIST.dl_prev = LIST.dl_next = &LIST; \ } while (0) static struct mc_marker *mc_ref_from = (void *) (ptrdiff_t) -1; #ifdef MEMORY_COUNT_DEBUG static void MC_DEBUG_MSG (struct mc_marker *m, const char *msg) { switch (mc_pass) { case MC_PASS_LOOKAHEAD: fputs ("LA ", stderr); break; case MC_PASS_MARK_EXTERNAL: fputs ("ME ", stderr); break; } if (m) { if (mc_ref_from != (void *) (ptrdiff_t) -1) fputs (" [", stderr); else fputs ("[", stderr); describe_mc_marker (m); fprintf (stderr, "] %s\n", msg); } else if (mc_ref_from != (void *) (ptrdiff_t) -1) { fputs ("{", stderr); describe_mc_marker (mc_ref_from); fprintf (stderr, "} %s\n", msg); } } #else #define MC_DEBUG_MSG(m, msg) do {} while (0) #endif /* memory_count_enter gets called both from the gc_check_* calls we * make for each thing in the work list, and also from the calls made * through the gc_check_* functions for each reference inside the * things. We use mc_has_entered_thing to figure out which. */ static void pass_lookahead_visit_ref (void *thing, int ref_type, visit_thing_fn *visit_fn, void *extra) { struct mc_marker *ref_to = find_mc_marker (thing); int ref_to_is_new = !ref_to; unsigned cur_dist; int ref_from_flags; assert (mc_pass == MC_PASS_LOOKAHEAD); #ifdef PIKE_DEBUG assert (mc_ref_from != (void *) (ptrdiff_t) -1); #endif cur_dist = mc_ref_from->dist; ref_from_flags = mc_ref_from->flags; if (ref_to_is_new) { ref_to = my_make_mc_marker (thing, visit_fn, extra); MC_DEBUG_MSG (ref_to, "visiting new thing"); assert (!(ref_from_flags & MC_FLAG_REFCOUNTED)); } else if (ref_to->flags & MC_FLAG_INTERNAL) { /* Ignore refs to internal things. Can't treat them like other * things anyway since the int_refs aren't valid for the starting * points. */ MC_DEBUG_MSG (ref_to, "ignored internal"); return; } else MC_DEBUG_MSG (ref_to, "visiting old thing"); if (ref_from_flags & MC_FLAG_INTERNAL) { if (!(ref_from_flags & MC_FLAG_REFCOUNTED)) ref_to->int_refs++; else { /* mc_ref_from is a former lookahead thing that has become internal. */ assert (ref_to->la_refs > 0); ref_to->la_refs--; ref_to->int_refs++; } assert (ref_to->int_refs + ref_to->la_refs <= *(INT32 *) thing); if (ref_to->int_refs == *(INT32 *) thing) { /* Found a new internal thing. */ ref_to->flags |= MC_FLAG_INTERNAL; ref_to->dist = 0; if (!ref_to_is_new) DL_REMOVE (ref_to); mc_wl_enqueue_first (ref_to); MC_DEBUG_MSG (ref_to, "made internal and enqueued"); return; } else MC_DEBUG_MSG (ref_to, "added internal ref"); } else { if (!(ref_from_flags & MC_FLAG_REFCOUNTED)) { ref_to->la_refs++; MC_DEBUG_MSG (ref_to, "added lookahead ref"); } assert (ref_to->int_refs + ref_to->la_refs <= *(INT32 *) thing); } if (!(ref_from_flags & MC_FLAG_REFCOUNTED)) { if (ref_to->int_refs + ref_to->la_refs == *(INT32 *) thing) { /* The thing has become complete. */ if (!ref_to_is_new) DL_REMOVE (ref_to); DL_ADD (mc_complete, ref_to); MC_DEBUG_MSG (ref_to, "refs are complete"); } else if (ref_to_is_new) DL_ADD (mc_incomplete, ref_to); } { /* Internal refs don't count as any distance, so the distance to * ref_to is the same as cur_dist in that case. */ unsigned ref_to_dist = ref_type & REF_TYPE_INTERNAL ? cur_dist : cur_dist + 1; if (ref_to_is_new || ref_to->dist > ref_to_dist) { unsigned type; ref_to->dist = ref_to_dist; #ifdef MEMORY_COUNT_DEBUG if (ref_to_dist == cur_dist) MC_DEBUG_MSG (ref_to, "lowered to dist + 0"); else MC_DEBUG_MSG (ref_to, "lowered to dist + 1"); #endif type = type_from_visit_fn (visit_fn); if (mc_block_lookahead & (1 << type)) MC_DEBUG_MSG (ref_to, "type is blocked - not enqueued"); else if (ref_to_dist < mc_lookahead) { if (ref_to_dist == cur_dist) mc_wl_enqueue_first (ref_to); else mc_wl_enqueue_last (ref_to); MC_DEBUG_MSG (ref_to, "enqueued"); } else MC_DEBUG_MSG (ref_to, "at max distance - not enqueued"); } } } static void pass_mark_external_visit_ref (void *thing, int ref_type, visit_thing_fn *visit_fn, void *extra) { struct mc_marker *ref_to = find_mc_marker (thing); assert (mc_pass == MC_PASS_MARK_EXTERNAL); if (ref_to) { if (!(ref_to->flags & MC_FLAG_INTERNAL)) { /* Only interested in existing lookahead things. */ if (!IS_EXTERNAL (ref_to)) { assert (ref_to->int_refs + ref_to->la_refs == *(INT32 *) thing); DL_REMOVE (ref_to); FLAG_EXTERNAL (ref_to); DL_ADD (mc_indirect, ref_to); mc_wl_enqueue_last (ref_to); MC_DEBUG_MSG (ref_to, "marked external"); } else MC_DEBUG_MSG (ref_to, "already external"); } else MC_DEBUG_MSG (ref_to, "ignored internal"); } } PMOD_EXPORT int mc_count_bytes (void *thing) { if (mc_pass == MC_PASS_LOOKAHEAD) { struct mc_marker *m = find_mc_marker (thing); if ((m->flags & (MC_FLAG_INTERNAL|MC_FLAG_MEMCOUNTED)) == MC_FLAG_INTERNAL) return 1; } return 0; } /*! @decl int count_memory (int(0..)|mapping(string:int) options, @
ad8d052008-05-02Martin Stjernholm  *! array|multiset|mapping|object|program|string|type|int... things) *! @appears Pike.count_memory *! *! This function returns the number of bytes that all @[things] *! occupy. Or to be more precise, it returns the number of bytes that *! would be freed if all those things would lose their references at *! the same time. I.e. it not only counts the memory in the things *! themselves, but also in all the things that are directly and
c095962008-05-11Martin Stjernholm  *! indirectly referenced from those things and not from anywhere *! else.
ad8d052008-05-02Martin Stjernholm  *! *! The memory counted is only that which is directly occupied by the *! things in question, including any overallocation for mappings, *! multisets and arrays. Other memory overhead that they give rise to *! is not counted. This means that if you would count the memory *! occupied by all the pike accessible things you would get a figure *! significantly lower than what the OS gives for the pike process. *! *! Also, if you were to actually free the things, you should not *! expect the size of the pike process to drop the amount of bytes *! returned by this function. That since Pike often retains the *! memory to be reused later. *! *! However, what you should expect is that if you actually free the *! things and then later allocates some more things for which this *! function returns the same size, there should be essentially no *! increase in the size of the pike process (some increase might *! occur due to internal fragmentation and memory pooling, but it
c095962008-05-11Martin Stjernholm  *! should be small in general and over time).
ad8d052008-05-02Martin Stjernholm  *!
c095962008-05-11Martin Stjernholm  *! The search for things only referenced from the arguments can *! handle limited cyclic structures. That is done by doing a *! "lookahead", i.e. searching through things that apparently have *! other outside references. You can control how long this lookahead *! should be through @[options] (see below). If the lookahead is too *! short to cover the cycles in a structure then a too low value is *! returned. If the lookahead is made gradually longer then the *! returned value will eventually become accurate and not increase *! anymore. If the lookahead is too long then unnecessary time might *! be spent searching through things that really have external *! references. *! *! @param options *! If this is an integer, it specifies the maximum lookahead *! distance. To e.g. cover cycles of length 2 (i.e. where two *! things point at each other), this has to be 3. *! *! However, the lookahead is by default blocked by programs, i.e. *! it never follows references emanating from programs. That since *! programs seldom are part of dynamic data structures, and they
c4d2032008-05-11Martin Stjernholm  *! also typically contain numerous references to global data which
c095962008-05-11Martin Stjernholm  *! would add a lot of work to the lookahead search. *! *! To control the search in more detail, @[options] can be a *! mapping instead: *! *! @mapping *! @member int lookahead *! The maximum lookahead distance. *! @member int block_arrays *! @member int block_mappings *! @member int block_multisets *! @member int block_objects *! @member int block_programs *! When any of these are given with a nonzero value, the *! corresponding type is blocked in when lookahead references *! are followed. They are unblocked if the flag is given with a *! zero value. *! @member int collect_stats *! If this is nonzero then the mapping is extended with more *! elements containing statistics from the search; see below. *! @endmapping *! *! When the @expr{collect_stats@} flag is set, the mapping is *! extended with these elements: *! *! @mapping *! @member int internal *! Number of things that were marked internal and hence memory *! counted. It includes the things given as arguments. *! @member int cyclic *! Number of things that were marked internal only after *! resolving cycles through the lookahead. *! @member int external *! Number of things that were visited through the lookahead but *! were found to be external. *! @member int visits *! Number of times things were visited in total. *! @member int rounds *! Number of search rounds. Whenever the lookahead discovers a *! cycle, another round has to be made to search for more *! internal things referenced from the cycle. *! @member int max_distance *! The maximum distance in the cyclic things that were *! eventually marked internal. This gives a measure on how much *! the lookahead can be lowered while still handling the same *! cycles. *! @member int size *! The memory occupied by the internal things. This is the same *! as the return value, but it's put here too for convenience. *! @endmapping
ad8d052008-05-02Martin Stjernholm  *! *! @param things *! One or more things to count memory size for. Only things passed *! by reference are allowed, except for functions which are *! forbidden because a meaningful size calculation can't be done *! for them. *! *! Integers are allowed because they are bignum objects when they *! become sufficiently large. However, passing an integer that is *! small enough to fit into the native integer type will return *! zero. *! *! @note
dcd9362008-05-03Henrik Grubbström (Grubba)  *! The result of @expr{Pike.count_memory(0,a,b)@} might be larger *! than the sum of @expr{Pike.count_memory(0,a)@} and
0abf6a2008-05-03Martin Nilsson  *! @expr{Pike.count_memory(0,b)@} since @expr{a@} and @expr{b@}
ad8d052008-05-02Martin Stjernholm  *! together might reference things that aren't referenced from *! anywhere else. *! *! @note *! It's possible that a string that is referenced still isn't *! counted, because strings are always shared in Pike and the same
c095962008-05-11Martin Stjernholm  *! string might be in use in some unrelated part of the program. *! *! @note *! Things (normally programs) that are blocked in the lookahead *! search are still recursed and memory counted properly if they are *! given as arguments or only got internal references.
ad8d052008-05-02Martin Stjernholm  */ void f_count_memory (INT32 args) {
c095962008-05-11Martin Stjernholm  struct mapping *opts = NULL; unsigned count_internal, count_cyclic, count_visited; unsigned count_visits, count_rounds, max_dist;
ad8d052008-05-02Martin Stjernholm  if (args < 1) SIMPLE_TOO_FEW_ARGS_ERROR ("count_memory", 1);
c095962008-05-11Martin Stjernholm  mc_block_lookahead = mc_block_lookahead_default; if (Pike_sp[-args].type == T_MAPPING) { struct mapping *m = Pike_sp[-args].u.mapping; struct pike_string *ind; struct svalue *val; MAKE_CONST_STRING (ind, "lookahead"); if ((val = low_mapping_string_lookup (m, ind))) { if (val->type != T_INT || val->u.integer < 0) SIMPLE_ARG_ERROR ("count_memory", 1, "\"lookahead\" is not a non-negative integer.");
d9c3e72008-05-11Martin Stjernholm #if MAX_INT_TYPE > MAX_UINT32 if (val->u.integer > MAX_UINT32) mc_lookahead = MAX_UINT32;
c095962008-05-11Martin Stjernholm  else #endif mc_lookahead = val->u.integer; } #define CHECK_BLOCK_FLAG(NAME, TYPE_BIT) do { \ MAKE_CONST_STRING (ind, NAME); \ if ((val = low_mapping_string_lookup (m, ind))) { \ if (UNSAFE_IS_ZERO (val)) \ mc_block_lookahead &= ~TYPE_BIT; \ else \ mc_block_lookahead |= TYPE_BIT; \ } \ } while (0) CHECK_BLOCK_FLAG ("block_arrays", BIT_ARRAY); CHECK_BLOCK_FLAG ("block_mappings", BIT_MAPPING); CHECK_BLOCK_FLAG ("block_multisets", BIT_MULTISET); CHECK_BLOCK_FLAG ("block_objects", BIT_OBJECT); CHECK_BLOCK_FLAG ("block_programs", BIT_PROGRAM); MAKE_CONST_STRING (ind, "collect_stats"); if ((val = low_mapping_string_lookup (m, ind)) && !UNSAFE_IS_ZERO (val)) opts = m; }
ad8d052008-05-02Martin Stjernholm 
c095962008-05-11Martin Stjernholm  else { if (Pike_sp[-args].type != T_INT || Pike_sp[-args].u.integer < 0) SIMPLE_ARG_TYPE_ERROR ("count_memory", 1, "int(0..)");
ad8d052008-05-02Martin Stjernholm 
d9c3e72008-05-11Martin Stjernholm #if MAX_INT_TYPE > MAX_UINT32 if (Pike_sp[-args].u.integer > MAX_UINT32) mc_lookahead = MAX_UINT32;
c095962008-05-11Martin Stjernholm  else
ad8d052008-05-02Martin Stjernholm #endif
c095962008-05-11Martin Stjernholm  mc_lookahead = Pike_sp[-args].u.integer; } init_mc_marker_hash();
ad8d052008-05-02Martin Stjernholm 
c095962008-05-11Martin Stjernholm  assert (!mc_pass); assert (visit_ref == NULL); assert (mc_work_list.wl_prev == &mc_work_list); assert (mc_work_list.wl_next == &mc_work_list);
ad8d052008-05-02Martin Stjernholm  { int i; for (i = -args + 1; i < 0; i++) { struct svalue *s = Pike_sp + i; if (s->type == T_INT) continue;
c095962008-05-11Martin Stjernholm  else if (s->type > MAX_REF_TYPE)
ad8d052008-05-02Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ( "count_memory", i + args + 1, "array|multiset|mapping|object|program|string|type|int"); else { if (s->type == T_FUNCTION) { struct svalue s2;
c095962008-05-11Martin Stjernholm  if (!(s2.u.program = program_from_function (s)))
ad8d052008-05-02Martin Stjernholm  SIMPLE_ARG_TYPE_ERROR ( "count_memory", i + args + 1, "array|multiset|mapping|object|program|string|type|int"); add_ref (s2.u.program); s2.type = T_PROGRAM; free_svalue (s); move_svalue (s, &s2); }
c095962008-05-11Martin Stjernholm  if (find_mc_marker (s->u.ptr)) { /* The user passed the same thing several times. Ignore it. */ } else if (s->type == T_ARRAY && (s->u.array == &empty_array || s->u.array == &weak_empty_array)) { /* Special cases for statically allocated things. */ } else { struct mc_marker *m = my_make_mc_marker (s->u.ptr, visit_fn_from_type[s->type], NULL); m->dist = 0; m->flags = MC_FLAG_INTERNAL; mc_wl_enqueue_last (m); MC_DEBUG_MSG (m, "enqueued starting point");
ad8d052008-05-02Martin Stjernholm  } } } }
c095962008-05-11Martin Stjernholm  assert (mc_incomplete.dl_prev == &mc_incomplete); assert (mc_incomplete.dl_next == &mc_incomplete); assert (mc_complete.dl_prev == &mc_complete); assert (mc_complete.dl_next == &mc_complete); #ifdef PIKE_DEBUG assert (mc_ref_from == (void *) (ptrdiff_t) -1); #endif mc_counted_bytes = 0; count_internal = count_cyclic = count_visited = 0; count_visits = count_rounds = max_dist = 0; do { count_rounds++; #ifdef MEMORY_COUNT_DEBUG fputs ("MC_PASS_LOOKAHEAD\n", stderr); #endif mc_pass = MC_PASS_LOOKAHEAD; visit_ref = pass_lookahead_visit_ref; while ((mc_ref_from = mc_wl_dequeue())) { int action; if ((mc_ref_from->flags & (MC_FLAG_INTERNAL|MC_FLAG_MEMCOUNTED)) == MC_FLAG_INTERNAL) { action = VISIT_COUNT_BYTES; /* Memory count this. */ count_internal++; MC_DEBUG_MSG (NULL, "enter with byte counting"); } else { action = VISIT_NORMAL; MC_DEBUG_MSG (NULL, "enter"); } count_visits++; mc_ref_from->visit_fn (mc_ref_from->thing, action, mc_ref_from->extra); if (!(mc_ref_from->flags & MC_FLAG_REFCOUNTED)) { mc_ref_from->flags |= MC_FLAG_REFCOUNTED; count_visited++; } if (mc_ref_from->flags & MC_FLAG_INTERNAL) mc_ref_from->flags |= MC_FLAG_MEMCOUNTED; MC_DEBUG_MSG (NULL, "leave"); } #if defined (PIKE_DEBUG) || defined (MEMORY_COUNT_DEBUG) mc_ref_from = (void *) (ptrdiff_t) -1; #endif #ifdef MEMORY_COUNT_DEBUG fputs ("MC_PASS_MARK_EXTERNAL\n", stderr); #endif mc_pass = MC_PASS_MARK_EXTERNAL; visit_ref = pass_mark_external_visit_ref; assert (mc_indirect.dl_next == &mc_indirect); assert (mc_indirect.dl_prev == &mc_indirect); { struct mc_marker *m; for (m = mc_incomplete.dl_next; m != &mc_incomplete; m = m->dl_next) { int type = type_from_visit_fn (m->visit_fn); FLAG_EXTERNAL (m); if (mc_block_lookahead & (1 << type)) MC_DEBUG_MSG (m, "type blocked - not enqueued"); else { mc_wl_enqueue_last (m); MC_DEBUG_MSG (m, "enqueued external"); } } while ((m = mc_wl_dequeue())) { MC_DEBUG_MSG (m, "visiting external"); count_visits++; m->visit_fn (m->thing, VISIT_NORMAL, m->extra); } } if (DL_IS_EMPTY (mc_complete)) break; { /* We've found some internal cyclic stuff. Put it in the work * list for the next round. */ struct mc_marker *m = mc_complete.dl_next; assert (m != &mc_complete); do { DL_REMOVE (m); if (m->dist > max_dist) max_dist = m->dist; m->dist = 0; m->flags |= MC_FLAG_INTERNAL; mc_wl_enqueue_last (m); count_cyclic++; MC_DEBUG_MSG (m, "enqueued cyclic internal"); m = mc_complete.dl_next; } while (m != &mc_complete); } DL_MOVE (mc_indirect, mc_complete); TOGGLE_EXT_FLAGS(); #ifdef PIKE_DEBUG if (d_flag) { struct mc_marker *m; for (m = mc_incomplete.dl_next; m != &mc_incomplete; m = m->dl_next) assert (!IS_EXTERNAL (m)); for (m = mc_complete.dl_next; m != &mc_complete; m = m->dl_next) assert (!IS_EXTERNAL (m)); } #endif } while (1); #ifdef MEMORY_COUNT_DEBUG fputs ("memory counting done\n", stderr); #endif
ad8d052008-05-02Martin Stjernholm 
20842b2008-05-02Martin Stjernholm #if 0
c095962008-05-11Martin Stjernholm  fprintf (stderr, "count_memory stats: %u internal, %u cyclic, %u external\n" "count_memory stats: %u visits, %u rounds, %u max distance\n", count_internal, count_cyclic, count_visited - count_internal, count_visits, count_rounds, max_dist);
ad8d052008-05-02Martin Stjernholm #ifdef PIKE_DEBUG { size_t num, size;
c095962008-05-11Martin Stjernholm  count_memory_in_mc_markers (&num, &size); fprintf (stderr, "count_memory used %"PRINTSIZET"u bytes " "for %"PRINTSIZET"u markers.\n", size, num);
ad8d052008-05-02Martin Stjernholm  }
20842b2008-05-02Martin Stjernholm #endif
ad8d052008-05-02Martin Stjernholm #endif
c095962008-05-11Martin Stjernholm  if (opts) { #define INSERT_STAT(NAME, VALUE) do { \ struct pike_string *ind; \ push_ulongest (VALUE); \ MAKE_CONST_STRING (ind, NAME); \ mapping_string_insert (opts, ind, Pike_sp - 1); \ pop_stack(); \ } while (0) INSERT_STAT ("internal", count_internal); INSERT_STAT ("cyclic", count_cyclic); INSERT_STAT ("external", count_visited - count_internal); INSERT_STAT ("visits", count_visits); INSERT_STAT ("rounds", count_rounds); INSERT_STAT ("max_distance", max_dist); INSERT_STAT ("size", mc_counted_bytes); }
ad8d052008-05-02Martin Stjernholm 
c095962008-05-11Martin Stjernholm  mc_pass = 0; visit_ref = NULL;
ad8d052008-05-02Martin Stjernholm 
c095962008-05-11Martin Stjernholm  DL_MAKE_EMPTY (mc_incomplete); DL_MAKE_EMPTY (mc_indirect); #ifdef DO_PIKE_CLEANUP { size_t e; for (e = 0; e < mc_marker_hash_table_size; e++) while (mc_marker_hash_table[e]) remove_mc_marker (mc_marker_hash_table[e]->thing);
5da0872000-08-22Henrik Grubbström (Grubba)  }
c095962008-05-11Martin Stjernholm #endif exit_mc_marker_hash(); pop_n_elems (args); push_ulongest (mc_counted_bytes);
5da0872000-08-22Henrik Grubbström (Grubba) }