Merge pull request #268 from pcc/menudeactivate
[mono.git] / libgc / finalize.c
1 /*
2  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
3  * Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
4  * Copyright (c) 1996-1999 by Silicon Graphics.  All rights reserved.
5
6  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
7  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
8  *
9  * Permission is hereby granted to use or copy this program
10  * for any purpose,  provided the above notices are retained on all copies.
11  * Permission to modify the code and to distribute modified code is granted,
12  * provided the above notices are retained, and a notice that the code was
13  * modified is included with the above copyright notice.
14  */
15 /* Boehm, February 1, 1996 1:19 pm PST */
16 # define I_HIDE_POINTERS
17 # include "private/gc_pmark.h"
18
19 # ifdef FINALIZE_ON_DEMAND
20     int GC_finalize_on_demand = 1;
21 # else
22     int GC_finalize_on_demand = 0;
23 # endif
24
25 # ifdef JAVA_FINALIZATION
26     int GC_java_finalization = 1;
27 # else
28     int GC_java_finalization = 0;
29 # endif
30
31 /* Type of mark procedure used for marking from finalizable object.     */
32 /* This procedure normally does not mark the object, only its           */
33 /* descendents.                                                         */
34 typedef void finalization_mark_proc(/* ptr_t finalizable_obj_ptr */); 
35
36 # define HASH3(addr,size,log_size) \
37     ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+(log_size)))) \
38     & ((size) - 1))
39 #define HASH2(addr,log_size) HASH3(addr, 1 << log_size, log_size)
40
41 struct hash_chain_entry {
42     word hidden_key;
43     struct hash_chain_entry * next;
44 };
45
46 unsigned GC_finalization_failures = 0;
47         /* Number of finalization requests that failed for lack of memory. */
48
49 struct disappearing_link {
50     struct hash_chain_entry prolog;
51 #   define dl_hidden_link prolog.hidden_key
52                                 /* Field to be cleared.         */
53 #   define dl_next(x) (struct disappearing_link *)((x) -> prolog.next)
54 #   define dl_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
55
56     word dl_hidden_obj;         /* Pointer to object base       */
57 };
58
59 struct dl_hashtbl_s {
60     struct disappearing_link **head;
61     signed_word log_size;
62     word entries;
63 };
64
65 /* Forward decls. */
66 static int GC_register_disappearing_link_inner(struct dl_hashtbl_s *dl_hashtbl, GC_PTR * link, GC_PTR obj);
67 static int GC_unregister_disappearing_link_inner(struct dl_hashtbl_s *dl_hashtbl, GC_PTR * link);
68
69 static struct dl_hashtbl_s GC_dl_hashtbl = {
70     /* head */ NULL, /* log_size */ -1, /* entries */ 0 };
71
72 static struct dl_hashtbl_s GC_ll_hashtbl = { NULL, -1, 0 };
73
74
75 static struct finalizable_object {
76     struct hash_chain_entry prolog;
77 #   define fo_hidden_base prolog.hidden_key
78                                 /* Pointer to object base.      */
79                                 /* No longer hidden once object */
80                                 /* is on finalize_now queue.    */
81 #   define fo_next(x) (struct finalizable_object *)((x) -> prolog.next)
82 #   define fo_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
83     GC_finalization_proc fo_fn; /* Finalizer.                   */
84     ptr_t fo_client_data;
85     word fo_object_size;        /* In bytes.                    */
86     finalization_mark_proc * fo_mark_proc;      /* Mark-through procedure */
87 } **fo_head = 0;
88
89 struct finalizable_object * GC_finalize_now = 0;
90         /* LIst of objects that should be finalized now.        */
91
92 static signed_word log_fo_table_size = -1;
93
94 word GC_fo_entries = 0;
95
96 void GC_push_finalizer_structures GC_PROTO((void))
97 {
98     GC_push_all((ptr_t)(&GC_ll_hashtbl.head),
99                 (ptr_t)(&GC_ll_hashtbl.head) + sizeof(word));
100     GC_push_all((ptr_t)(&GC_dl_hashtbl.head),
101                 (ptr_t)(&GC_dl_hashtbl.head) + sizeof(word));
102     GC_push_all((ptr_t)(&fo_head), (ptr_t)(&fo_head) + sizeof(word));
103     GC_push_all((ptr_t)(&GC_finalize_now),
104                 (ptr_t)(&GC_finalize_now) + sizeof(word));
105 }
106
107 /* Double the size of a hash table. *size_ptr is the log of its current */
108 /* size.  May be a noop.                                                */
109 /* *table is a pointer to an array of hash headers.  If we succeed, we  */
110 /* update both *table and *log_size_ptr.                                */
111 /* Lock is held.  Signals are disabled.                                 */
112 void GC_grow_table(table, log_size_ptr)
113 struct hash_chain_entry ***table;
114 signed_word * log_size_ptr;
115 {
116     register word i;
117     register struct hash_chain_entry *p;
118     int log_old_size = *log_size_ptr;
119     register int log_new_size = log_old_size + 1;
120     word old_size = ((log_old_size == -1)? 0: (1 << log_old_size));
121     register word new_size = 1 << log_new_size;
122     struct hash_chain_entry **new_table = (struct hash_chain_entry **)
123         GC_INTERNAL_MALLOC_IGNORE_OFF_PAGE(
124                 (size_t)new_size * sizeof(struct hash_chain_entry *), NORMAL);
125     
126     if (new_table == 0) {
127         if (table == 0) {
128             ABORT("Insufficient space for initial table allocation");
129         } else {
130             return;
131         }
132     }
133     for (i = 0; i < old_size; i++) {
134       p = (*table)[i];
135       while (p != 0) {
136         register ptr_t real_key = (ptr_t)REVEAL_POINTER(p -> hidden_key);
137         register struct hash_chain_entry *next = p -> next;
138         register int new_hash = HASH3(real_key, new_size, log_new_size);
139         
140         p -> next = new_table[new_hash];
141         new_table[new_hash] = p;
142         p = next;
143       }
144     }
145     *log_size_ptr = log_new_size;
146     *table = new_table;
147 }
148
149 # if defined(__STDC__) || defined(__cplusplus)
150     int GC_register_disappearing_link(GC_PTR * link)
151 # else
152     int GC_register_disappearing_link(link)
153     GC_PTR * link;
154 # endif
155 {
156     ptr_t base;
157     
158     base = (ptr_t)GC_base((GC_PTR)link);
159     if (base == 0)
160         ABORT("Bad arg to GC_register_disappearing_link");
161     return(GC_general_register_disappearing_link(link, base));
162 }
163
164 # if defined(__STDC__) || defined(__cplusplus)
165     int GC_general_register_disappearing_link(GC_PTR * link,
166                                               GC_PTR obj)
167 # else
168     int GC_general_register_disappearing_link(link, obj)
169     GC_PTR * link;
170     GC_PTR obj;
171 # endif
172 {
173     return GC_register_disappearing_link_inner(&GC_dl_hashtbl, link, obj);      
174 }
175
176 # if defined(__STDC__) || defined(__cplusplus)
177     static int GC_register_disappearing_link_inner(struct dl_hashtbl_s *dl_hashtbl, GC_PTR * link,
178                                               GC_PTR obj)
179 # else
180     static int GC_register_disappearing_link_inner(dl_hashtbl, link, obj)
181         struct dl_hashtbl_s *dl_hashtbl
182     GC_PTR * link;
183     GC_PTR obj;
184 # endif
185 {
186     struct disappearing_link *curr_dl;
187     int index;
188     struct disappearing_link * new_dl;
189     DCL_LOCK_STATE;
190     
191     if ((word)link & (ALIGNMENT-1))
192         ABORT("Bad arg to GC_general_register_disappearing_link");
193 #   ifdef THREADS
194         DISABLE_SIGNALS();
195         LOCK();
196 #   endif
197     if (dl_hashtbl -> log_size == -1
198         || dl_hashtbl -> entries > ((word)1 << dl_hashtbl -> log_size)) {
199 #       ifndef THREADS
200             DISABLE_SIGNALS();
201 #       endif
202         GC_grow_table((struct hash_chain_entry ***)(&dl_hashtbl -> head),
203                       &dl_hashtbl -> log_size);
204 #       ifdef CONDPRINT
205           if (GC_print_stats) {
206             GC_printf1("Grew dl table to %lu entries\n",
207                         (unsigned long)(1 << dl_hashtbl -> log_size));
208           }
209 #       endif
210 #       ifndef THREADS
211             ENABLE_SIGNALS();
212 #       endif
213     }
214     index = HASH2(link, dl_hashtbl -> log_size);
215     curr_dl = dl_hashtbl -> head[index];
216     for (curr_dl = dl_hashtbl -> head[index]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
217         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
218             curr_dl -> dl_hidden_obj = HIDE_POINTER(obj);
219 #           ifdef THREADS
220                 UNLOCK();
221                 ENABLE_SIGNALS();
222 #           endif
223             return(1);
224         }
225     }
226     new_dl = (struct disappearing_link *)
227         GC_INTERNAL_MALLOC(sizeof(struct disappearing_link),NORMAL);
228     if (0 == new_dl) {
229 #     ifdef THREADS
230         UNLOCK();
231         ENABLE_SIGNALS();
232 #     endif
233       new_dl = (struct disappearing_link *)
234               GC_oom_fn(sizeof(struct disappearing_link));
235       if (0 == new_dl) {
236         GC_finalization_failures++;
237         return(0);
238       }
239       /* It's not likely we'll make it here, but ... */
240 #     ifdef THREADS
241         DISABLE_SIGNALS();
242         LOCK();
243 #     endif
244     }
245     new_dl -> dl_hidden_obj = HIDE_POINTER(obj);
246     new_dl -> dl_hidden_link = HIDE_POINTER(link);
247     dl_set_next(new_dl, dl_hashtbl -> head[index]);
248     dl_hashtbl -> head[index] = new_dl;
249     dl_hashtbl -> entries++;
250 #   ifdef THREADS
251         UNLOCK();
252         ENABLE_SIGNALS();
253 #   endif
254     return(0);
255 }
256
257 # if defined(__STDC__) || defined(__cplusplus)
258     int GC_unregister_disappearing_link(GC_PTR * link)
259 # else
260     int GC_unregister_disappearing_link(link)
261     GC_PTR * link;
262 # endif
263 {
264         return GC_unregister_disappearing_link_inner(&GC_dl_hashtbl, link);
265 }
266
267 # if defined(__STDC__) || defined(__cplusplus)
268     static int GC_unregister_disappearing_link_inner(struct dl_hashtbl_s *dl_hashtbl, GC_PTR * link)
269 # else
270     static int GC_unregister_disappearing_link_inner(dl_hashtbl, link)
271         struct dl_hashtbl_s *dl_hashtbl;
272     GC_PTR * link;
273 # endif
274 {
275     struct disappearing_link *curr_dl, *prev_dl;
276     int index;
277     DCL_LOCK_STATE;
278     
279     DISABLE_SIGNALS();
280     LOCK();
281     index = HASH2(link, dl_hashtbl->log_size);
282     if (((unsigned long)link & (ALIGNMENT-1))) goto out;
283     prev_dl = 0; curr_dl = dl_hashtbl -> head[index];
284     while (curr_dl != 0) {
285         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
286             if (prev_dl == 0) {
287                 dl_hashtbl -> head[index] = dl_next(curr_dl);
288             } else {
289                 dl_set_next(prev_dl, dl_next(curr_dl));
290             }
291             dl_hashtbl -> entries--;
292             UNLOCK();
293             ENABLE_SIGNALS();
294 #           ifdef DBG_HDRS_ALL
295               dl_set_next(curr_dl, 0);
296 #           else
297               GC_free((GC_PTR)curr_dl);
298 #           endif
299             return(1);
300         }
301         prev_dl = curr_dl;
302         curr_dl = dl_next(curr_dl);
303     }
304 out:
305     UNLOCK();
306     ENABLE_SIGNALS();
307     return(0);
308 }
309
310
311 # if defined(__STDC__) || defined(__cplusplus)
312     int GC_register_long_link(GC_PTR * link, GC_PTR obj)
313 # else
314     int GC_register_long_link(link, obj)
315     GC_PTR * link;
316         GC_PTR obj;
317 # endif
318 {
319     return GC_register_disappearing_link_inner(&GC_ll_hashtbl, link, obj);      
320 }
321
322 # if defined(__STDC__) || defined(__cplusplus)
323     int GC_unregister_long_link(GC_PTR * link)
324 # else
325     int GC_unregister_long_link(link)
326     GC_PTR * link;
327 # endif
328 {
329         return GC_unregister_disappearing_link_inner(&GC_ll_hashtbl, link);
330 }
331
332 /* Possible finalization_marker procedures.  Note that mark stack       */
333 /* overflow is handled by the caller, and is not a disaster.            */
334 GC_API void GC_normal_finalize_mark_proc(p)
335 ptr_t p;
336 {
337     hdr * hhdr = HDR(p);
338     
339     PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top,
340              &(GC_mark_stack[GC_mark_stack_size]));
341 }
342
343 /* This only pays very partial attention to the mark descriptor.        */
344 /* It does the right thing for normal and atomic objects, and treats    */
345 /* most others as normal.                                               */
346 GC_API void GC_ignore_self_finalize_mark_proc(p)
347 ptr_t p;
348 {
349     hdr * hhdr = HDR(p);
350     word descr = hhdr -> hb_descr;
351     ptr_t q, r;
352     ptr_t scan_limit;
353     ptr_t target_limit = p + WORDS_TO_BYTES(hhdr -> hb_sz) - 1;
354     
355     if ((descr & GC_DS_TAGS) == GC_DS_LENGTH) {
356        scan_limit = p + descr - sizeof(word);
357     } else {
358        scan_limit = target_limit + 1 - sizeof(word);
359     }
360     for (q = p; q <= scan_limit; q += ALIGNMENT) {
361         r = *(ptr_t *)q;
362         if (r < p || r > target_limit) {
363             GC_PUSH_ONE_HEAP((word)r, q);
364         }
365     }
366 }
367
368 /*ARGSUSED*/
369 GC_API void GC_null_finalize_mark_proc(p)
370 ptr_t p;
371 {
372 }
373
374
375
376 /* Register a finalization function.  See gc.h for details.     */
377 /* in the nonthreads case, we try to avoid disabling signals,   */
378 /* since it can be expensive.  Threads packages typically       */
379 /* make it cheaper.                                             */
380 /* The last parameter is a procedure that determines            */
381 /* marking for finalization ordering.  Any objects marked       */
382 /* by that procedure will be guaranteed to not have been        */
383 /* finalized when this finalizer is invoked.                    */
384 GC_API void GC_register_finalizer_inner(obj, fn, cd, ofn, ocd, mp)
385 GC_PTR obj;
386 GC_finalization_proc fn;
387 GC_PTR cd;
388 GC_finalization_proc * ofn;
389 GC_PTR * ocd;
390 finalization_mark_proc * mp;
391 {
392     ptr_t base;
393     struct finalizable_object * curr_fo, * prev_fo;
394     int index;
395     struct finalizable_object *new_fo;
396     hdr *hhdr;
397     DCL_LOCK_STATE;
398
399 #   ifdef THREADS
400         DISABLE_SIGNALS();
401         LOCK();
402 #   endif
403     if (log_fo_table_size == -1
404         || GC_fo_entries > ((word)1 << log_fo_table_size)) {
405 #       ifndef THREADS
406             DISABLE_SIGNALS();
407 #       endif
408         GC_grow_table((struct hash_chain_entry ***)(&fo_head),
409                       &log_fo_table_size);
410 #       ifdef CONDPRINT
411           if (GC_print_stats) {
412             GC_printf1("Grew fo table to %lu entries\n",
413                         (unsigned long)(1 << log_fo_table_size));
414           }
415 #       endif
416 #       ifndef THREADS
417             ENABLE_SIGNALS();
418 #       endif
419     }
420     /* in the THREADS case signals are disabled and we hold allocation  */
421     /* lock; otherwise neither is true.  Proceed carefully.             */
422     base = (ptr_t)obj;
423     index = HASH2(base, log_fo_table_size);
424     prev_fo = 0; curr_fo = fo_head[index];
425     while (curr_fo != 0) {
426         if (curr_fo -> fo_hidden_base == HIDE_POINTER(base)) {
427             /* Interruption by a signal in the middle of this   */
428             /* should be safe.  The client may see only *ocd    */
429             /* updated, but we'll declare that to be his        */
430             /* problem.                                         */
431             if (ocd) *ocd = (GC_PTR) curr_fo -> fo_client_data;
432             if (ofn) *ofn = curr_fo -> fo_fn;
433             /* Delete the structure for base. */
434                 if (prev_fo == 0) {
435                   fo_head[index] = fo_next(curr_fo);
436                 } else {
437                   fo_set_next(prev_fo, fo_next(curr_fo));
438                 }
439             if (fn == 0) {
440                 GC_fo_entries--;
441                   /* May not happen if we get a signal.  But a high     */
442                   /* estimate will only make the table larger than      */
443                   /* necessary.                                         */
444 #               if !defined(THREADS) && !defined(DBG_HDRS_ALL)
445                   GC_free((GC_PTR)curr_fo);
446 #               endif
447             } else {
448                 curr_fo -> fo_fn = fn;
449                 curr_fo -> fo_client_data = (ptr_t)cd;
450                 curr_fo -> fo_mark_proc = mp;
451                 /* Reinsert it.  We deleted it first to maintain        */
452                 /* consistency in the event of a signal.                */
453                 if (prev_fo == 0) {
454                   fo_head[index] = curr_fo;
455                 } else {
456                   fo_set_next(prev_fo, curr_fo);
457                 }
458             }
459 #           ifdef THREADS
460                 UNLOCK();
461                 ENABLE_SIGNALS();
462 #           endif
463             return;
464         }
465         prev_fo = curr_fo;
466         curr_fo = fo_next(curr_fo);
467     }
468     if (ofn) *ofn = 0;
469     if (ocd) *ocd = 0;
470     if (fn == 0) {
471 #       ifdef THREADS
472             UNLOCK();
473             ENABLE_SIGNALS();
474 #       endif
475         return;
476     }
477     GET_HDR(base, hhdr);
478     if (0 == hhdr) {
479       /* We won't collect it, hence finalizer wouldn't be run. */
480 #     ifdef THREADS
481           UNLOCK();
482           ENABLE_SIGNALS();
483 #     endif
484       return;
485     }
486     new_fo = (struct finalizable_object *)
487         GC_INTERNAL_MALLOC(sizeof(struct finalizable_object),NORMAL);
488     if (0 == new_fo) {
489 #     ifdef THREADS
490         UNLOCK();
491         ENABLE_SIGNALS();
492 #     endif
493       new_fo = (struct finalizable_object *)
494               GC_oom_fn(sizeof(struct finalizable_object));
495       if (0 == new_fo) {
496         GC_finalization_failures++;
497         return;
498       }
499       /* It's not likely we'll make it here, but ... */
500 #     ifdef THREADS
501         DISABLE_SIGNALS();
502         LOCK();
503 #     endif
504     }
505     new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
506     new_fo -> fo_fn = fn;
507     new_fo -> fo_client_data = (ptr_t)cd;
508     new_fo -> fo_object_size = hhdr -> hb_sz;
509     new_fo -> fo_mark_proc = mp;
510     fo_set_next(new_fo, fo_head[index]);
511     GC_fo_entries++;
512     fo_head[index] = new_fo;
513 #   ifdef THREADS
514         UNLOCK();
515         ENABLE_SIGNALS();
516 #   endif
517 }
518
519 # if defined(__STDC__)
520     void GC_register_finalizer(void * obj,
521                                GC_finalization_proc fn, void * cd,
522                                GC_finalization_proc *ofn, void ** ocd)
523 # else
524     void GC_register_finalizer(obj, fn, cd, ofn, ocd)
525     GC_PTR obj;
526     GC_finalization_proc fn;
527     GC_PTR cd;
528     GC_finalization_proc * ofn;
529     GC_PTR * ocd;
530 # endif
531 {
532     GC_register_finalizer_inner(obj, fn, cd, ofn,
533                                 ocd, GC_normal_finalize_mark_proc);
534 }
535
536 # if defined(__STDC__)
537     void GC_register_finalizer_ignore_self(void * obj,
538                                GC_finalization_proc fn, void * cd,
539                                GC_finalization_proc *ofn, void ** ocd)
540 # else
541     void GC_register_finalizer_ignore_self(obj, fn, cd, ofn, ocd)
542     GC_PTR obj;
543     GC_finalization_proc fn;
544     GC_PTR cd;
545     GC_finalization_proc * ofn;
546     GC_PTR * ocd;
547 # endif
548 {
549     GC_register_finalizer_inner(obj, fn, cd, ofn,
550                                 ocd, GC_ignore_self_finalize_mark_proc);
551 }
552
553 # if defined(__STDC__)
554     void GC_register_finalizer_no_order(void * obj,
555                                GC_finalization_proc fn, void * cd,
556                                GC_finalization_proc *ofn, void ** ocd)
557 # else
558     void GC_register_finalizer_no_order(obj, fn, cd, ofn, ocd)
559     GC_PTR obj;
560     GC_finalization_proc fn;
561     GC_PTR cd;
562     GC_finalization_proc * ofn;
563     GC_PTR * ocd;
564 # endif
565 {
566     GC_register_finalizer_inner(obj, fn, cd, ofn,
567                                 ocd, GC_null_finalize_mark_proc);
568 }
569
570 #ifndef NO_DEBUGGING
571
572 static void GC_dump_finalization_links(struct dl_hashtbl_s *dl_hashtbl)
573 {
574   struct disappearing_link *curr_dl;
575   ptr_t real_ptr, real_link;
576   size_t dl_size = dl_hashtbl->log_size == -1 ? 0 :
577                               1 << dl_hashtbl->log_size;
578   int i;
579
580   for (i = 0; i < dl_size; i++) {
581     for (curr_dl = dl_hashtbl -> head[i]; curr_dl != 0;
582          curr_dl = dl_next(curr_dl)) {
583       real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
584       real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
585       GC_printf2("Object: %lx, link: %lx\n", real_ptr, real_link);
586     }
587   }
588 }
589
590 void GC_dump_finalization()
591 {
592     struct finalizable_object * curr_fo;
593     ptr_t real_ptr;
594     int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
595     int i;
596
597     GC_printf0("Disappearing (short) links:\n");
598     GC_dump_finalization_links(&GC_dl_hashtbl);
599     GC_printf0("Disappearing long links:\n");
600     GC_dump_finalization_links(&GC_ll_hashtbl);
601
602     GC_printf0("Finalizers:\n");
603     for (i = 0; i < fo_size; i++) {
604       for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
605         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
606         GC_printf1("Finalizable object: 0x%lx\n", real_ptr);
607       }
608     }
609 }
610 #endif
611
612 static void GC_make_disappearing_links_disappear(struct dl_hashtbl_s *dl_hashtbl)
613 {
614     struct disappearing_link * curr_dl, * prev_dl, * next_dl;
615     ptr_t real_ptr, real_link;
616     register int i;
617     int dl_size = (dl_hashtbl -> log_size == -1 ) ? 0 : (1 << dl_hashtbl -> log_size);
618
619     for (i = 0; i < dl_size; i++) {
620       curr_dl = dl_hashtbl -> head[i];
621       prev_dl = 0;
622       while (curr_dl != 0) {
623         real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
624         real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
625         if (!GC_is_marked(real_ptr)) {
626             *(word *)real_link = 0;
627             next_dl = dl_next(curr_dl);
628             if (prev_dl == 0) {
629                 dl_hashtbl -> head[i] = next_dl;
630             } else {
631                 dl_set_next(prev_dl, next_dl);
632             }
633             GC_clear_mark_bit((ptr_t)curr_dl);
634             dl_hashtbl -> entries--;
635             curr_dl = next_dl;
636         } else {
637             prev_dl = curr_dl;
638             curr_dl = dl_next(curr_dl);
639         }
640       }
641     }
642 }
643
644 static void GC_remove_dangling_disappearing_links(struct dl_hashtbl_s *dl_hashtbl)
645 {
646     struct disappearing_link * curr_dl, * prev_dl, * next_dl;
647     ptr_t real_ptr, real_link;
648     register int i;
649     int dl_size = (dl_hashtbl -> log_size == -1 ) ? 0 : (1 << dl_hashtbl -> log_size);
650
651     for (i = 0; i < dl_size; i++) {
652       curr_dl = dl_hashtbl -> head[i];
653       prev_dl = 0;
654       while (curr_dl != 0) {
655         real_link = GC_base((ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link));
656         if (real_link != 0 && !GC_is_marked(real_link)) {
657             next_dl = dl_next(curr_dl);
658             if (prev_dl == 0) {
659                 dl_hashtbl -> head[i] = next_dl;
660             } else {
661                 dl_set_next(prev_dl, next_dl);
662             }
663             GC_clear_mark_bit((ptr_t)curr_dl);
664             dl_hashtbl -> entries--;
665             curr_dl = next_dl;
666         } else {
667             prev_dl = curr_dl;
668             curr_dl = dl_next(curr_dl);
669         }
670       }
671     }
672 }
673
674 /* Called with world stopped.  Cause disappearing links to disappear,   */
675 /* and invoke finalizers.                                               */
676 void GC_finalize()
677 {
678     struct finalizable_object * curr_fo, * prev_fo, * next_fo;
679     ptr_t real_ptr;
680     register int i;
681     int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
682     
683   /* Make non-tracking disappearing links disappear */
684         GC_make_disappearing_links_disappear(&GC_dl_hashtbl);
685
686   /* Mark all objects reachable via chains of 1 or more pointers        */
687   /* from finalizable objects.                                          */
688     GC_ASSERT(GC_mark_state == MS_NONE);
689     for (i = 0; i < fo_size; i++) {
690       for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
691         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
692         if (!GC_is_marked(real_ptr)) {
693             GC_MARKED_FOR_FINALIZATION(real_ptr);
694             GC_MARK_FO(real_ptr, curr_fo -> fo_mark_proc);
695             if (GC_is_marked(real_ptr)) {
696                 WARN("Finalization cycle involving %lx\n", real_ptr);
697             }
698         }
699       }
700     }
701   /* Enqueue for finalization all objects that are still                */
702   /* unreachable.                                                       */
703     GC_words_finalized = 0;
704     for (i = 0; i < fo_size; i++) {
705       curr_fo = fo_head[i];
706       prev_fo = 0;
707       while (curr_fo != 0) {
708         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
709         if (!GC_is_marked(real_ptr)) {
710             if (!GC_java_finalization) {
711               GC_set_mark_bit(real_ptr);
712             }
713             /* Delete from hash table */
714               next_fo = fo_next(curr_fo);
715               if (prev_fo == 0) {
716                 fo_head[i] = next_fo;
717               } else {
718                 fo_set_next(prev_fo, next_fo);
719               }
720               GC_fo_entries--;
721             /* Add to list of objects awaiting finalization.    */
722               fo_set_next(curr_fo, GC_finalize_now);
723               GC_finalize_now = curr_fo;
724               /* unhide object pointer so any future collections will   */
725               /* see it.                                                */
726               curr_fo -> fo_hidden_base = 
727                         (word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
728               GC_words_finalized +=
729                         ALIGNED_WORDS(curr_fo -> fo_object_size)
730                         + ALIGNED_WORDS(sizeof(struct finalizable_object));
731             GC_ASSERT(GC_is_marked(GC_base((ptr_t)curr_fo)));
732             curr_fo = next_fo;
733         } else {
734             prev_fo = curr_fo;
735             curr_fo = fo_next(curr_fo);
736         }
737       }
738     }
739
740   if (GC_java_finalization) {
741     /* make sure we mark everything reachable from objects finalized
742        using the no_order mark_proc */
743       for (curr_fo = GC_finalize_now; 
744          curr_fo != NULL; curr_fo = fo_next(curr_fo)) {
745         real_ptr = (ptr_t)curr_fo -> fo_hidden_base;
746         if (!GC_is_marked(real_ptr)) {
747             if (curr_fo -> fo_mark_proc == GC_null_finalize_mark_proc) {
748                 GC_MARK_FO(real_ptr, GC_normal_finalize_mark_proc);
749             }
750             GC_set_mark_bit(real_ptr);
751         }
752       }
753   }
754
755   /* Remove dangling disappearing links. */
756   GC_remove_dangling_disappearing_links(&GC_dl_hashtbl);
757
758   /* Make long links disappear and remove dangling ones. */
759   GC_make_disappearing_links_disappear(&GC_ll_hashtbl);
760   GC_remove_dangling_disappearing_links(&GC_ll_hashtbl);
761 }
762
763 #ifndef JAVA_FINALIZATION_NOT_NEEDED
764
765 /* Enqueue all remaining finalizers to be run - Assumes lock is
766  * held, and signals are disabled */
767 void GC_enqueue_all_finalizers()
768 {
769     struct finalizable_object * curr_fo, * prev_fo, * next_fo;
770     ptr_t real_ptr;
771     register int i;
772     int fo_size;
773     
774     fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
775     GC_words_finalized = 0;
776     for (i = 0; i < fo_size; i++) {
777         curr_fo = fo_head[i];
778         prev_fo = 0;
779       while (curr_fo != 0) {
780           real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
781           GC_MARK_FO(real_ptr, GC_normal_finalize_mark_proc);
782           GC_set_mark_bit(real_ptr);
783  
784           /* Delete from hash table */
785           next_fo = fo_next(curr_fo);
786           if (prev_fo == 0) {
787               fo_head[i] = next_fo;
788           } else {
789               fo_set_next(prev_fo, next_fo);
790           }
791           GC_fo_entries--;
792
793           /* Add to list of objects awaiting finalization.      */
794           fo_set_next(curr_fo, GC_finalize_now);
795           GC_finalize_now = curr_fo;
796
797           /* unhide object pointer so any future collections will       */
798           /* see it.                                            */
799           curr_fo -> fo_hidden_base = 
800                         (word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
801
802           GC_words_finalized +=
803                 ALIGNED_WORDS(curr_fo -> fo_object_size)
804                         + ALIGNED_WORDS(sizeof(struct finalizable_object));
805           curr_fo = next_fo;
806         }
807     }
808
809     return;
810 }
811
812 /* Invoke all remaining finalizers that haven't yet been run. 
813  * This is needed for strict compliance with the Java standard, 
814  * which can make the runtime guarantee that all finalizers are run.
815  * Unfortunately, the Java standard implies we have to keep running
816  * finalizers until there are no more left, a potential infinite loop.
817  * YUCK.
818  * Note that this is even more dangerous than the usual Java
819  * finalizers, in that objects reachable from static variables
820  * may have been finalized when these finalizers are run.
821  * Finalizers run at this point must be prepared to deal with a
822  * mostly broken world.
823  * This routine is externally callable, so is called without 
824  * the allocation lock. 
825  */
826 GC_API void GC_finalize_all()
827 {
828     DCL_LOCK_STATE;
829
830     DISABLE_SIGNALS();
831     LOCK();
832     while (GC_fo_entries > 0) {
833       GC_enqueue_all_finalizers();
834       UNLOCK();
835       ENABLE_SIGNALS();
836       GC_INVOKE_FINALIZERS();
837       DISABLE_SIGNALS();
838       LOCK();
839     }
840     UNLOCK();
841     ENABLE_SIGNALS();
842 }
843 #endif
844
845 /* Returns true if it is worth calling GC_invoke_finalizers. (Useful if */
846 /* finalizers can only be called from some kind of `safe state' and     */
847 /* getting into that safe state is expensive.)                          */
848 int GC_should_invoke_finalizers GC_PROTO((void))
849 {
850     return GC_finalize_now != 0;
851 }
852
853 /* Invoke finalizers for all objects that are ready to be finalized.    */
854 /* Should be called without allocation lock.                            */
855 int GC_invoke_finalizers()
856 {
857     struct finalizable_object * curr_fo;
858     int count = 0;
859     word mem_freed_before;
860     DCL_LOCK_STATE;
861     
862     while (GC_finalize_now != 0) {
863 #       ifdef THREADS
864             DISABLE_SIGNALS();
865             LOCK();
866 #       endif
867         if (count == 0) {
868             mem_freed_before = GC_mem_freed;
869         }
870         curr_fo = GC_finalize_now;
871 #       ifdef THREADS
872             if (curr_fo != 0) GC_finalize_now = fo_next(curr_fo);
873             UNLOCK();
874             ENABLE_SIGNALS();
875             if (curr_fo == 0) break;
876 #       else
877             GC_finalize_now = fo_next(curr_fo);
878 #       endif
879         fo_set_next(curr_fo, 0);
880         (*(curr_fo -> fo_fn))((ptr_t)(curr_fo -> fo_hidden_base),
881                               curr_fo -> fo_client_data);
882         curr_fo -> fo_client_data = 0;
883         ++count;
884 #       ifdef UNDEFINED
885             /* This is probably a bad idea.  It throws off accounting if */
886             /* nearly all objects are finalizable.  O.w. it shouldn't    */
887             /* matter.                                                   */
888             GC_free((GC_PTR)curr_fo);
889 #       endif
890     }
891     if (count != 0 && mem_freed_before != GC_mem_freed) {
892         LOCK();
893         GC_finalizer_mem_freed += (GC_mem_freed - mem_freed_before);
894         UNLOCK();
895     }
896     return count;
897 }
898
899 void (* GC_finalizer_notifier)() = (void (*) GC_PROTO((void)))0;
900
901 static GC_word last_finalizer_notification = 0;
902
903 void GC_notify_or_invoke_finalizers GC_PROTO((void))
904 {
905     /* This is a convenient place to generate backtraces if appropriate, */
906     /* since that code is not callable with the allocation lock.         */
907 #   if defined(KEEP_BACK_PTRS) || defined(MAKE_BACK_GRAPH)
908       static word last_back_trace_gc_no = 1;    /* Skip first one. */
909
910       if (GC_gc_no > last_back_trace_gc_no) {
911         word i;
912
913 #       ifdef KEEP_BACK_PTRS
914           LOCK();
915           /* Stops when GC_gc_no wraps; that's OK.      */
916           last_back_trace_gc_no = (word)(-1);  /* disable others. */
917           for (i = 0; i < GC_backtraces; ++i) {
918               /* FIXME: This tolerates concurrent heap mutation,        */
919               /* which may cause occasional mysterious results.         */
920               /* We need to release the GC lock, since GC_print_callers */
921               /* acquires it.  It probably shouldn't.                   */
922               UNLOCK();
923               GC_generate_random_backtrace_no_gc();
924               LOCK();
925           }
926           last_back_trace_gc_no = GC_gc_no;
927           UNLOCK();
928 #       endif
929 #       ifdef MAKE_BACK_GRAPH
930           if (GC_print_back_height)
931             GC_print_back_graph_stats();
932 #       endif
933       }
934 #   endif
935     if (GC_finalize_now == 0) return;
936     if (!GC_finalize_on_demand) {
937         (void) GC_invoke_finalizers();
938 #       ifndef THREADS
939           GC_ASSERT(GC_finalize_now == 0);
940 #       endif   /* Otherwise GC can run concurrently and add more */
941         return;
942     }
943     if (GC_finalizer_notifier != (void (*) GC_PROTO((void)))0
944         && last_finalizer_notification != GC_gc_no) {
945         last_finalizer_notification = GC_gc_no;
946         GC_finalizer_notifier();
947     }
948 }
949
950 # ifdef __STDC__
951     GC_PTR GC_call_with_alloc_lock(GC_fn_type fn,
952                                          GC_PTR client_data)
953 # else
954     GC_PTR GC_call_with_alloc_lock(fn, client_data)
955     GC_fn_type fn;
956     GC_PTR client_data;
957 # endif
958 {
959     GC_PTR result;
960     DCL_LOCK_STATE;
961     
962 #   ifdef THREADS
963       DISABLE_SIGNALS();
964       LOCK();
965       SET_LOCK_HOLDER();
966 #   endif
967     result = (*fn)(client_data);
968 #   ifdef THREADS
969 #     ifndef GC_ASSERTIONS
970         UNSET_LOCK_HOLDER();
971 #     endif /* o.w. UNLOCK() does it implicitly */
972       UNLOCK();
973       ENABLE_SIGNALS();
974 #   endif
975     return(result);
976 }
977
978 #if !defined(NO_DEBUGGING)
979
980 void GC_print_finalization_stats()
981 {
982     struct finalizable_object *fo = GC_finalize_now;
983     size_t ready = 0;
984
985     GC_printf3("%lu finalization table entries; %lu/%lu short/long disappearing links alive\n",
986                GC_fo_entries, (unsigned long)GC_dl_hashtbl.entries, (unsigned long)GC_ll_hashtbl.entries);
987     for (; 0 != fo; fo = fo_next(fo)) ++ready;
988     GC_printf1("%lu objects are eligible for immediate finalization\n", ready);
989 }
990
991 #endif /* NO_DEBUGGING */