Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/runtime/gc/check-heap.c
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/runtime/gc/check-heap.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 139 - (view) (download) (as text)

1 : monnier 2 /* check-heap.c
2 :     *
3 :     * COPYRIGHT (c) 1994 by AT&T Bell Laboratories.
4 :     */
5 :    
6 :     #include "ml-base.h"
7 :     #include "card-map.h"
8 :     #include "heap.h"
9 :     #include "c-globals-tbl.h"
10 :    
11 :     /* local routines */
12 :     PVT void CheckRecordArena (arena_t *ap);
13 :     PVT void CheckPairArena (arena_t *ap);
14 :     PVT void CheckStringArena (arena_t *ap);
15 :     PVT void CheckArrayArena (arena_t *ap, card_map_t *cm);
16 :     PVT int CheckPtr (ml_val_t *p, ml_val_t w, int srcGen, int srcKind);
17 :    
18 :     PVT int ErrCount = 0;
19 :    
20 :     #define ERROR { \
21 :     if (++ErrCount > 100) { \
22 :     Die("CheckHeap: too many errors\n"); \
23 :     } \
24 :     }
25 :    
26 :    
27 :     /* CheckHeap:
28 :     *
29 :     * Check the heap for consistency after a garbage collection (or blast out).
30 :     */
31 :     void CheckHeap (heap_t *heap, int maxSweptGen)
32 :     {
33 :     int i, j;
34 :    
35 :     ErrCount = 0;
36 :    
37 :     SayDebug ("Checking heap (%d generations) ...\n", maxSweptGen);
38 :     for (i = 0; i < maxSweptGen; i++) {
39 :     gen_t *g = heap->gen[i];
40 :    
41 :     CheckRecordArena (g->arena[RECORD_INDX]);
42 :     CheckPairArena (g->arena[PAIR_INDX]);
43 :     CheckStringArena (g->arena[STRING_INDX]);
44 :     CheckArrayArena (g->arena[ARRAY_INDX], g->dirty);
45 :     }
46 :     SayDebug ("... done\n");
47 :    
48 :     if (ErrCount > 0)
49 :     Die ("CheckHeap --- inconsistent heap\n");
50 :    
51 :     } /* end of CheckHeap */
52 :    
53 :     /* CheckRecordArena:
54 :     *
55 :     * Check the record arena.
56 :     */
57 :     PVT void CheckRecordArena (arena_t *ap)
58 :     {
59 :     ml_val_t *p, *stop, desc, w;
60 :     int i, len;
61 :     int gen = EXTRACT_GEN(ap->id);
62 :    
63 :     if (! isACTIVE(ap))
64 :     return;
65 :    
66 :     SayDebug (" records [%d]: [%#x..%#x:%#x)\n",
67 :     gen, ap->tospBase, ap->nextw, ap->tospTop);
68 :    
69 :     p = ap->tospBase;
70 :     stop = ap->nextw;
71 :     while (p < stop) {
72 :     desc = *p++;
73 :     if (! isDESC(desc)) {
74 :     ERROR;
75 :     SayDebug (
76 :     "** @%#x: expected descriptor, but found %#x in record arena\n",
77 :     p-1, desc);
78 :     return;
79 :     }
80 :     switch (GET_TAG(desc)) {
81 :     case DTAG_record:
82 :     len = GET_LEN(desc);
83 :     break;
84 :     default:
85 :     ERROR;
86 :     SayDebug ("** @%#x: strange tag (%#x) in record arena\n",
87 :     p-1, GET_TAG(desc));
88 :     return;
89 :     } /* end of switch */
90 :     for (i = 0; i < len; i++, p++) {
91 :     w = *p;
92 :     if (isDESC(w)) {
93 :     ERROR;
94 :     SayDebug (
95 :     "** @%#x: unexpected descriptor %#x in slot %d of %d\n",
96 :     p, w, i, GET_LEN(desc));
97 :     return;
98 :     }
99 :     else if (isBOXED(w)) {
100 :     CheckPtr(p, w, gen, OBJC_record);
101 :     }
102 :     }
103 :     }
104 :    
105 :     } /* end of CheckRecordArena */
106 :    
107 :     /* CheckPairArena:
108 :     */
109 :     PVT void CheckPairArena (arena_t *ap)
110 :     {
111 :     ml_val_t *p, *stop, w;
112 :     int gen = EXTRACT_GEN(ap->id);
113 :    
114 :     if (! isACTIVE(ap))
115 :     return;
116 :    
117 :     SayDebug (" pairs [%d]: [%#x..%#x:%#x)\n",
118 :     gen, ap->tospBase, ap->nextw, ap->tospTop);
119 :    
120 :     p = ap->tospBase + 2;
121 :     stop = ap->nextw;
122 :     while (p < stop) {
123 :     w = *p++;
124 :     if (isDESC(w)) {
125 :     ERROR;
126 :     SayDebug (
127 :     "** @%#x: unexpected descriptor %#x in pair arena\n",
128 :     p-1, w);
129 :     return;
130 :     }
131 :     else if (isBOXED(w)) {
132 :     CheckPtr(p, w, gen, OBJC_pair);
133 :     }
134 :     }
135 :    
136 :     } /* end of CheckPairArena */
137 :    
138 :     /* CheckStringArena:
139 :     *
140 :     * Check a string arena for consistency.
141 :     */
142 :     PVT void CheckStringArena (arena_t *ap)
143 :     {
144 :     ml_val_t *p, *stop, *prevDesc, desc;
145 :     int len;
146 :     int gen = EXTRACT_GEN(ap->id);
147 :    
148 :     if (! isACTIVE(ap))
149 :     return;
150 :    
151 :     SayDebug (" strings [%d]: [%#x..%#x:%#x)\n",
152 :     gen, ap->tospBase, ap->nextw, ap->tospTop);
153 :    
154 :     p = ap->tospBase;
155 :     stop = ap->nextw;
156 :     prevDesc = NIL(ml_val_t *);
157 :     while (p < stop) {
158 :     desc = *p++;
159 :     if (! isDESC(desc)) {
160 :     #ifdef ALIGN_REALDS
161 :     ml_val_t next = *p;
162 :     if ((! isDESC(next))
163 : monnier 139 || ((GET_TAG(next) != DTAG_reald)
164 :     && (GET_TAG(next) != DTAG_realdarray))) {
165 : monnier 2 #endif
166 :     ERROR;
167 :     SayDebug (
168 :     "** @%#x: expected descriptor, but found %#x in string arena\n",
169 :     p-1, desc);
170 :     if (prevDesc != NIL(ml_val_t *))
171 :     SayDebug (" previous string started @ %#x\n", prevDesc);
172 :     return;
173 :     #ifdef ALIGN_REALDS
174 :     }
175 :     else {
176 :     /* the bogus descriptor is alignment padding */
177 :     desc = next; p++;
178 :     }
179 :     #endif
180 :     }
181 :     switch (GET_TAG(desc)) {
182 :     case DTAG_string:
183 :     len = GET_STR_LEN(desc);
184 :     /* include the 0 termination bytes */
185 :     if ((GET_LEN(desc) & (WORD_SZB-1)) == 0) len++;
186 :     break;
187 :     case DTAG_bytearray:
188 :     len = GET_STR_LEN(desc);
189 :     break;
190 :     case DTAG_reald:
191 :     len = REALD_SZW;
192 :     break;
193 :     case DTAG_realdarray:
194 :     len = GET_REALDARR_LEN(desc);
195 :     break;
196 :     default:
197 :     ERROR;
198 :     SayDebug ("** @%#x: strange tag (%#x) in string arena\n",
199 :     p-1, GET_TAG(desc));
200 :     return;
201 :     } /* end of switch */
202 :     prevDesc = p-1;
203 :     p += len;
204 :     }
205 :    
206 :     } /* end of CheckStringArena */
207 :    
208 :     /* CheckArrayArena:
209 :     */
210 :     PVT void CheckArrayArena (arena_t *ap, card_map_t *cm)
211 :     {
212 :     ml_val_t *p, *stop, desc, w;
213 :     int i, j, len;
214 :     int gen = EXTRACT_GEN(ap->id);
215 :    
216 :     if (! isACTIVE(ap))
217 :     return;
218 :    
219 :     SayDebug (" arrays [%d]: [%#x..%#x:%#x)\n",
220 :     gen, ap->tospBase, ap->nextw, ap->tospTop);
221 :    
222 :     p = ap->tospBase;
223 :     stop = ap->nextw;
224 :     while (p < stop) {
225 :     desc = *p++;
226 :     if (! isDESC(desc)) {
227 :     ERROR;
228 :     SayDebug (
229 :     "** @%#x: expected descriptor, but found %#x in array arena\n",
230 :     p-1, desc);
231 :     return;
232 :     }
233 :     switch (GET_TAG(desc)) {
234 :     case DTAG_array:
235 :     len = GET_LEN(desc);
236 :     break;
237 :     case DTAG_special:
238 :     len = 1;
239 :     break;
240 :     default:
241 :     ERROR;
242 :     SayDebug ("** @%#x: strange tag (%#x) in array arena\n",
243 :     p-1, GET_TAG(desc));
244 :     return;
245 :     } /* end of switch */
246 :     for (i = 0; i < len; i++, p++) {
247 :     w = *p;
248 :     if (isDESC(w)) {
249 :     ERROR;
250 :     SayDebug (
251 :     "** @%#x: unexpected descriptor %#x in array slot %d of %d\n",
252 :     p, w, i, GET_LEN(desc));
253 :     for (p -= (i+1), j = 0; j <= len; j++, p++) {
254 :     SayDebug (" %#x: %#10x\n", p, *p);
255 :     }
256 :     return;
257 :     }
258 :     else if (isBOXED(w)) {
259 :     CheckPtr(p, w, gen, OBJC_array);
260 :     }
261 :     }
262 :     }
263 :    
264 :     } /* end of CheckArrayArena */
265 :    
266 :     /* CheckPtr:
267 :     */
268 :     PVT int CheckPtr (ml_val_t *p, ml_val_t w, int srcGen, int srcKind)
269 :     {
270 :     aid_t aid = ADDR_TO_PAGEID(BIBOP, w);
271 :     int dstGen = EXTRACT_GEN(aid);
272 :    
273 :     switch (EXTRACT_OBJC(aid)) {
274 :     case OBJC_record:
275 :     case OBJC_pair:
276 :     case OBJC_string:
277 :     case OBJC_array:
278 :     if (dstGen < srcGen) {
279 :     if (srcKind != OBJC_array) {
280 :     ERROR;
281 :     SayDebug (
282 :     "** @%#x: reference to younger object @%#x (gen = %d)\n",
283 :     p, w, dstGen);
284 :     }
285 :     }
286 :     break;
287 :     case OBJC_bigobj:
288 :     break;
289 :     case OBJC_new:
290 :     ERROR;
291 :     SayDebug ("** @%#x: unexpected new-space reference\n", p);
292 :     dstGen = MAX_NUM_GENS;
293 :     break;
294 :     default:
295 :     if (aid == AID_UNMAPPED) {
296 :     if (AddrToCSymbol(w) == NIL(const char *)) {
297 :     ERROR;
298 :     SayDebug (
299 :     "** @%#x: reference to unregistered external address %#x\n",
300 :     p, w);
301 :     }
302 :     dstGen = MAX_NUM_GENS;
303 :     }
304 :     else Die("bogus object class in BIBOP\n");
305 :     break;
306 :     } /* end of switch */
307 :    
308 :     return dstGen;
309 :    
310 :     } /* end of CheckPtr */
311 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0