Back to index

plt-scheme  4.2.1
finalize.c
Go to the documentation of this file.
00001 /*
00002  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
00003  * Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
00004 
00005  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
00006  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
00007  *
00008  * Permission is hereby granted to use or copy this program
00009  * for any purpose,  provided the above notices are retained on all copies.
00010  * Permission to modify the code and to distribute modified code is granted,
00011  * provided the above notices are retained, and a notice that the code was
00012  * modified is included with the above copyright notice.
00013  */
00014 /* Boehm, February 1, 1996 1:19 pm PST */
00015 # define I_HIDE_POINTERS
00016 # include "private/gc_pmark.h"
00017 
00018 /* Type of mark procedure used for marking from finalizable object.   */
00019 /* This procedure normally does not mark the object, only its         */
00020 /* descendents.                                                       */
00021 typedef void finalization_mark_proc(/* ptr_t finalizable_obj_ptr */); 
00022 
00023 # define HASH3(addr,size,log_size) \
00024     ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+(log_size)))) \
00025     & ((size) - 1))
00026 #define HASH2(addr,log_size) HASH3(addr, 1 << log_size, log_size)
00027 
00028 struct hash_chain_entry {
00029     word hidden_key;
00030     struct hash_chain_entry * next;
00031 };
00032 
00033 unsigned GC_finalization_failures = 0;
00034        /* Number of finalization requests that failed for lack of memory. */
00035 
00036 /* PLTSCHEME: */
00037 void (*GC_custom_finalize)(void);
00038 void (*GC_push_last_roots_again)(void);
00039 
00040 static struct disappearing_link {
00041     struct hash_chain_entry prolog;
00042 #   define dl_hidden_link prolog.hidden_key
00043                             /* Field to be cleared.            */
00044 #   define dl_next(x) (struct disappearing_link *)((x) -> prolog.next)
00045 #   define dl_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
00046 
00047     word dl_hidden_obj;            /* Pointer to object base   */
00048 
00049     /* PLTSCHEME: for restoring: */
00050     union {
00051       short kind;
00052 #           define NORMAL_DL  0
00053 #           define RESTORE_DL 1
00054 #           define LATE_DL    2
00055       word value; /* old value when zeroed */
00056     } dl_special;
00057     struct disappearing_link *restore_next;
00058 } **dl_head = 0;
00059 
00060 static signed_word log_dl_table_size = -1;
00061                      /* Binary log of                          */
00062                      /* current size of array pointed to by dl_head.  */
00063                      /* -1 ==> size is 0.                      */
00064 
00065 word GC_dl_entries = 0;     /* Number of entries currently in disappearing   */
00066                      /* link table.                                   */
00067 
00068 static struct finalizable_object {
00069     struct hash_chain_entry prolog;
00070 #   define fo_hidden_base prolog.hidden_key
00071                             /* Pointer to object base.  */
00072                             /* No longer hidden once object */
00073                             /* is on finalize_now queue.       */
00074 #   define fo_next(x) (struct finalizable_object *)((x) -> prolog.next)
00075 #   define fo_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
00076     GC_finalization_proc fo_fn;    /* Finalizer.               */
00077     ptr_t fo_client_data;
00078     word fo_object_size;    /* In bytes.                */
00079     finalization_mark_proc * fo_mark_proc;       /* Mark-through procedure */
00080     int eager_level; /* PLTSCHEME: eager finalizers don't care about cycles */
00081 } **fo_head = 0;
00082 
00083 
00084 struct finalizable_object * GC_finalize_now = 0;
00085        /* LIst of objects that should be finalized now. */
00086 
00087 static signed_word log_fo_table_size = -1;
00088 
00089 word GC_fo_entries = 0;
00090 
00091 void GC_push_finalizer_structures GC_PROTO((void))
00092 {
00093     GC_push_all((ptr_t)(&dl_head), (ptr_t)(&dl_head) + sizeof(word));
00094     GC_push_all((ptr_t)(&fo_head), (ptr_t)(&fo_head) + sizeof(word));
00095 
00096     GC_push_all((ptr_t)(&GC_finalize_now), (ptr_t)(&GC_finalize_now) + sizeof(GC_finalize_now));
00097 }
00098 
00099 /* Double the size of a hash table. *size_ptr is the log of its current      */
00100 /* size.  May be a noop.                                       */
00101 /* *table is a pointer to an array of hash headers.  If we succeed, we       */
00102 /* update both *table and *log_size_ptr.                       */
00103 /* Lock is held.  Signals are disabled.                               */
00104 void GC_grow_table(table, log_size_ptr)
00105 struct hash_chain_entry ***table;
00106 signed_word * log_size_ptr;
00107 {
00108     register word i;
00109     register struct hash_chain_entry *p;
00110     int log_old_size = *log_size_ptr;
00111     register int log_new_size = log_old_size + 1;
00112     word old_size = ((log_old_size == -1)? 0: (1 << log_old_size));
00113     register word new_size = 1 << log_new_size;
00114     struct hash_chain_entry **new_table = (struct hash_chain_entry **)
00115        GC_INTERNAL_MALLOC_IGNORE_OFF_PAGE(
00116               (size_t)new_size * sizeof(struct hash_chain_entry *), NORMAL);
00117     
00118     if (new_table == 0) {
00119        if (table == 0) {
00120            ABORT("Insufficient space for initial table allocation");
00121        } else {
00122            return;
00123        }
00124     }
00125     for (i = 0; i < old_size; i++) {
00126       p = (*table)[i];
00127       while (p != 0) {
00128         register ptr_t real_key = (ptr_t)REVEAL_POINTER(p -> hidden_key);
00129         register struct hash_chain_entry *next = p -> next;
00130         register int new_hash = HASH3(real_key, new_size, log_new_size);
00131         
00132         p -> next = new_table[new_hash];
00133         new_table[new_hash] = p;
00134         p = next;
00135       }
00136     }
00137     *log_size_ptr = log_new_size;
00138     *table = new_table;
00139 }
00140 
00141 # if defined(__STDC__) || defined(__cplusplus)
00142     int GC_register_disappearing_link(GC_PTR * link)
00143 # else
00144     int GC_register_disappearing_link(link)
00145     GC_PTR * link;
00146 # endif
00147 {
00148     ptr_t base;
00149     
00150     base = (ptr_t)GC_base((GC_PTR)link);
00151     if (base == 0)
00152        ABORT("Bad arg to GC_register_disappearing_link");
00153     return(GC_general_register_disappearing_link(link, base));
00154 }
00155 
00156 /* PLTSCHEME: GC_register_late_disappearing_link */
00157 static int late_dl; /* a stupid way to pass arguments (to minimize my changes). */
00158 GC_API void GC_register_late_disappearing_link(void **link, void *obj)
00159 {
00160   late_dl= 1;
00161   GC_general_register_disappearing_link((GC_PTR *)link, (GC_PTR)obj);
00162   late_dl = 0;
00163 }
00164 
00165 
00166 # if defined(__STDC__) || defined(__cplusplus)
00167     int GC_general_register_disappearing_link(GC_PTR * link,
00168                                          GC_PTR obj)
00169 # else
00170     int GC_general_register_disappearing_link(link, obj)
00171     GC_PTR * link;
00172     GC_PTR obj;
00173 # endif
00174 
00175 {
00176     struct disappearing_link *curr_dl;
00177     int index;
00178     struct disappearing_link * new_dl;
00179     DCL_LOCK_STATE;
00180     
00181 #if 1
00182     /* PLTSCHEME: If wxObjects are sometimes stack-allocated, 
00183        MrEd needs this. Keeping it for now just-in-case, though
00184        it should be eliminated in the future. */
00185     if (!GC_base(link))
00186       return 1;
00187 #endif
00188 
00189     if ((word)link & (ALIGNMENT-1))
00190        ABORT("Bad arg to GC_general_register_disappearing_link");
00191 #   ifdef THREADS
00192        DISABLE_SIGNALS();
00193        LOCK();
00194 #   endif
00195     if (log_dl_table_size == -1
00196         || GC_dl_entries > ((word)1 << log_dl_table_size)) {
00197 #      ifndef THREADS
00198            DISABLE_SIGNALS();
00199 #      endif
00200        GC_grow_table((struct hash_chain_entry ***)(&dl_head),
00201                     &log_dl_table_size);
00202 #      ifdef CONDPRINT
00203          if (GC_print_stats) {
00204            GC_printf1("Grew dl table to %lu entries\n",
00205                      (unsigned long)(1 << log_dl_table_size));
00206          }
00207 #      endif
00208 #      ifndef THREADS
00209            ENABLE_SIGNALS();
00210 #      endif
00211     }
00212     index = HASH2(link, log_dl_table_size);
00213     curr_dl = dl_head[index];
00214     for (curr_dl = dl_head[index]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
00215         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
00216             curr_dl -> dl_hidden_obj = HIDE_POINTER(obj);
00217 #          ifdef THREADS
00218                 UNLOCK();
00219                ENABLE_SIGNALS();
00220 #          endif
00221             return(1);
00222         }
00223     }
00224     new_dl = (struct disappearing_link *)
00225       GC_INTERNAL_MALLOC(sizeof(struct disappearing_link),NORMAL);
00226     if (0 == new_dl) {
00227 #     ifdef THREADS
00228        UNLOCK();
00229        ENABLE_SIGNALS();
00230 #     endif
00231       new_dl = (struct disappearing_link *)
00232           GC_oom_fn(sizeof(struct disappearing_link));
00233       if (0 == new_dl) {
00234        GC_finalization_failures++;
00235        return(0);
00236       }
00237       /* It's not likely we'll make it here, but ... */
00238 #     ifdef THREADS
00239         DISABLE_SIGNALS();
00240        LOCK();
00241 #     endif
00242     }
00243     new_dl -> dl_hidden_obj = HIDE_POINTER(obj);
00244     new_dl -> dl_hidden_link = HIDE_POINTER(link);
00245     new_dl -> dl_special.kind = late_dl ? LATE_DL : (obj ? NORMAL_DL : RESTORE_DL); /* PLTSCHEME: Set flag */
00246     dl_set_next(new_dl, dl_head[index]);
00247     dl_head[index] = new_dl;
00248     GC_dl_entries++;
00249 #   ifdef THREADS
00250         UNLOCK();
00251         ENABLE_SIGNALS();
00252 #   endif
00253     return(0);
00254 }
00255 
00256 # if defined(__STDC__) || defined(__cplusplus)
00257     int GC_unregister_disappearing_link(GC_PTR * link)
00258 # else
00259     int GC_unregister_disappearing_link(link)
00260     GC_PTR * link;
00261 # endif
00262 {
00263     struct disappearing_link *curr_dl, *prev_dl;
00264     int index;
00265     DCL_LOCK_STATE;
00266     
00267     DISABLE_SIGNALS();
00268     LOCK();
00269     index = HASH2(link, log_dl_table_size);
00270     if (((unsigned long)link & (ALIGNMENT-1))) goto out;
00271     prev_dl = 0; curr_dl = dl_head[index];
00272     while (curr_dl != 0) {
00273         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
00274             if (prev_dl == 0) {
00275                 dl_head[index] = dl_next(curr_dl);
00276             } else {
00277                 dl_set_next(prev_dl, dl_next(curr_dl));
00278             }
00279             GC_dl_entries--;
00280             UNLOCK();
00281            ENABLE_SIGNALS();
00282 #           ifdef DBG_HDRS_ALL
00283               dl_set_next(curr_dl, 0);
00284 #           else
00285                 GC_free((GC_PTR)curr_dl);
00286 #           endif
00287             return(1);
00288         }
00289         prev_dl = curr_dl;
00290         curr_dl = dl_next(curr_dl);
00291     }
00292 out:
00293     UNLOCK();
00294     ENABLE_SIGNALS();
00295     return(0);
00296 }
00297 
00298 /* Possible finalization_marker procedures.  Note that mark stack     */
00299 /* overflow is handled by the caller, and is not a disaster.          */
00300 void GC_normal_finalize_mark_proc(p)
00301 ptr_t p;
00302 {
00303     hdr * hhdr = HDR(p);
00304     
00305     PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top,
00306             &(GC_mark_stack[GC_mark_stack_size]));
00307 }
00308 
00309 /* This only pays very partial attention to the mark descriptor.      */
00310 /* It does the right thing for normal and atomic objects, and treats  */
00311 /* most others as normal.                                      */
00312 void GC_ignore_self_finalize_mark_proc(p)
00313 ptr_t p;
00314 {
00315     hdr * hhdr = HDR(p);
00316     word descr = hhdr -> hb_descr;
00317     ptr_t q, r;
00318     ptr_t scan_limit;
00319     ptr_t target_limit = p + WORDS_TO_BYTES(hhdr -> hb_sz) - 1;
00320     
00321     if ((descr & GC_DS_TAGS) == GC_DS_LENGTH) {
00322        scan_limit = p + descr - sizeof(word);
00323     } else {
00324        scan_limit = target_limit + 1 - sizeof(word);
00325     }
00326     for (q = p; q <= scan_limit; q += ALIGNMENT) {
00327        r = *(ptr_t *)q;
00328        if (r < p || r > target_limit) {
00329            GC_PUSH_ONE_HEAP((word)r, q);
00330        }
00331     }
00332 }
00333 
00334 /*ARGSUSED*/
00335 void GC_null_finalize_mark_proc(p)
00336 ptr_t p;
00337 {
00338 }
00339 
00340 
00341 
00342 /* Register a finalization function.  See gc.h for details.    */
00343 /* in the nonthreads case, we try to avoid disabling signals,  */
00344 /* since it can be expensive.  Threads packages typically      */
00345 /* make it cheaper.                                     */
00346 void GC_register_finalizer_inner(obj, fn, cd, ofn, ocd, mp, eager_level) /* PLTSCHEME: eager_level */
00347 GC_PTR obj;
00348 GC_finalization_proc fn;
00349 GC_PTR cd;
00350 GC_finalization_proc * ofn;
00351 GC_PTR * ocd;
00352 finalization_mark_proc * mp;
00353 int eager_level; /* PLTSCHEME */
00354 {
00355     ptr_t base;
00356     struct finalizable_object * curr_fo, * prev_fo;
00357     int index;
00358     struct finalizable_object *new_fo;
00359     hdr *hhdr;
00360     DCL_LOCK_STATE;
00361 
00362 #   ifdef THREADS
00363        DISABLE_SIGNALS();
00364        LOCK();
00365 #   endif
00366     if (log_fo_table_size == -1
00367         || GC_fo_entries > ((word)1 << log_fo_table_size)) {
00368 #      ifndef THREADS
00369            DISABLE_SIGNALS();
00370 #      endif
00371        GC_grow_table((struct hash_chain_entry ***)(&fo_head),
00372                     &log_fo_table_size);
00373 #      ifdef PRINTSTATS
00374            GC_printf1("Grew fo table to %lu entries\n",
00375                      (unsigned long)(1 << log_fo_table_size));
00376 #      endif
00377 #      ifndef THREADS
00378            ENABLE_SIGNALS();
00379 #      endif
00380     }
00381     /* in the THREADS case signals are disabled and we hold allocation       */
00382     /* lock; otherwise neither is true.  Proceed carefully.           */
00383     base = (ptr_t)obj;
00384     index = HASH2(base, log_fo_table_size);
00385     prev_fo = 0; curr_fo = fo_head[index];
00386     while (curr_fo != 0) {
00387         if (curr_fo -> fo_hidden_base == HIDE_POINTER(base)) {
00388             /* Interruption by a signal in the middle of this  */
00389             /* should be safe.  The client may see only *ocd   */
00390             /* updated, but we'll declare that to be his       */
00391             /* problem.                                        */
00392             if (ocd) *ocd = (GC_PTR) curr_fo -> fo_client_data;
00393             if (ofn) *ofn = curr_fo -> fo_fn;
00394             /* Delete the structure for base. */
00395                 if (prev_fo == 0) {
00396                   fo_head[index] = fo_next(curr_fo);
00397                 } else {
00398                   fo_set_next(prev_fo, fo_next(curr_fo));
00399                 }
00400             if (fn == 0) {
00401                 GC_fo_entries--;
00402                   /* May not happen if we get a signal.  But a high   */
00403                   /* estimate will only make the table larger than    */
00404                   /* necessary.                                       */
00405 #             if !defined(THREADS) && !defined(DBG_HDRS_ALL)
00406                   GC_free((GC_PTR)curr_fo);
00407 #             endif
00408             } else {
00409                 curr_fo -> fo_fn = fn;
00410                 curr_fo -> fo_client_data = (ptr_t)cd;
00411                 curr_fo -> fo_mark_proc = mp;
00412               curr_fo -> eager_level = eager_level; /* PLTSCHEME */
00413               /* Reinsert it.  We deleted it first to maintain */
00414               /* consistency in the event of a signal.         */
00415               if (prev_fo == 0) {
00416                   fo_head[index] = curr_fo;
00417                 } else {
00418                   fo_set_next(prev_fo, curr_fo);
00419                 }
00420             }
00421 #          ifdef THREADS
00422                 UNLOCK();
00423               ENABLE_SIGNALS();
00424 #          endif
00425             return;
00426         }
00427         prev_fo = curr_fo;
00428         curr_fo = fo_next(curr_fo);
00429     }
00430     if (ofn) *ofn = 0;
00431     if (ocd) *ocd = 0;
00432     if (fn == 0) {
00433 
00434       /* PLTSCHEME: */
00435       /* If this item is already queued, de-queue it. */
00436 #if 1
00437       if (GC_finalize_now) {
00438        ptr_t real_ptr;
00439        register struct finalizable_object * curr_fo, *prev_fo;
00440        
00441        prev_fo = NULL;
00442        curr_fo = GC_finalize_now;
00443        while (curr_fo != 0) {
00444          real_ptr = (ptr_t)(curr_fo -> fo_hidden_base);
00445          if (real_ptr == obj) {
00446            if (prev_fo)
00447              fo_set_next(prev_fo, fo_next(curr_fo));
00448            else
00449              GC_finalize_now = fo_next(curr_fo);
00450            GC_free((GC_PTR)curr_fo);
00451            break;
00452          }
00453          prev_fo = curr_fo;
00454          curr_fo = fo_next(curr_fo);
00455        }
00456       }
00457 #endif
00458 
00459 #      ifdef THREADS
00460             UNLOCK();
00461            ENABLE_SIGNALS();
00462 #      endif
00463         return;
00464     }
00465     GET_HDR(base, hhdr);
00466     if (0 == hhdr) {
00467       /* We won't collect it, hence finalizer wouldn't be run. */
00468 #     ifdef THREADS
00469           UNLOCK();
00470          ENABLE_SIGNALS();
00471 #     endif
00472       return;
00473     }
00474     new_fo = (struct finalizable_object *)
00475       GC_INTERNAL_MALLOC(sizeof(struct finalizable_object),NORMAL);
00476     if (0 == new_fo) {
00477 #     ifdef THREADS
00478        UNLOCK();
00479        ENABLE_SIGNALS();
00480 #     endif
00481       new_fo = (struct finalizable_object *)
00482           GC_oom_fn(sizeof(struct finalizable_object));
00483       if (0 == new_fo) {
00484        GC_finalization_failures++;
00485        return;
00486       }
00487       /* It's not likely we'll make it here, but ... */
00488 #     ifdef THREADS
00489         DISABLE_SIGNALS();
00490        LOCK();
00491 #     endif
00492     }
00493     new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
00494     new_fo -> fo_fn = fn;
00495     new_fo -> fo_client_data = (ptr_t)cd;
00496     new_fo -> fo_object_size = hhdr -> hb_sz;
00497     new_fo -> fo_mark_proc = mp;
00498     new_fo -> eager_level = eager_level; /* PLTSCHEME */
00499     fo_set_next(new_fo, fo_head[index]);
00500     GC_fo_entries++;
00501     fo_head[index] = new_fo;
00502 #   ifdef THREADS
00503         UNLOCK();
00504        ENABLE_SIGNALS();
00505 #   endif
00506 }
00507 
00508 # if defined(__STDC__)
00509     void GC_register_finalizer(void * obj,
00510                             GC_finalization_proc fn, void * cd,
00511                             GC_finalization_proc *ofn, void ** ocd)
00512 # else
00513     void GC_register_finalizer(obj, fn, cd, ofn, ocd)
00514     GC_PTR obj;
00515     GC_finalization_proc fn;
00516     GC_PTR cd;
00517     GC_finalization_proc * ofn;
00518     GC_PTR * ocd;
00519 # endif
00520 {
00521     GC_register_finalizer_inner(obj, fn, cd, ofn,
00522                             ocd, GC_normal_finalize_mark_proc, 
00523                             0); /* PLTSCHEME */
00524 }
00525 
00526 /* PLTSCHEME: eager finalizers */
00527 # if defined(__STDC__)
00528     void GC_register_eager_finalizer(void * obj, int eager_level,
00529                                  GC_finalization_proc fn, void * cd,
00530                                  GC_finalization_proc *ofn, void ** ocd)
00531 # else
00532     void GC_register_eager_finalizer(obj, eager_level, fn, cd, ofn, ocd)
00533     GC_PTR obj;
00534     int eager_level;
00535     GC_finalization_proc fn;
00536     GC_PTR cd;
00537     GC_finalization_proc * ofn;
00538     GC_PTR * ocd;
00539 # endif
00540 {
00541     GC_register_finalizer_inner(obj, fn, cd, ofn,
00542                             ocd, GC_normal_finalize_mark_proc, 
00543                             eager_level);
00544 }
00545 
00546 # if defined(__STDC__)
00547     void GC_register_finalizer_ignore_self(void * obj,
00548                             GC_finalization_proc fn, void * cd,
00549                             GC_finalization_proc *ofn, void ** ocd)
00550 # else
00551     void GC_register_finalizer_ignore_self(obj, fn, cd, ofn, ocd)
00552     GC_PTR obj;
00553     GC_finalization_proc fn;
00554     GC_PTR cd;
00555     GC_finalization_proc * ofn;
00556     GC_PTR * ocd;
00557 # endif
00558 {
00559     GC_register_finalizer_inner(obj, fn, cd, ofn,
00560                             ocd, GC_ignore_self_finalize_mark_proc, 
00561                             0); /* PLTSCHEME */
00562 }
00563 
00564 # if defined(__STDC__)
00565     void GC_register_finalizer_no_order(void * obj,
00566                             GC_finalization_proc fn, void * cd,
00567                             GC_finalization_proc *ofn, void ** ocd)
00568 # else
00569     void GC_register_finalizer_no_order(obj, fn, cd, ofn, ocd)
00570     GC_PTR obj;
00571     GC_finalization_proc fn;
00572     GC_PTR cd;
00573     GC_finalization_proc * ofn;
00574     GC_PTR * ocd;
00575 # endif
00576 {
00577     GC_register_finalizer_inner(obj, fn, cd, ofn,
00578                             ocd, GC_null_finalize_mark_proc, 
00579                             0); /* PLTSCHEME */
00580 }
00581 
00582 /* PLTSCHEME: eager finalization: */
00583 static void finalize_eagers(int eager_level)
00584 {
00585   struct finalizable_object * curr_fo, * prev_fo, * next_fo;
00586   struct finalizable_object * end_eager_mark;
00587   ptr_t real_ptr;
00588   register int i;
00589   int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
00590 
00591   end_eager_mark = GC_finalize_now; /* PLTSCHEME */
00592   for (i = 0; i < fo_size; i++) {
00593     curr_fo = fo_head[i];
00594     prev_fo = 0;
00595     while (curr_fo != 0) {
00596       if (curr_fo -> eager_level == eager_level) {
00597        real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
00598        if (!GC_is_marked(real_ptr)) {
00599          /* We assume that (non-eager) finalization orders do not
00600             need to take into account connections through memory
00601             with eager finalizations. Otherwise, this mark bit
00602             could break the chain from one (non-eager) finalizeable
00603             to another. */
00604          GC_set_mark_bit(real_ptr);
00605          
00606          /* Delete from hash table */
00607          next_fo = fo_next(curr_fo);
00608          if (prev_fo == 0) {
00609            fo_head[i] = next_fo;
00610          } else {
00611            fo_set_next(prev_fo, next_fo);
00612          }
00613          GC_fo_entries--;
00614          /* Add to list of objects awaiting finalization.      */
00615          fo_set_next(curr_fo, GC_finalize_now);
00616          GC_finalize_now = curr_fo;
00617          /* unhide object pointer so any future collections will      */
00618          /* see it.                                     */
00619          curr_fo -> fo_hidden_base = 
00620            (word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
00621          GC_words_finalized +=
00622            ALIGNED_WORDS(curr_fo -> fo_object_size)
00623              + ALIGNED_WORDS(sizeof(struct finalizable_object));
00624 #          ifdef PRINTSTATS
00625          if (!GC_is_marked((ptr_t)curr_fo)) {
00626            ABORT("GC_finalize: found accessible unmarked object\n");
00627          }
00628 #          endif
00629          curr_fo = next_fo;
00630        } else {
00631          prev_fo = curr_fo;
00632          curr_fo = fo_next(curr_fo);
00633        }
00634       } else {
00635        prev_fo = curr_fo;
00636        curr_fo = fo_next(curr_fo);
00637       }
00638     }
00639   }
00640   
00641   /* PLTSCHEME: Mark from queued eagers: */
00642   for (curr_fo = GC_finalize_now; curr_fo != end_eager_mark; curr_fo = fo_next(curr_fo)) {
00643     /* PLTSCHEME: if this is an eager finalization, then objects
00644        accessible from real_ptr need to be marked */
00645     if (curr_fo -> eager_level == eager_level) {
00646       (*(curr_fo -> fo_mark_proc))(curr_fo -> fo_hidden_base);
00647       while (!GC_mark_stack_empty()) MARK_FROM_MARK_STACK();
00648       if (GC_mark_state != MS_NONE) {
00649        /* Mark stack overflowed. Very unlikely. 
00650           Everything's ok, though. Just mark from scratch. */
00651        while (!GC_mark_some((ptr_t)0));
00652       }
00653     }
00654   }
00655 }
00656 
00657 /* Called with world stopped.  Cause disappearing links to disappear, */
00658 /* and invoke finalizers.                                      */
00659 void GC_finalize()
00660 {
00661     struct disappearing_link * curr_dl, * prev_dl, * next_dl;
00662     struct finalizable_object * curr_fo, * prev_fo, * next_fo;
00663     ptr_t real_ptr, real_link;
00664     register int i;
00665     int dl_size = (log_dl_table_size == -1 ) ? 0 : (1 << log_dl_table_size);
00666     int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
00667     /* PLTSCHEME: for resetting the disapearing link */
00668     struct disappearing_link *done_dl = NULL, *last_done_dl = NULL;
00669 
00670     /* PLTSCHEME: it's important to "push roots again" before
00671        making disappearing links disappear, because this
00672        step includes marking from ephemerons whose keys are
00673        reachable. We want to mark before disappearing links
00674        are disappeared. */
00675     if (GC_push_last_roots_again) GC_push_last_roots_again();
00676 
00677     /* Make disappearing links disappear */
00678     /* PLTSCHEME: handle NULL real_link and remember old values */
00679     for (i = 0; i < dl_size; i++) {
00680       curr_dl = dl_head[i];
00681       prev_dl = 0;
00682       while (curr_dl != 0) {
00683        /* PLTSCHEME: skip late dls: */
00684        if (curr_dl->dl_special.kind == LATE_DL) {
00685          prev_dl = curr_dl;
00686          curr_dl = dl_next(curr_dl);
00687          continue;
00688        }
00689        /* PLTSCHEME: reorder and set real_ptr based on real_link: */
00690         real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
00691         real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
00692        if (!real_ptr)
00693          real_ptr = (ptr_t)GC_base(*(GC_PTR *)real_link);
00694        /* PLTSCHEME: keep the dl entry if dl_special.kind = 1: */
00695         if (real_ptr && !GC_is_marked(real_ptr)) {
00696          int needs_restore = (curr_dl->dl_special.kind == RESTORE_DL);
00697          if (needs_restore)
00698            curr_dl->dl_special.value = *(word *)real_link;
00699          *(word *)real_link = 0;
00700 
00701          next_dl = dl_next(curr_dl);
00702 
00703           if (needs_restore && curr_dl->dl_special.value) {
00704            if (!last_done_dl)
00705              done_dl = curr_dl;
00706            else
00707              last_done_dl->restore_next = curr_dl;
00708            last_done_dl = curr_dl;
00709          } else {
00710            if (prev_dl == 0)
00711              dl_head[i] = next_dl;
00712            else
00713              dl_set_next(prev_dl, next_dl);
00714 
00715            GC_clear_mark_bit((ptr_t)curr_dl);
00716            GC_dl_entries--;
00717          }
00718          curr_dl = next_dl;
00719        } else {
00720             prev_dl = curr_dl;
00721             curr_dl = dl_next(curr_dl);
00722         }
00723       }
00724     }
00725 
00726     /* PLTSCHEME: set NULL terminator: */
00727     if (last_done_dl)
00728       last_done_dl->restore_next = NULL;
00729 
00730   /* PLTSCHEME: All eagers first */
00731   /* Enqueue for finalization all EAGER objects that are still        */
00732   /* unreachable.                                              */
00733     GC_words_finalized = 0;
00734     finalize_eagers(1);
00735     if (GC_push_last_roots_again) GC_push_last_roots_again();
00736     finalize_eagers(2);
00737     if (GC_push_last_roots_again) GC_push_last_roots_again();
00738 
00739   /* Mark all objects reachable via chains of 1 or more pointers      */
00740   /* from finalizable objects.                                        */
00741   /* PLTSCHEME: non-eager finalizations only (eagers already marked) */
00742 #   ifdef PRINTSTATS
00743     GC_ASSERT(GC_mark_state == MS_NONE);
00744 #   endif
00745     for (i = 0; i < fo_size; i++) {
00746       for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
00747        if (!(curr_fo -> eager_level)) { /* PLTSCHEME */
00748          real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
00749          if (!GC_is_marked(real_ptr)) {
00750             (*(curr_fo -> fo_mark_proc))(real_ptr);
00751             while (!GC_mark_stack_empty()) MARK_FROM_MARK_STACK();
00752             if (GC_mark_state != MS_NONE) {
00753              /* Mark stack overflowed. Very unlikely. */
00754 #             ifdef PRINTSTATS
00755              if (GC_mark_state != MS_INVALID) ABORT("Bad mark state");
00756              GC_printf0("Mark stack overflowed in finalization!!\n");
00757 #             endif
00758              /* Make mark bits consistent again.  Forget about */
00759              /* finalizing this object for now.                */
00760              GC_set_mark_bit(real_ptr);
00761              while (!GC_mark_some((ptr_t)0));
00762             }
00763 #if 0
00764             if (GC_is_marked(real_ptr)) {
00765              /* PLTSCHEME: we have some ok cycles (below a parent) */
00766              printf("Finalization cycle involving %lx\n", real_ptr);
00767             }
00768 #endif
00769          }
00770        }
00771       }
00772     }
00773   /* Enqueue for finalization all objects that are still              */
00774   /* unreachable.                                              */
00775     /* GC_words_finalized = 0; */ /* PLTSCHEME: done above */
00776     for (i = 0; i < fo_size; i++) {
00777       curr_fo = fo_head[i];
00778       prev_fo = 0;
00779       while (curr_fo != 0) {
00780         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
00781         if (!GC_is_marked(real_ptr)) {
00782             GC_set_mark_bit(real_ptr);
00783 
00784             /* Delete from hash table */
00785               next_fo = fo_next(curr_fo);
00786               if (prev_fo == 0) {
00787                 fo_head[i] = next_fo;
00788               } else {
00789                 fo_set_next(prev_fo, next_fo);
00790               }
00791               GC_fo_entries--;
00792             /* Add to list of objects awaiting finalization.   */
00793               fo_set_next(curr_fo, GC_finalize_now);
00794               GC_finalize_now = curr_fo;
00795               /* unhide object pointer so any future collections will */
00796               /* see it.                                       */
00797               curr_fo -> fo_hidden_base = 
00798                             (word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
00799               GC_words_finalized +=
00800                      ALIGNED_WORDS(curr_fo -> fo_object_size)
00801                             + ALIGNED_WORDS(sizeof(struct finalizable_object));
00802             curr_fo = next_fo;
00803         } else {
00804             prev_fo = curr_fo;
00805             curr_fo = fo_next(curr_fo);
00806         }
00807       }
00808     }
00809 
00810     /* PLTSCHEME: Restore disappeared links. */
00811     curr_dl = done_dl;
00812     while (curr_dl != 0) {
00813       real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
00814       *(word *)real_link = curr_dl->dl_special.value;
00815       curr_dl->dl_special.kind = RESTORE_DL;
00816       prev_dl = curr_dl;
00817       curr_dl = curr_dl->restore_next;
00818       prev_dl->restore_next = NULL;
00819     }
00820 
00821     /* Remove dangling disappearing links. */
00822     for (i = 0; i < dl_size; i++) {
00823       curr_dl = dl_head[i];
00824       prev_dl = 0;
00825       while (curr_dl != 0) {
00826         real_link = GC_base((ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link));
00827         if (real_link != 0 && !GC_is_marked(real_link)) {
00828             next_dl = dl_next(curr_dl);
00829             if (prev_dl == 0) {
00830                 dl_head[i] = next_dl;
00831             } else {
00832                 dl_set_next(prev_dl, next_dl);
00833             }
00834             GC_clear_mark_bit((ptr_t)curr_dl);
00835             GC_dl_entries--;
00836             curr_dl = next_dl;
00837         } else {
00838             prev_dl = curr_dl;
00839             curr_dl = dl_next(curr_dl);
00840         }
00841       }
00842     }
00843 
00844     /* PLTSCHEME: late disappearing links */
00845     for (i = 0; i < dl_size; i++) {
00846       curr_dl = dl_head[i];
00847       prev_dl = 0;
00848       while (curr_dl != 0) {
00849        if (curr_dl -> dl_special.kind == LATE_DL) {
00850          /* PLTSCHEME: reorder and set real_ptr based on real_link: */
00851          real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
00852          real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
00853          if (!real_ptr)
00854            real_ptr = (ptr_t)GC_base(*(GC_PTR *)real_link);
00855          if (real_ptr && !GC_is_marked(real_ptr)) {
00856            *(word *)real_link = 0;
00857 
00858            next_dl = dl_next(curr_dl);
00859 
00860            if (prev_dl == 0)
00861              dl_head[i] = next_dl;
00862            else
00863              dl_set_next(prev_dl, next_dl);
00864 
00865            GC_clear_mark_bit((ptr_t)curr_dl);
00866            GC_dl_entries--;
00867 
00868            curr_dl = next_dl;
00869          } else {
00870            prev_dl = curr_dl;
00871            curr_dl = dl_next(curr_dl);
00872          }
00873        } else {
00874          prev_dl = curr_dl;
00875          curr_dl = dl_next(curr_dl);
00876         }
00877       }
00878     }
00879 
00880     /* PLTSCHEME: */
00881     if (GC_custom_finalize)
00882       GC_custom_finalize();
00883 }
00884 
00885 #ifdef JAVA_FINALIZATION
00886 
00887 /* Enqueue all remaining finalizers to be run - Assumes lock is
00888  * held, and signals are disabled */
00889 void GC_enqueue_all_finalizers()
00890 {
00891     struct finalizable_object * curr_fo, * prev_fo, * next_fo;
00892     ptr_t real_ptr;
00893     register int i;
00894     int fo_size;
00895     
00896     fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
00897     GC_words_finalized = 0;
00898     for (i = 0; i < fo_size; i++) {
00899         curr_fo = fo_head[i];
00900         prev_fo = 0;
00901       while (curr_fo != 0) {
00902           real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
00903           GC_MARK_FO(real_ptr, GC_normal_finalize_mark_proc);
00904           GC_set_mark_bit(real_ptr);
00905  
00906           /* Delete from hash table */
00907           next_fo = fo_next(curr_fo);
00908           if (prev_fo == 0) {
00909               fo_head[i] = next_fo;
00910           } else {
00911               fo_set_next(prev_fo, next_fo);
00912           }
00913           GC_fo_entries--;
00914 
00915           /* Add to list of objects awaiting finalization.     */
00916           fo_set_next(curr_fo, GC_finalize_now);
00917           GC_finalize_now = curr_fo;
00918 
00919           /* unhide object pointer so any future collections will     */
00920           /* see it.                                    */
00921           curr_fo -> fo_hidden_base = 
00922                      (word) REVEAL_POINTER(curr_fo -> fo_hidden_base);
00923 
00924           GC_words_finalized +=
00925               ALIGNED_WORDS(curr_fo -> fo_object_size)
00926                      + ALIGNED_WORDS(sizeof(struct finalizable_object));
00927           curr_fo = next_fo;
00928         }
00929     }
00930 
00931     return;
00932 }
00933 
00934 /* Invoke all remaining finalizers that haven't yet been run. 
00935  * This is needed for strict compliance with the Java standard, 
00936  * which can make the runtime guarantee that all finalizers are run.
00937  * Unfortunately, the Java standard implies we have to keep running
00938  * finalizers until there are no more left, a potential infinite loop.
00939  * YUCK.
00940  * This routine is externally callable, so is called without 
00941  * the allocation lock. 
00942  */
00943 void GC_finalize_all()
00944 {
00945     DCL_LOCK_STATE;
00946 
00947     DISABLE_SIGNALS();
00948     LOCK();
00949     while (GC_fo_entries > 0) {
00950       GC_enqueue_all_finalizers();
00951       UNLOCK();
00952       ENABLE_SIGNALS();
00953       GC_INVOKE_FINALIZERS();
00954       DISABLE_SIGNALS();
00955       LOCK();
00956     }
00957     UNLOCK();
00958     ENABLE_SIGNALS();
00959 }
00960 #endif
00961 
00962 /* Invoke finalizers for all objects that are ready to be finalized.  */
00963 /* Should be called without allocation lock.                          */
00964 int GC_invoke_finalizers()
00965 {
00966     static int doing = 0; /* PLTSCHEME */
00967     struct finalizable_object * curr_fo;
00968     int count = 0;
00969     word mem_freed_before;
00970     DCL_LOCK_STATE;
00971 
00972     /* PLTSCHEME: don't allow nested finalizations */
00973     if (doing)
00974       return 0;
00975     doing++;
00976     
00977     while (GC_finalize_now != 0) {
00978 #      ifdef THREADS
00979            DISABLE_SIGNALS();
00980            LOCK();
00981 #      endif
00982        if (count == 0) {
00983            mem_freed_before = GC_mem_freed;
00984        }
00985        curr_fo = GC_finalize_now;
00986 #      ifdef THREADS
00987            if (curr_fo != 0) GC_finalize_now = fo_next(curr_fo);
00988            UNLOCK();
00989            ENABLE_SIGNALS();
00990            if (curr_fo == 0) break;
00991 #      else
00992            GC_finalize_now = fo_next(curr_fo);
00993 #      endif
00994        fo_set_next(curr_fo, 0);
00995        (*(curr_fo -> fo_fn))((ptr_t)(curr_fo -> fo_hidden_base),
00996                            curr_fo -> fo_client_data);
00997        curr_fo -> fo_client_data = 0;
00998        ++count;
00999 #      ifdef UNDEFINED
01000            /* This is probably a bad idea.  It throws off accounting if */
01001            /* nearly all objects are finalizable.  O.w. it shouldn't   */
01002            /* matter.                                                  */
01003            GC_free((GC_PTR)curr_fo);
01004 #      endif
01005     }
01006 
01007     doing--; /* PLTSCHEME */
01008 
01009     if (count != 0 && mem_freed_before != GC_mem_freed) {
01010         LOCK();
01011        GC_finalizer_mem_freed += (GC_mem_freed - mem_freed_before);
01012        UNLOCK();
01013     }
01014     return count;
01015 }
01016 
01017 void (* GC_finalizer_notifier)() = (void (*) GC_PROTO((void)))0;
01018 
01019 static GC_word last_finalizer_notification = 0;
01020 
01021 #ifdef KEEP_BACK_PTRS
01022 void GC_generate_random_backtrace_no_gc(void);
01023 #endif
01024 
01025 void GC_notify_or_invoke_finalizers GC_PROTO((void))
01026 {
01027     /* This is a convenient place to generate backtraces if appropriate, */
01028     /* since that code is not callable with the allocation lock.       */
01029 #   ifdef KEEP_BACK_PTRS
01030       if (GC_backtraces > 0) {
01031        static word last_back_trace_gc_no = 3;    /* Skip early ones. */
01032        long i;
01033 
01034        LOCK();
01035        if (GC_gc_no > last_back_trace_gc_no) {
01036          /* Stops when GC_gc_no wraps; that's OK.       */
01037            last_back_trace_gc_no = (word)(-1);  /* disable others. */
01038            for (i = 0; i < GC_backtraces; ++i) {
01039              /* FIXME: This tolerates concurrent heap mutation,       */
01040              /* which may cause occasional mysterious results.        */
01041              /* We need to release the GC lock, since GC_print_callers       */
01042              /* acquires it.  It probably shouldn't.                  */
01043              UNLOCK();
01044              GC_generate_random_backtrace_no_gc();
01045              LOCK();
01046            }
01047            last_back_trace_gc_no = GC_gc_no;
01048        }
01049        UNLOCK();
01050       }
01051 #   endif
01052     if (GC_finalize_now == 0) return;
01053     {
01054        (void) GC_invoke_finalizers();
01055 #      ifndef THREADS
01056          GC_ASSERT(GC_finalize_now == 0);
01057 #      endif  /* Otherwise GC can run concurrently and add more */
01058        return;
01059     }
01060     if (GC_finalizer_notifier != (void (*) GC_PROTO((void)))0
01061        && last_finalizer_notification != GC_gc_no) {
01062        last_finalizer_notification = GC_gc_no;
01063        GC_finalizer_notifier();
01064     }
01065 }
01066 
01067 # ifdef __STDC__
01068     GC_PTR GC_call_with_alloc_lock(GC_fn_type fn,
01069                                     GC_PTR client_data)
01070 # else
01071     GC_PTR GC_call_with_alloc_lock(fn, client_data)
01072     GC_fn_type fn;
01073     GC_PTR client_data;
01074 # endif
01075 {
01076     GC_PTR result;
01077     DCL_LOCK_STATE;
01078     
01079 #   ifdef THREADS
01080       DISABLE_SIGNALS();
01081       LOCK();
01082       SET_LOCK_HOLDER();
01083 #   endif
01084     result = (*fn)(client_data);
01085 #   ifdef THREADS
01086 #     ifndef GC_ASSERTIONS
01087         UNSET_LOCK_HOLDER();
01088 #     endif /* o.w. UNLOCK() does it implicitly */
01089       UNLOCK();
01090       ENABLE_SIGNALS();
01091 #   endif
01092     return(result);
01093 }
01094 
01095 #if !defined(NO_DEBUGGING)
01096 
01097 void GC_print_finalization_stats()
01098 {
01099     struct finalizable_object *fo = GC_finalize_now;
01100     size_t ready = 0;
01101 
01102     GC_printf2("%lu finalization table entries; %lu disappearing links\n",
01103               GC_fo_entries, GC_dl_entries);
01104     for (; 0 != fo; fo = fo_next(fo)) ++ready;
01105     GC_printf1("%lu objects are eligible for immediate finalization\n", ready);
01106 }
01107 
01108 #endif /* NO_DEBUGGING */
01109 
01110 
01111 /* PLTSCHEME: GC_register_fnl_statics */
01112 /* See call in GC_init_inner (misc.c) for details. */
01113 void GC_register_fnl_statics(void)
01114 {
01115 #define REG(p) GC_add_roots_inner((char *)&p, ((char *)&p) + sizeof(p) + 1, FALSE);
01116 
01117   REG(GC_finalize_now);
01118   REG(GC_fo_entries);
01119   REG(dl_head);
01120   REG(fo_head);
01121 }