Back to index

lightning-sunbird  0.9+nobinonly
alloc.c
Go to the documentation of this file.
00001 /*
00002  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
00003  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
00004  * Copyright (c) 1998 by Silicon Graphics.  All rights reserved.
00005  *
00006  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
00007  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
00008  *
00009  * Permission is hereby granted to use or copy this program
00010  * for any purpose,  provided the above notices are retained on all copies.
00011  * Permission to modify the code and to distribute modified code is granted,
00012  * provided the above notices are retained, and a notice that the code was
00013  * modified is included with the above copyright notice.
00014  *
00015  */
00016 
00017 
00018 # include "gc_priv.h"
00019 
00020 # include <stdio.h>
00021 # ifndef MACOS
00022 #   include <signal.h>
00023 #   include <sys/types.h>
00024 # endif
00025 
00026 /*
00027  * Separate free lists are maintained for different sized objects
00028  * up to MAXOBJSZ.
00029  * The call GC_allocobj(i,k) ensures that the freelist for
00030  * kind k objects of size i points to a non-empty
00031  * free list. It returns a pointer to the first entry on the free list.
00032  * In a single-threaded world, GC_allocobj may be called to allocate
00033  * an object of (small) size i as follows:
00034  *
00035  *            opp = &(GC_objfreelist[i]);
00036  *            if (*opp == 0) GC_allocobj(i, NORMAL);
00037  *            ptr = *opp;
00038  *            *opp = obj_link(ptr);
00039  *
00040  * Note that this is very fast if the free list is non-empty; it should
00041  * only involve the execution of 4 or 5 simple instructions.
00042  * All composite objects on freelists are cleared, except for
00043  * their first word.
00044  */
00045 
00046 /*
00047  *  The allocator uses GC_allochblk to allocate large chunks of objects.
00048  * These chunks all start on addresses which are multiples of
00049  * HBLKSZ.   Each allocated chunk has an associated header,
00050  * which can be located quickly based on the address of the chunk.
00051  * (See headers.c for details.) 
00052  * This makes it possible to check quickly whether an
00053  * arbitrary address corresponds to an object administered by the
00054  * allocator.
00055  */
00056 
00057 word GC_non_gc_bytes = 0;  /* Number of bytes not intended to be collected */
00058 
00059 word GC_gc_no = 0;
00060 
00061 #ifndef SMALL_CONFIG
00062   int GC_incremental = 0;    /* By default, stop the world.    */
00063 #endif
00064 
00065 int GC_full_freq = 4;          /* Every 5th collection is a full      */
00066                         /* collection.                  */
00067 
00068 char * GC_copyright[] =
00069 {"Copyright 1988,1989 Hans-J. Boehm and Alan J. Demers ",
00070 "Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved. ",
00071 "Copyright (c) 1996-1998 by Silicon Graphics.  All rights reserved. ",
00072 "THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY",
00073 " EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.",
00074 "See source code for details." };
00075 
00076 # include "version.h"
00077 
00078 /* some more variables */
00079 
00080 extern signed_word GC_mem_found;  /* Number of reclaimed longwords    */
00081                               /* after garbage collection             */
00082 
00083 GC_bool GC_dont_expand = 0;
00084 
00085 word GC_free_space_divisor = 4;
00086 
00087 extern GC_bool GC_collection_in_progress();
00088               /* Collection is in progress, or was abandoned.  */
00089 
00090 int GC_never_stop_func GC_PROTO((void)) { return(0); }
00091 
00092 CLOCK_TYPE GC_start_time;   /* Time at which we stopped world. */
00093                             /* used only in GC_timeout_stop_func.     */
00094 
00095 int GC_n_attempts = 0;             /* Number of attempts at finishing */
00096                             /* collection within TIME_LIMIT           */
00097 
00098 #ifdef SMALL_CONFIG
00099 #   define GC_timeout_stop_func GC_never_stop_func
00100 #else
00101   int GC_timeout_stop_func GC_PROTO((void))
00102   {
00103     CLOCK_TYPE current_time;
00104     static unsigned count = 0;
00105     unsigned long time_diff;
00106     
00107     if ((count++ & 3) != 0) return(0);
00108     GET_TIME(current_time);
00109     time_diff = MS_TIME_DIFF(current_time,GC_start_time);
00110     if (time_diff >= TIME_LIMIT) {
00111 #      ifdef PRINTSTATS
00112            GC_printf0("Abandoning stopped marking after ");
00113            GC_printf1("%lu msecs", (unsigned long)time_diff);
00114            GC_printf1("(attempt %d)\n", (unsigned long) GC_n_attempts);
00115 #      endif
00116        return(1);
00117     }
00118     return(0);
00119   }
00120 #endif /* !SMALL_CONFIG */
00121 
00122 /* Return the minimum number of words that must be allocated between  */
00123 /* collections to amortize the collection cost.                       */
00124 static word min_words_allocd()
00125 {
00126 #   ifdef THREADS
00127        /* We punt, for now. */
00128        register signed_word stack_size = 10000;
00129 #   else
00130         int dummy;
00131         register signed_word stack_size = (ptr_t)(&dummy) - GC_stackbottom;
00132 #   endif
00133     register word total_root_size;  /* includes double stack size,    */
00134                                 /* since the stack is expensive       */
00135                                 /* to scan.                           */
00136     
00137     if (stack_size < 0) stack_size = -stack_size;
00138     total_root_size = 2 * stack_size + GC_root_size;
00139     if (GC_incremental) {
00140         return(BYTES_TO_WORDS(GC_heapsize + total_root_size)
00141                / (2 * GC_free_space_divisor));
00142     } else {
00143         return(BYTES_TO_WORDS(GC_heapsize + total_root_size)
00144                / GC_free_space_divisor);
00145     }
00146 }
00147 
00148 /* Return the number of words allocated, adjusted for explicit storage       */
00149 /* management, etc..  This number is used in deciding when to trigger */
00150 /* collections.                                                       */
00151 word GC_adj_words_allocd()
00152 {
00153     register signed_word result;
00154     register signed_word expl_managed =
00155               BYTES_TO_WORDS((long)GC_non_gc_bytes
00156                             - (long)GC_non_gc_bytes_at_gc);
00157     
00158     /* Don't count what was explicitly freed, or newly allocated for  */
00159     /* explicit management.  Note that deallocating an explicitly     */
00160     /* managed object should not alter result, assuming the client    */
00161     /* is playing by the rules.                                       */
00162     result = (signed_word)GC_words_allocd
00163             - (signed_word)GC_mem_freed - expl_managed;
00164     if (result > (signed_word)GC_words_allocd) {
00165         result = GC_words_allocd;
00166        /* probably client bug or unfortunate scheduling */
00167     }
00168     result += GC_words_finalized;
00169        /* We count objects enqueued for finalization as though they   */
00170        /* had been reallocated this round. Finalization is user       */
00171        /* visible progress.  And if we don't count this, we have      */
00172        /* stability problems for programs that finalize all objects.  */
00173     result += GC_words_wasted;
00174        /* This doesn't reflect useful work.  But if there is lots of  */
00175        /* new fragmentation, the same is probably true of the heap,   */
00176        /* and the collection will be correspondingly cheaper.         */
00177     if (result < (signed_word)(GC_words_allocd >> 3)) {
00178        /* Always count at least 1/8 of the allocations.  We don't want       */
00179        /* to collect too infrequently, since that would inhibit       */
00180        /* coalescing of free storage blocks.                          */
00181        /* This also makes us partially robust against client bugs.    */
00182         return(GC_words_allocd >> 3);
00183     } else {
00184         return(result);
00185     }
00186 }
00187 
00188 
00189 /* Clear up a few frames worth of garbage left at the top of the stack.      */
00190 /* This is used to prevent us from accidentally treating garbade left */
00191 /* on the stack by other parts of the collector as roots.  This       */
00192 /* differs from the code in misc.c, which actually tries to keep the  */
00193 /* stack clear of long-lived, client-generated garbage.               */
00194 void GC_clear_a_few_frames()
00195 {
00196 #   define NWORDS 64
00197     word frames[NWORDS];
00198     register int i;
00199     
00200     for (i = 0; i < NWORDS; i++) frames[i] = 0;
00201 }
00202 
00203 /* Have we allocated enough to amortize a collection? */
00204 GC_bool GC_should_collect()
00205 {
00206     return(GC_adj_words_allocd() >= min_words_allocd());
00207 }
00208 
00209 void GC_notify_full_gc()
00210 {
00211     if (GC_start_call_back != (void (*)())0) {
00212        (*GC_start_call_back)();
00213     }
00214 }
00215 
00216 /* 
00217  * Initiate a garbage collection if appropriate.
00218  * Choose judiciously
00219  * between partial, full, and stop-world collections.
00220  * Assumes lock held, signals disabled.
00221  */
00222 void GC_maybe_gc()
00223 {
00224     static int n_partial_gcs = 0;
00225     GC_bool is_full_gc = FALSE;
00226 
00227     if (GC_should_collect()) {
00228         if (!GC_incremental) {
00229            GC_notify_full_gc();
00230             GC_gcollect_inner();
00231             n_partial_gcs = 0;
00232             return;
00233         } else if (n_partial_gcs >= GC_full_freq) {
00234 #          ifdef PRINTSTATS
00235              GC_printf2(
00236                "***>Full mark for collection %lu after %ld allocd bytes\n",
00237               (unsigned long) GC_gc_no+1,
00238               (long)WORDS_TO_BYTES(GC_words_allocd));
00239 #           endif
00240            GC_promote_black_lists();
00241            (void)GC_reclaim_all((GC_stop_func)0, TRUE);
00242            GC_clear_marks();
00243             n_partial_gcs = 0;
00244            GC_notify_full_gc();
00245            is_full_gc = TRUE;
00246         } else {
00247             n_partial_gcs++;
00248         }
00249         /* We try to mark with the world stopped.       */
00250         /* If we run out of time, this turns into       */
00251         /* incremental marking.                  */
00252         GET_TIME(GC_start_time);
00253         if (GC_stopped_mark(GC_timeout_stop_func)) {
00254 #           ifdef SAVE_CALL_CHAIN
00255                 GC_save_callers(GC_last_stack);
00256 #           endif
00257             GC_finish_collection();
00258         } else {
00259            if (!is_full_gc) {
00260               /* Count this as the first attempt */
00261                GC_n_attempts++;
00262            }
00263        }
00264     }
00265 }
00266 
00267 
00268 /*
00269  * Stop the world garbage collection.  Assumes lock held, signals disabled.
00270  * If stop_func is not GC_never_stop_func, then abort if stop_func returns TRUE.
00271  */
00272 GC_bool GC_try_to_collect_inner(stop_func)
00273 GC_stop_func stop_func;
00274 {
00275     if (GC_incremental && GC_collection_in_progress()) {
00276 #   ifdef PRINTSTATS
00277        GC_printf0(
00278            "GC_try_to_collect_inner: finishing collection in progress\n");
00279 #    endif /* PRINTSTATS */
00280       /* Just finish collection already in progress.    */
00281        while(GC_collection_in_progress()) {
00282            if (stop_func()) return(FALSE);
00283            GC_collect_a_little_inner(1);
00284        }
00285     }
00286 #   ifdef PRINTSTATS
00287        GC_printf2(
00288           "Initiating full world-stop collection %lu after %ld allocd bytes\n",
00289           (unsigned long) GC_gc_no+1,
00290           (long)WORDS_TO_BYTES(GC_words_allocd));
00291 #   endif
00292     GC_promote_black_lists();
00293     /* Make sure all blocks have been reclaimed, so sweep routines    */
00294     /* don't see cleared mark bits.                                   */
00295     /* If we're guaranteed to finish, then this is unnecessary.              */
00296        if (stop_func != GC_never_stop_func
00297            && !GC_reclaim_all(stop_func, FALSE)) {
00298            /* Aborted.  So far everything is still consistent. */
00299            return(FALSE);
00300        }
00301     GC_invalidate_mark_state();  /* Flush mark stack.   */
00302     GC_clear_marks();
00303 #   ifdef SAVE_CALL_CHAIN
00304         GC_save_callers(GC_last_stack);
00305 #   endif
00306     if (!GC_stopped_mark(stop_func)) {
00307       if (!GC_incremental) {
00308        /* We're partially done and have no way to complete or use     */
00309        /* current work.  Reestablish invariants as cheaply as         */
00310        /* possible.                                            */
00311        GC_invalidate_mark_state();
00312        GC_unpromote_black_lists();
00313       } /* else we claim the world is already still consistent.  We'll       */
00314         /* finish incrementally.                               */
00315       return(FALSE);
00316     }
00317     GC_finish_collection();
00318     return(TRUE);
00319 }
00320 
00321 
00322 
00323 /*
00324  * Perform n units of garbage collection work.  A unit is intended to touch
00325  * roughly GC_RATE pages.  Every once in a while, we do more than that.
00326  * This needa to be a fairly large number with our current incremental
00327  * GC strategy, since otherwise we allocate too much during GC, and the
00328  * cleanup gets expensive.
00329  */
00330 # define GC_RATE 10 
00331 # define MAX_PRIOR_ATTEMPTS 1
00332        /* Maximum number of prior attempts at world stop marking      */
00333        /* A value of 1 means that we finish the seconf time, no matter */
00334        /* how long it takes.  Doesn't count the initial root scan     */
00335        /* for a full GC.                                       */
00336 
00337 int GC_deficit = 0;  /* The number of extra calls to GC_mark_some     */
00338                      /* that we have made.                            */
00339 
00340 void GC_collect_a_little_inner(n)
00341 int n;
00342 {
00343     register int i;
00344     
00345     if (GC_incremental && GC_collection_in_progress()) {
00346        for (i = GC_deficit; i < GC_RATE*n; i++) {
00347            if (GC_mark_some((ptr_t)0)) {
00348                /* Need to finish a collection */
00349 #             ifdef SAVE_CALL_CHAIN
00350                   GC_save_callers(GC_last_stack);
00351 #             endif
00352               if (GC_n_attempts < MAX_PRIOR_ATTEMPTS) {
00353                 GET_TIME(GC_start_time);
00354                 if (!GC_stopped_mark(GC_timeout_stop_func)) {
00355                   GC_n_attempts++;
00356                   break;
00357                 }
00358               } else {
00359                 (void)GC_stopped_mark(GC_never_stop_func);
00360               }
00361                GC_finish_collection();
00362                break;
00363            }
00364        }
00365        if (GC_deficit > 0) GC_deficit -= GC_RATE*n;
00366        if (GC_deficit < 0) GC_deficit = 0;
00367     } else {
00368         GC_maybe_gc();
00369     }
00370 }
00371 
00372 int GC_collect_a_little GC_PROTO(())
00373 {
00374     int result;
00375     DCL_LOCK_STATE;
00376 
00377     DISABLE_SIGNALS();
00378     LOCK();
00379     GC_collect_a_little_inner(1);
00380     result = (int)GC_collection_in_progress();
00381     UNLOCK();
00382     ENABLE_SIGNALS();
00383     return(result);
00384 }
00385 
00386 /*
00387  * Assumes lock is held, signals are disabled.
00388  * We stop the world.
00389  * If stop_func() ever returns TRUE, we may fail and return FALSE.
00390  * Increment GC_gc_no if we succeed.
00391  */
00392 GC_bool GC_stopped_mark(stop_func)
00393 GC_stop_func stop_func;
00394 {
00395     register int i;
00396     int dummy;
00397 #   ifdef PRINTSTATS
00398        CLOCK_TYPE start_time, current_time;
00399 #   endif
00400        
00401     STOP_WORLD();
00402 #   ifdef PRINTSTATS
00403        GET_TIME(start_time);
00404        GC_printf1("--> Marking for collection %lu ",
00405                   (unsigned long) GC_gc_no + 1);
00406        GC_printf2("after %lu allocd bytes + %lu wasted bytes\n",
00407                  (unsigned long) WORDS_TO_BYTES(GC_words_allocd),
00408                  (unsigned long) WORDS_TO_BYTES(GC_words_wasted));
00409 #   endif
00410 
00411     /* Mark from all roots.  */
00412         /* Minimize junk left in my registers and on the stack */
00413             GC_clear_a_few_frames();
00414             GC_noop(0,0,0,0,0,0);
00415        GC_initiate_gc();
00416        for(i = 0;;i++) {
00417            if ((*stop_func)()) {
00418 #                 ifdef PRINTSTATS
00419                      GC_printf0("Abandoned stopped marking after ");
00420                      GC_printf1("%lu iterations\n",
00421                                (unsigned long)i);
00422 #                 endif
00423                   GC_deficit = i; /* Give the mutator a chance. */
00424                    START_WORLD();
00425                    return(FALSE);
00426            }
00427            if (GC_mark_some((ptr_t)(&dummy))) break;
00428        }
00429        
00430     GC_gc_no++;
00431 #   ifdef PRINTSTATS
00432       GC_printf2("Collection %lu reclaimed %ld bytes",
00433                 (unsigned long) GC_gc_no - 1,
00434                 (long)WORDS_TO_BYTES(GC_mem_found));
00435       GC_printf1(" ---> heapsize = %lu bytes\n",
00436                (unsigned long) GC_heapsize);
00437       /* Printf arguments may be pushed in funny places.  Clear the   */
00438       /* space.                                                       */
00439       GC_printf0("");
00440 #   endif      
00441 
00442     /* Check all debugged objects for consistency */
00443         if (GC_debugging_started) {
00444             (*GC_check_heap)();
00445         }
00446     
00447 #   ifdef PRINTTIMES
00448        GET_TIME(current_time);
00449        GC_printf1("World-stopped marking took %lu msecs\n",
00450                   MS_TIME_DIFF(current_time,start_time));
00451 #   endif
00452     START_WORLD();
00453     return(TRUE);
00454 }
00455 
00456 
00457 /* Finish up a collection.  Assumes lock is held, signals are disabled,      */
00458 /* but the world is otherwise running.                                */
00459 void GC_finish_collection()
00460 {
00461 #   ifdef PRINTTIMES
00462        CLOCK_TYPE start_time;
00463        CLOCK_TYPE finalize_time;
00464        CLOCK_TYPE done_time;
00465        
00466        GET_TIME(start_time);
00467        finalize_time = start_time;
00468 #   endif
00469 
00470 #   ifdef GATHERSTATS
00471         GC_mem_found = 0;
00472 #   endif
00473 #   ifdef FIND_LEAK
00474       /* Mark all objects on the free list.  All objects should be */
00475       /* marked when we're done.                           */
00476        {
00477          register word size;              /* current object size             */
00478          register ptr_t p;  /* pointer to current object       */
00479          register struct hblk * h; /* pointer to block containing *p */
00480          register hdr * hhdr;
00481          register int word_no;           /* "index" of *p in *q          */
00482          int kind;
00483 
00484          for (kind = 0; kind < GC_n_kinds; kind++) {
00485            for (size = 1; size <= MAXOBJSZ; size++) {
00486              for (p= GC_obj_kinds[kind].ok_freelist[size];
00487                   p != 0; p=obj_link(p)){
00488               h = HBLKPTR(p);
00489               hhdr = HDR(h);
00490               word_no = (((word *)p) - ((word *)h));
00491               set_mark_bit_from_hdr(hhdr, word_no);
00492              }
00493            }
00494          }
00495        }
00496       /* Check that everything is marked */
00497        GC_start_reclaim(TRUE);
00498 #   else
00499 
00500       GC_finalize();
00501 #     ifdef STUBBORN_ALLOC
00502         GC_clean_changing_list();
00503 #     endif
00504 
00505 #     ifdef PRINTTIMES
00506        GET_TIME(finalize_time);
00507 #     endif
00508 
00509       /* Clear free list mark bits, in case they got accidentally marked   */
00510       /* Note: HBLKPTR(p) == pointer to head of block containing *p        */
00511       /* Also subtract memory remaining from GC_mem_found count.           */
00512       /* Note that composite objects on free list are cleared.             */
00513       /* Thus accidentally marking a free list is not a problem;  only     */
00514       /* objects on the list itself will be marked, and that's fixed here. */
00515       {
00516        register word size;         /* current object size             */
00517        register ptr_t p;    /* pointer to current object       */
00518        register struct hblk * h;   /* pointer to block containing *p */
00519        register hdr * hhdr;
00520        register int word_no;           /* "index" of *p in *q          */
00521        int kind;
00522 
00523        for (kind = 0; kind < GC_n_kinds; kind++) {
00524          for (size = 1; size <= MAXOBJSZ; size++) {
00525            for (p= GC_obj_kinds[kind].ok_freelist[size];
00526                 p != 0; p=obj_link(p)){
00527               h = HBLKPTR(p);
00528               hhdr = HDR(h);
00529               word_no = (((word *)p) - ((word *)h));
00530               clear_mark_bit_from_hdr(hhdr, word_no);
00531 #             ifdef GATHERSTATS
00532                   GC_mem_found -= size;
00533 #             endif
00534            }
00535          }
00536        }
00537       }
00538 
00539 
00540 #     ifdef PRINTSTATS
00541        GC_printf1("Bytes recovered before sweep - f.l. count = %ld\n",
00542                  (long)WORDS_TO_BYTES(GC_mem_found));
00543 #     endif
00544 
00545     /* Reconstruct free lists to contain everything not marked */
00546       GC_start_reclaim(FALSE);
00547     
00548 #   endif /* !FIND_LEAK */
00549 
00550 #   ifdef PRINTSTATS
00551        GC_printf2(
00552                 "Immediately reclaimed %ld bytes in heap of size %lu bytes\n",
00553                  (long)WORDS_TO_BYTES(GC_mem_found),
00554                  (unsigned long)GC_heapsize);
00555        GC_printf2("%lu (atomic) + %lu (composite) collectable bytes in use\n",
00556                   (unsigned long)WORDS_TO_BYTES(GC_atomic_in_use),
00557                   (unsigned long)WORDS_TO_BYTES(GC_composite_in_use));
00558 #   endif
00559 
00560       GC_n_attempts = 0;
00561     /* Reset or increment counters for next cycle */
00562       GC_words_allocd_before_gc += GC_words_allocd;
00563       GC_non_gc_bytes_at_gc = GC_non_gc_bytes;
00564       GC_words_allocd = 0;
00565       GC_words_wasted = 0;
00566       GC_mem_freed = 0;
00567       
00568 #   ifdef PRINTTIMES
00569        GET_TIME(done_time);
00570        GC_printf2("Finalize + initiate sweep took %lu + %lu msecs\n",
00571                   MS_TIME_DIFF(finalize_time,start_time),
00572                   MS_TIME_DIFF(done_time,finalize_time));
00573 #   endif
00574 }
00575 
00576 /* Externally callable routine to invoke full, stop-world collection */
00577 # if defined(__STDC__) || defined(__cplusplus)
00578     int GC_try_to_collect(GC_stop_func stop_func)
00579 # else
00580     int GC_try_to_collect(stop_func)
00581     GC_stop_func stop_func;
00582 # endif
00583 {
00584     int result;
00585     DCL_LOCK_STATE;
00586     
00587     GC_INVOKE_FINALIZERS();
00588     DISABLE_SIGNALS();
00589     LOCK();
00590     ENTER_GC();
00591     if (!GC_is_initialized) GC_init_inner();
00592     /* Minimize junk left in my registers */
00593       GC_noop(0,0,0,0,0,0);
00594     result = (int)GC_try_to_collect_inner(stop_func);
00595     EXIT_GC();
00596     UNLOCK();
00597     ENABLE_SIGNALS();
00598     if(result) GC_INVOKE_FINALIZERS();
00599     return(result);
00600 }
00601 
00602 void GC_gcollect GC_PROTO(())
00603 {
00604     GC_notify_full_gc();
00605     (void)GC_try_to_collect(GC_never_stop_func);
00606 }
00607 
00608 word GC_n_heap_sects = 0;   /* Number of sections currently in heap. */
00609 
00610 /*
00611  * Use the chunk of memory starting at p of syze bytes as part of the heap.
00612  * Assumes p is HBLKSIZE aligned, and bytes is a multiple of HBLKSIZE.
00613  */
00614 void GC_add_to_heap(p, bytes)
00615 struct hblk *p;
00616 word bytes;
00617 {
00618     word words;
00619     
00620     if (GC_n_heap_sects >= MAX_HEAP_SECTS) {
00621        ABORT("Too many heap sections: Increase MAXHINCR or MAX_HEAP_SECTS");
00622     }
00623     if (!GC_install_header(p)) {
00624        /* This is extremely unlikely. Can't add it.  This will        */
00625        /* almost certainly result in a    0 return from the allocator,       */
00626        /* which is entirely appropriate.                       */
00627        return;
00628     }
00629     GC_heap_sects[GC_n_heap_sects].hs_start = (ptr_t)p;
00630     GC_heap_sects[GC_n_heap_sects].hs_bytes = bytes;
00631     GC_n_heap_sects++;
00632     words = BYTES_TO_WORDS(bytes - HDR_BYTES);
00633     HDR(p) -> hb_sz = words;
00634     GC_freehblk(p);
00635     GC_heapsize += bytes;
00636     if ((ptr_t)p <= GC_least_plausible_heap_addr
00637         || GC_least_plausible_heap_addr == 0) {
00638         GC_least_plausible_heap_addr = (ptr_t)p - sizeof(word);
00639               /* Making it a little smaller than necessary prevents   */
00640               /* us from getting a false hit from the variable */
00641               /* itself.  There's some unintentional reflection       */
00642               /* here.                                         */
00643     }
00644     if ((ptr_t)p + bytes >= GC_greatest_plausible_heap_addr) {
00645         GC_greatest_plausible_heap_addr = (ptr_t)p + bytes;
00646     }
00647 }
00648 
00649 #ifdef PRESERVE_LAST
00650 
00651 GC_bool GC_protect_last_block = FALSE;
00652 
00653 GC_bool GC_in_last_heap_sect(p)
00654 ptr_t p;
00655 {
00656     struct HeapSect * last_heap_sect;
00657     ptr_t start;
00658     ptr_t end;
00659 
00660     if (!GC_protect_last_block) return FALSE;
00661     last_heap_sect = &(GC_heap_sects[GC_n_heap_sects-1]);
00662     start = last_heap_sect -> hs_start;
00663     if (p < start) return FALSE;
00664     end = start + last_heap_sect -> hs_bytes;
00665     if (p >= end) return FALSE;
00666     return TRUE;
00667 }
00668 #endif
00669 
00670 # if !defined(NO_DEBUGGING)
00671 void GC_print_heap_sects()
00672 {
00673     register unsigned i;
00674     
00675     GC_printf1("Total heap size: %lu\n", (unsigned long) GC_heapsize);
00676     for (i = 0; i < GC_n_heap_sects; i++) {
00677         unsigned long start = (unsigned long) GC_heap_sects[i].hs_start;
00678         unsigned long len = (unsigned long) GC_heap_sects[i].hs_bytes;
00679         struct hblk *h;
00680         unsigned nbl = 0;
00681         
00682        GC_printf3("Section %ld from 0x%lx to 0x%lx ", (unsigned long)i,
00683                  start, (unsigned long)(start + len));
00684        for (h = (struct hblk *)start; h < (struct hblk *)(start + len); h++) {
00685            if (GC_is_black_listed(h, HBLKSIZE)) nbl++;
00686        }
00687        GC_printf2("%lu/%lu blacklisted\n", (unsigned long)nbl,
00688                  (unsigned long)(len/HBLKSIZE));
00689     }
00690 }
00691 # endif
00692 
00693 ptr_t GC_least_plausible_heap_addr = (ptr_t)ONES;
00694 ptr_t GC_greatest_plausible_heap_addr = 0;
00695 
00696 ptr_t GC_max(x,y)
00697 ptr_t x, y;
00698 {
00699     return(x > y? x : y);
00700 }
00701 
00702 ptr_t GC_min(x,y)
00703 ptr_t x, y;
00704 {
00705     return(x < y? x : y);
00706 }
00707 
00708 # if defined(__STDC__) || defined(__cplusplus)
00709     void GC_set_max_heap_size(GC_word n)
00710 # else
00711     void GC_set_max_heap_size(n)
00712     GC_word n;
00713 # endif
00714 {
00715     GC_max_heapsize = n;
00716 }
00717 
00718 GC_word GC_max_retries = 0;
00719 
00720 /*
00721  * this explicitly increases the size of the heap.  It is used
00722  * internally, but may also be invoked from GC_expand_hp by the user.
00723  * The argument is in units of HBLKSIZE.
00724  * Tiny values of n are rounded up.
00725  * Returns FALSE on failure.
00726  */
00727 GC_bool GC_expand_hp_inner(n)
00728 word n;
00729 {
00730     word bytes;
00731     struct hblk * space;
00732     word expansion_slop;    /* Number of bytes by which we expect the */
00733                             /* heap to expand soon.                     */
00734 
00735     if (n < MINHINCR) n = MINHINCR;
00736     bytes = n * HBLKSIZE;
00737     /* Make sure bytes is a multiple of GC_page_size */
00738       {
00739        word mask = GC_page_size - 1;
00740        bytes += mask;
00741        bytes &= ~mask;
00742       }
00743     
00744     if (GC_max_heapsize != 0 && GC_heapsize + bytes > GC_max_heapsize) {
00745         /* Exceeded self-imposed limit */
00746         return(FALSE);
00747     }
00748     space = GET_MEM(bytes);
00749     if( space == 0 ) {
00750        return(FALSE);
00751     }
00752 #   ifdef PRINTSTATS
00753        GC_printf2("Increasing heap size by %lu after %lu allocated bytes\n",
00754                   (unsigned long)bytes,
00755                   (unsigned long)WORDS_TO_BYTES(GC_words_allocd));
00756 #      ifdef UNDEFINED
00757          GC_printf1("Root size = %lu\n", GC_root_size);
00758          GC_print_block_list(); GC_print_hblkfreelist();
00759          GC_printf0("\n");
00760 #      endif
00761 #   endif
00762     expansion_slop = 8 * WORDS_TO_BYTES(min_words_allocd());
00763     if (5 * HBLKSIZE * MAXHINCR > expansion_slop) {
00764         expansion_slop = 5 * HBLKSIZE * MAXHINCR;
00765     }
00766     if (GC_last_heap_addr == 0 && !((word)space & SIGNB)
00767         || GC_last_heap_addr != 0 && GC_last_heap_addr < (ptr_t)space) {
00768         /* Assume the heap is growing up */
00769         GC_greatest_plausible_heap_addr =
00770             GC_max(GC_greatest_plausible_heap_addr,
00771                    (ptr_t)space + bytes + expansion_slop);
00772     } else {
00773         /* Heap is growing down */
00774         GC_least_plausible_heap_addr =
00775             GC_min(GC_least_plausible_heap_addr,
00776                    (ptr_t)space - expansion_slop);
00777     }
00778     GC_prev_heap_addr = GC_last_heap_addr;
00779     GC_last_heap_addr = (ptr_t)space;
00780     GC_add_to_heap(space, bytes);
00781     return(TRUE);
00782 }
00783 
00784 /* Really returns a bool, but it's externally visible, so that's clumsy. */
00785 /* Arguments is in bytes.                                      */
00786 # if defined(__STDC__) || defined(__cplusplus)
00787   int GC_expand_hp(size_t bytes)
00788 # else
00789   int GC_expand_hp(bytes)
00790   size_t bytes;
00791 # endif
00792 {
00793     int result;
00794     DCL_LOCK_STATE;
00795     
00796     DISABLE_SIGNALS();
00797     LOCK();
00798     if (!GC_is_initialized) GC_init_inner();
00799     result = (int)GC_expand_hp_inner(divHBLKSZ((word)bytes));
00800 #   ifdef PRESERVE_LAST
00801        if (result) GC_protect_last_block = FALSE;
00802 #   endif
00803     UNLOCK();
00804     ENABLE_SIGNALS();
00805     return(result);
00806 }
00807 
00808 unsigned GC_fail_count = 0;  
00809                      /* How many consecutive GC/expansion failures?   */
00810                      /* Reset by GC_allochblk.                 */
00811 
00812 GC_bool GC_collect_or_expand(needed_blocks, ignore_off_page)
00813 word needed_blocks;
00814 GC_bool ignore_off_page;
00815 {
00816     
00817     if (!GC_incremental && !GC_dont_gc && GC_should_collect()) {
00818       GC_notify_full_gc();
00819       GC_gcollect_inner();
00820     } else {
00821       word blocks_to_get = GC_heapsize/(HBLKSIZE*GC_free_space_divisor)
00822                         + needed_blocks;
00823       
00824       if (blocks_to_get > MAXHINCR) {
00825           word slop;
00826           
00827           if (ignore_off_page) {
00828               slop = 4;
00829           } else {
00830              slop = 2*divHBLKSZ(BL_LIMIT);
00831              if (slop > needed_blocks) slop = needed_blocks;
00832          }
00833           if (needed_blocks + slop > MAXHINCR) {
00834               blocks_to_get = needed_blocks + slop;
00835           } else {
00836               blocks_to_get = MAXHINCR;
00837           }
00838       }
00839       if (!GC_expand_hp_inner(blocks_to_get)
00840         && !GC_expand_hp_inner(needed_blocks)) {
00841        if (GC_fail_count++ < GC_max_retries) {
00842            WARN("Out of Memory!  Trying to continue ...\n", 0);
00843            GC_notify_full_gc();
00844            GC_gcollect_inner();
00845        } else {
00846            WARN("Out of Memory!  Returning NIL!\n", 0);
00847            return(FALSE);
00848        }
00849       } else {
00850 #        ifdef PRINTSTATS
00851             if (GC_fail_count) {
00852              GC_printf0("Memory available again ...\n");
00853            }
00854 #        endif
00855 #         ifdef PRESERVE_LAST
00856            if (needed_blocks > 1) GC_protect_last_block = TRUE;
00857               /* We were forced to expand the heap as the result      */
00858               /* of a large block allocation.  Avoid breaking up      */
00859               /* new block into small pieces.                         */
00860 #         endif
00861       }
00862     }
00863     return(TRUE);
00864 }
00865 
00866 /*
00867  * Make sure the object free list for sz is not empty.
00868  * Return a pointer to the first object on the free list.
00869  * The object MUST BE REMOVED FROM THE FREE LIST BY THE CALLER.
00870  * Assumes we hold the allocator lock and signals are disabled.
00871  *
00872  */
00873 ptr_t GC_allocobj(sz, kind)
00874 word sz;
00875 int kind;
00876 {
00877     register ptr_t * flh = &(GC_obj_kinds[kind].ok_freelist[sz]);
00878     
00879     if (sz == 0) return(0);
00880 
00881     while (*flh == 0) {
00882       ENTER_GC();
00883       /* Do our share of marking work */
00884         if(GC_incremental && !GC_dont_gc) GC_collect_a_little_inner(1);
00885       /* Sweep blocks for objects of this size */
00886           GC_continue_reclaim(sz, kind);
00887       EXIT_GC();
00888       if (*flh == 0) {
00889         GC_new_hblk(sz, kind);
00890       }
00891       if (*flh == 0) {
00892         ENTER_GC();
00893         if (!GC_collect_or_expand((word)1,FALSE)) {
00894            EXIT_GC();
00895            return(0);
00896        }
00897        EXIT_GC();
00898       }
00899     }
00900     
00901     return(*flh);
00902 }