annotate gc/backgraph.c @ 51488:5de98dce4bd1

*** empty log message ***
author Dave Love <fx@gnu.org>
date Thu, 05 Jun 2003 17:49:22 +0000
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
51488
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
1 /*
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
2 * Copyright (c) 2001 by Hewlett-Packard Company. All rights reserved.
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
3 *
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
4 * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
5 * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
6 *
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
7 * Permission is hereby granted to use or copy this program
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
8 * for any purpose, provided the above notices are retained on all copies.
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
9 * Permission to modify the code and to distribute modified code is granted,
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
10 * provided the above notices are retained, and a notice that the code was
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
11 * modified is included with the above copyright notice.
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
12 *
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
13 */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
14
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
15 /*
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
16 * This implements a full, though not well-tuned, representation of the
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
17 * backwards points-to graph. This is used to test for non-GC-robust
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
18 * data structures; the code is not used during normal garbage collection.
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
19 *
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
20 * One restriction is that we drop all back-edges from nodes with very
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
21 * high in-degree, and simply add them add them to a list of such
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
22 * nodes. They are then treated as permanent roots. Id this by itself
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
23 * doesn't introduce a space leak, then such nodes can't contribute to
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
24 * a growing space leak.
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
25 */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
26
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
27 #ifdef MAKE_BACK_GRAPH
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
28
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
29 #define MAX_IN 10 /* Maximum in-degree we handle directly */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
30
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
31 #include "private/dbg_mlc.h"
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
32 #include <unistd.h>
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
33
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
34 #if !defined(DBG_HDRS_ALL) || (ALIGNMENT != CPP_WORDSZ/8) || !defined(UNIX_LIKE)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
35 # error Configuration doesnt support MAKE_BACK_GRAPH
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
36 #endif
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
37
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
38 /* We store single back pointers directly in the object's oh_bg_ptr field. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
39 /* If there is more than one ptr to an object, we store q | FLAG_MANY, */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
40 /* where q is a pointer to a back_edges object. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
41 /* Every once in a while we use a back_edges object even for a single */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
42 /* pointer, since we need the other fields in the back_edges structure to */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
43 /* be present in some fraction of the objects. Otherwise we get serious */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
44 /* performance issues. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
45 #define FLAG_MANY 2
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
46
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
47 typedef struct back_edges_struct {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
48 word n_edges; /* Number of edges, including those in continuation */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
49 /* structures. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
50 unsigned short flags;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
51 # define RETAIN 1 /* Directly points to a reachable object; */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
52 /* retain for next GC. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
53 unsigned short height_gc_no;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
54 /* If height > 0, then the GC_gc_no value when it */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
55 /* was computed. If it was computed this cycle, then */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
56 /* it is current. If it was computed during the */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
57 /* last cycle, then it represents the old height, */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
58 /* which is only saved for live objects referenced by */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
59 /* dead ones. This may grow due to refs from newly */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
60 /* dead objects. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
61 signed_word height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
62 /* Longest path through unreachable nodes to this node */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
63 /* that we found using depth first search. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
64
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
65 # define HEIGHT_UNKNOWN ((signed_word)(-2))
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
66 # define HEIGHT_IN_PROGRESS ((signed_word)(-1))
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
67 ptr_t edges[MAX_IN];
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
68 struct back_edges_struct *cont;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
69 /* Pointer to continuation structure; we use only the */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
70 /* edges field in the continuation. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
71 /* also used as free list link. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
72 } back_edges;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
73
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
74 /* Allocate a new back edge structure. Should be more sophisticated */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
75 /* if this were production code. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
76 #define MAX_BACK_EDGE_STRUCTS 100000
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
77 static back_edges *back_edge_space = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
78 int GC_n_back_edge_structs = 0; /* Serves as pointer to never used */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
79 /* back_edges space. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
80 static back_edges *avail_back_edges = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
81 /* Pointer to free list of deallocated */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
82 /* back_edges structures. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
83
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
84 static back_edges * new_back_edges(void)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
85 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
86 if (0 == back_edge_space) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
87 back_edge_space = (back_edges *)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
88 sbrk(MAX_BACK_EDGE_STRUCTS*sizeof(back_edges));
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
89 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
90 if (0 != avail_back_edges) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
91 back_edges * result = avail_back_edges;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
92 avail_back_edges = result -> cont;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
93 result -> cont = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
94 return result;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
95 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
96 if (GC_n_back_edge_structs >= MAX_BACK_EDGE_STRUCTS - 1) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
97 ABORT("needed too much space for back edges: adjust "
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
98 "MAX_BACK_EDGE_STRUCTS");
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
99 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
100 return back_edge_space + (GC_n_back_edge_structs++);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
101 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
102
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
103 /* Deallocate p and its associated continuation structures. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
104 static void deallocate_back_edges(back_edges *p)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
105 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
106 back_edges *last = p;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
107
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
108 while (0 != last -> cont) last = last -> cont;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
109 last -> cont = avail_back_edges;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
110 avail_back_edges = p;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
111 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
112
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
113 /* Table of objects that are currently on the depth-first search */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
114 /* stack. Only objects with in-degree one are in this table. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
115 /* Other objects are identified using HEIGHT_IN_PROGRESS. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
116 /* This data structure NEEDS IMPROVEMENT. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
117 #define MAX_IN_PROGRESS 10000
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
118 static ptr_t * in_progress_space = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
119 static int n_in_progress = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
120
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
121 static void push_in_progress(ptr_t p)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
122 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
123 if (in_progress_space == 0)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
124 in_progress_space = sbrk(MAX_IN_PROGRESS * sizeof(ptr_t));
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
125 if (n_in_progress == MAX_IN_PROGRESS)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
126 ABORT("Exceeded MAX_IN_PROGRESS");
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
127 in_progress_space[n_in_progress++] = p;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
128 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
129
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
130 static GC_bool is_in_progress(ptr_t p)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
131 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
132 int i;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
133 for (i = 0; i < n_in_progress; ++i) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
134 if (in_progress_space[i] == p) return TRUE;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
135 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
136 return FALSE;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
137 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
138
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
139 static void pop_in_progress(ptr_t p)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
140 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
141 --n_in_progress;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
142 GC_ASSERT(in_progress_space[n_in_progress] == p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
143 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
144
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
145 #define GET_OH_BG_PTR(p) \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
146 (ptr_t)REVEAL_POINTER(((oh *)(p)) -> oh_bg_ptr)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
147 #define SET_OH_BG_PTR(p,q) (((oh *)(p)) -> oh_bg_ptr) = HIDE_POINTER(q)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
148
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
149 /* Execute s once for each predecessor q of p in the points-to graph. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
150 /* s should be a bracketed statement. We declare q. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
151 #define FOR_EACH_PRED(q, p, s) \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
152 { \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
153 ptr_t q = GET_OH_BG_PTR(p); \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
154 if (!((word)q & FLAG_MANY)) { \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
155 if (q && !((word)q & 1)) s \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
156 /* !((word)q & 1) checks for a misnterpreted freelist link */ \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
157 } else { \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
158 back_edges *orig_be_ = (back_edges *)((word)q & ~FLAG_MANY); \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
159 back_edges *be_ = orig_be_; \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
160 int total_, local_; \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
161 int n_edges_ = be_ -> n_edges; \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
162 for (total_ = 0, local_ = 0; total_ < n_edges_; ++local_, ++total_) { \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
163 if (local_ == MAX_IN) { \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
164 be_ = be_ -> cont; \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
165 local_ = 0; \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
166 } \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
167 q = be_ -> edges[local_]; s \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
168 } \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
169 } \
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
170 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
171
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
172 /* Ensure that p has a back_edges structure associated with it. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
173 static void ensure_struct(ptr_t p)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
174 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
175 ptr_t old_back_ptr = GET_OH_BG_PTR(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
176
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
177 if (!((word)old_back_ptr & FLAG_MANY)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
178 back_edges *be = new_back_edges();
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
179 be -> flags = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
180 if (0 == old_back_ptr) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
181 be -> n_edges = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
182 } else {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
183 be -> n_edges = 1;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
184 be -> edges[0] = old_back_ptr;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
185 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
186 be -> height = HEIGHT_UNKNOWN;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
187 be -> height_gc_no = GC_gc_no - 1;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
188 GC_ASSERT(be >= back_edge_space);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
189 SET_OH_BG_PTR(p, (word)be | FLAG_MANY);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
190 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
191 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
192
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
193 /* Add the (forward) edge from p to q to the backward graph. Both p */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
194 /* q are pointers to the object base, i.e. pointers to an oh. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
195 static void add_edge(ptr_t p, ptr_t q)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
196 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
197 ptr_t old_back_ptr = GET_OH_BG_PTR(q);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
198 back_edges * be, *be_cont;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
199 word i;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
200 static unsigned random_number = 13;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
201 # define GOT_LUCKY_NUMBER (((++random_number) & 0x7f) == 0)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
202 /* A not very random number we use to occasionally allocate a */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
203 /* back_edges structure even for a single backward edge. This */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
204 /* prevents us from repeatedly tracing back through very long */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
205 /* chains, since we will have some place to store height and */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
206 /* in_progress flags along the way. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
207
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
208 GC_ASSERT(p == GC_base(p) && q == GC_base(q));
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
209 if (!GC_HAS_DEBUG_INFO(q) || !GC_HAS_DEBUG_INFO(p)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
210 /* This is really a misinterpreted free list link, since we saw */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
211 /* a pointer to a free list. Dont overwrite it! */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
212 return;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
213 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
214 if (0 == old_back_ptr) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
215 SET_OH_BG_PTR(q, p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
216 if (GOT_LUCKY_NUMBER) ensure_struct(q);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
217 return;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
218 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
219 /* Check whether it was already in the list of predecessors. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
220 FOR_EACH_PRED(pred, q, { if (p == pred) return; });
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
221 ensure_struct(q);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
222 old_back_ptr = GET_OH_BG_PTR(q);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
223 be = (back_edges *)((word)old_back_ptr & ~FLAG_MANY);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
224 for (i = be -> n_edges, be_cont = be; i > MAX_IN;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
225 be_cont = be_cont -> cont, i -= MAX_IN) {}
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
226 if (i == MAX_IN) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
227 be_cont -> cont = new_back_edges();
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
228 be_cont = be_cont -> cont;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
229 i = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
230 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
231 be_cont -> edges[i] = p;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
232 be -> n_edges++;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
233 if (be -> n_edges == 100) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
234 # if 0
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
235 if (GC_print_stats) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
236 GC_err_printf0("The following object has in-degree >= 100:\n");
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
237 GC_print_heap_obj(q);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
238 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
239 # endif
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
240 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
241 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
242
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
243 typedef void (*per_object_func)(ptr_t p, word n_words, word gc_descr);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
244
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
245 static void per_object_helper(struct hblk *h, word fn)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
246 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
247 hdr * hhdr = HDR(h);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
248 word sz = hhdr -> hb_sz;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
249 word descr = hhdr -> hb_descr;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
250 per_object_func f = (per_object_func)fn;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
251 int i = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
252
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
253 do {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
254 f((ptr_t)(h -> hb_body + i), sz, descr);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
255 i += sz;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
256 } while (i + sz <= BYTES_TO_WORDS(HBLKSIZE));
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
257 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
258
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
259 void GC_apply_to_each_object(per_object_func f)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
260 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
261 GC_apply_to_all_blocks(per_object_helper, (word)f);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
262 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
263
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
264 static void reset_back_edge(ptr_t p, word n_words, word gc_descr)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
265 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
266 /* Skip any free list links, or dropped blocks */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
267 if (GC_HAS_DEBUG_INFO(p)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
268 ptr_t old_back_ptr = GET_OH_BG_PTR(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
269 if ((word)old_back_ptr & FLAG_MANY) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
270 back_edges *be = (back_edges *)((word)old_back_ptr & ~FLAG_MANY);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
271 if (!(be -> flags & RETAIN)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
272 deallocate_back_edges(be);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
273 SET_OH_BG_PTR(p, 0);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
274 } else {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
275 word *currentp;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
276
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
277 GC_ASSERT(GC_is_marked(p));
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
278
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
279 /* Back edges may point to objects that will not be retained. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
280 /* Delete them for now, but remember the height. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
281 /* Some will be added back at next GC. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
282 be -> n_edges = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
283 if (0 != be -> cont) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
284 deallocate_back_edges(be -> cont);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
285 be -> cont = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
286 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
287
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
288 GC_ASSERT(GC_is_marked(p));
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
289
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
290 /* We only retain things for one GC cycle at a time. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
291 be -> flags &= ~RETAIN;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
292 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
293 } else /* Simple back pointer */ {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
294 /* Clear to avoid dangling pointer. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
295 SET_OH_BG_PTR(p, 0);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
296 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
297 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
298 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
299
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
300 static void add_back_edges(ptr_t p, word n_words, word gc_descr)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
301 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
302 word *currentp = (word *)(p + sizeof(oh));
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
303
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
304 /* For now, fix up non-length descriptors conservatively. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
305 if((gc_descr & GC_DS_TAGS) != GC_DS_LENGTH) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
306 gc_descr = WORDS_TO_BYTES(n_words);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
307 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
308 while (currentp < (word *)(p + gc_descr)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
309 word current = *currentp++;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
310 FIXUP_POINTER(current);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
311 if (current >= (word)GC_least_plausible_heap_addr &&
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
312 current <= (word)GC_greatest_plausible_heap_addr) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
313 ptr_t target = GC_base((GC_PTR)current);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
314 if (0 != target) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
315 add_edge(p, target);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
316 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
317 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
318 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
319 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
320
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
321 /* Rebuild the reprentation of the backward reachability graph. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
322 /* Does not examine mark bits. Can be called before GC. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
323 void GC_build_back_graph(void)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
324 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
325 GC_apply_to_each_object(add_back_edges);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
326 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
327
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
328 /* Return an approximation to the length of the longest simple path */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
329 /* through unreachable objects to p. We refer to this as the height */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
330 /* of p. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
331 static word backwards_height(ptr_t p)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
332 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
333 word result;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
334 ptr_t back_ptr = GET_OH_BG_PTR(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
335 back_edges *be;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
336
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
337 if (0 == back_ptr) return 1;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
338 if (!((word)back_ptr & FLAG_MANY)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
339 if (is_in_progress(p)) return 0; /* DFS back edge, i.e. we followed */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
340 /* an edge to an object already */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
341 /* on our stack: ignore */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
342 push_in_progress(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
343 result = backwards_height(back_ptr)+1;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
344 pop_in_progress(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
345 return result;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
346 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
347 be = (back_edges *)((word)back_ptr & ~FLAG_MANY);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
348 if (be -> height >= 0 && be -> height_gc_no == GC_gc_no)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
349 return be -> height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
350 /* Ignore back edges in DFS */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
351 if (be -> height == HEIGHT_IN_PROGRESS) return 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
352 result = (be -> height > 0? be -> height : 1);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
353 be -> height = HEIGHT_IN_PROGRESS;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
354 FOR_EACH_PRED(q, p, {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
355 word this_height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
356 if (GC_is_marked(q) && !(FLAG_MANY & (word)GET_OH_BG_PTR(p))) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
357 if (GC_print_stats)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
358 GC_printf2("Found bogus pointer from 0x%lx to 0x%lx\n", q, p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
359 /* Reachable object "points to" unreachable one. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
360 /* Could be caused by our lax treatment of GC descriptors. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
361 this_height = 1;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
362 } else {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
363 this_height = backwards_height(q);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
364 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
365 if (this_height >= result) result = this_height + 1;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
366 });
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
367 be -> height = result;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
368 be -> height_gc_no = GC_gc_no;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
369 return result;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
370 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
371
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
372 word GC_max_height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
373 ptr_t GC_deepest_obj;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
374
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
375 /* Compute the maximum height of every unreachable predecessor p of a */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
376 /* reachable object. Arrange to save the heights of all such objects p */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
377 /* so that they can be used in calculating the height of objects in the */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
378 /* next GC. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
379 /* Set GC_max_height to be the maximum height we encounter, and */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
380 /* GC_deepest_obj to be the corresponding object. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
381 static void update_max_height(ptr_t p, word n_words, word gc_descr)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
382 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
383 if (GC_is_marked(p) && GC_HAS_DEBUG_INFO(p)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
384 int i;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
385 word p_height = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
386 ptr_t p_deepest_obj = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
387 ptr_t back_ptr;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
388 back_edges *be = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
389
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
390 /* If we remembered a height last time, use it as a minimum. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
391 /* It may have increased due to newly unreachable chains pointing */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
392 /* to p, but it can't have decreased. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
393 back_ptr = GET_OH_BG_PTR(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
394 if (0 != back_ptr && ((word)back_ptr & FLAG_MANY)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
395 be = (back_edges *)((word)back_ptr & ~FLAG_MANY);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
396 if (be -> height != HEIGHT_UNKNOWN) p_height = be -> height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
397 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
398 FOR_EACH_PRED(q, p, {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
399 if (!GC_is_marked(q) && GC_HAS_DEBUG_INFO(q)) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
400 word q_height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
401
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
402 q_height = backwards_height(q);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
403 if (q_height > p_height) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
404 p_height = q_height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
405 p_deepest_obj = q;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
406 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
407 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
408 });
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
409 if (p_height > 0) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
410 /* Remember the height for next time. */
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
411 if (be == 0) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
412 ensure_struct(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
413 back_ptr = GET_OH_BG_PTR(p);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
414 be = (back_edges *)((word)back_ptr & ~FLAG_MANY);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
415 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
416 be -> flags |= RETAIN;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
417 be -> height = p_height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
418 be -> height_gc_no = GC_gc_no;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
419 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
420 if (p_height > GC_max_height) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
421 GC_max_height = p_height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
422 GC_deepest_obj = p_deepest_obj;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
423 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
424 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
425 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
426
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
427 void GC_traverse_back_graph(void)
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
428 {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
429 static word max_max_height = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
430 GC_max_height = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
431 GC_apply_to_each_object(update_max_height);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
432 GC_printf2("Maximum backwards height of reachable objects at GC %lu is %ld\n",
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
433 (unsigned long) GC_gc_no, GC_max_height);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
434 if (GC_max_height > max_max_height) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
435 max_max_height = GC_max_height;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
436 GC_printf0("The following unreachable object is last in a longest chain "
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
437 "of unreachable objects:\n");
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
438 GC_print_heap_obj(GC_deepest_obj);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
439 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
440 if (GC_print_stats) {
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
441 GC_printf1("Needed max total of %ld back-edge structs\n",
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
442 GC_n_back_edge_structs);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
443 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
444 GC_apply_to_each_object(reset_back_edge);
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
445 GC_deepest_obj = 0;
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
446 }
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
447
5de98dce4bd1 *** empty log message ***
Dave Love <fx@gnu.org>
parents:
diff changeset
448 #endif /* MAKE_BACK_GRAPH */