Back to index

plt-scheme  4.2.1
stubborn.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  *
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, July 31, 1995 5:02 pm PDT */
00015 
00016 
00017 #include "private/gc_priv.h"
00018 
00019 # ifdef STUBBORN_ALLOC
00020 /* Stubborn object (hard to change, nearly immutable) allocation. */
00021 
00022 extern ptr_t GC_clear_stack();     /* in misc.c, behaves like identity */
00023 
00024 #define GENERAL_MALLOC(lb,k) \
00025     (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
00026 
00027 /* Data structure representing immutable objects that   */
00028 /* are still being initialized.                         */
00029 /* This is a bit baroque in order to avoid acquiring    */
00030 /* the lock twice for a typical allocation.             */
00031 
00032 GC_PTR * GC_changing_list_start;
00033 
00034 void GC_push_stubborn_structures GC_PROTO((void))
00035 {
00036     GC_push_all((ptr_t)(&GC_changing_list_start),
00037               (ptr_t)(&GC_changing_list_start) + sizeof(GC_PTR *));
00038 }
00039 
00040 # ifdef THREADS
00041   VOLATILE GC_PTR * VOLATILE GC_changing_list_current;
00042 # else
00043   GC_PTR * GC_changing_list_current;
00044 # endif
00045        /* Points at last added element.  Also (ab)used for            */
00046        /* synchronization.  Updates and reads are assumed atomic.     */
00047 
00048 GC_PTR * GC_changing_list_limit;
00049        /* Points at the last word of the buffer, which is always 0    */
00050        /* All entries in (GC_changing_list_current,                   */
00051        /* GC_changing_list_limit] are 0                        */
00052 
00053 
00054 void GC_stubborn_init()
00055 {
00056 #   define INIT_SIZE 10
00057 
00058     GC_changing_list_start = (GC_PTR *)
00059                      GC_INTERNAL_MALLOC(
00060                             (word)(INIT_SIZE * sizeof(GC_PTR)),
00061                             PTRFREE);
00062     BZERO(GC_changing_list_start,
00063          INIT_SIZE * sizeof(GC_PTR));
00064     if (GC_changing_list_start == 0) {
00065         GC_err_printf0("Insufficient space to start up\n");
00066         ABORT("GC_stubborn_init: put of space");
00067     }
00068     GC_changing_list_current = GC_changing_list_start;
00069     GC_changing_list_limit = GC_changing_list_start + INIT_SIZE - 1;
00070     * GC_changing_list_limit = 0;
00071 }
00072 
00073 /* Compact and possibly grow GC_uninit_list.  The old copy is         */
00074 /* left alone.       Lock must be held.                               */
00075 /* When called GC_changing_list_current == GC_changing_list_limit     */
00076 /* which is one past the current element.                      */
00077 /* When we finish GC_changing_list_current again points one past last */
00078 /* element.                                                    */
00079 /* Invariant while this is running: GC_changing_list_current          */
00080 /* points at a word containing 0.                              */
00081 /* Returns FALSE on failure.                                          */
00082 GC_bool GC_compact_changing_list()
00083 {
00084     register GC_PTR *p, *q;
00085     register word count = 0;
00086     word old_size = (char **)GC_changing_list_limit
00087                   - (char **)GC_changing_list_start+1;
00088                   /* The casts are needed as a workaround for an Amiga bug */
00089     register word new_size = old_size;
00090     GC_PTR * new_list;
00091     
00092     for (p = GC_changing_list_start; p < GC_changing_list_limit; p++) {
00093         if (*p != 0) count++;
00094     }
00095     if (2 * count > old_size) new_size = 2 * count;
00096     new_list = (GC_PTR *)
00097               GC_INTERNAL_MALLOC(
00098                             new_size * sizeof(GC_PTR), PTRFREE);
00099               /* PTRFREE is a lie.  But we don't want the collector to  */
00100               /* consider these.  We do want the list itself to be      */
00101               /* collectable.                                           */
00102     if (new_list == 0) return(FALSE);
00103     BZERO(new_list, new_size * sizeof(GC_PTR));
00104     q = new_list;
00105     for (p = GC_changing_list_start; p < GC_changing_list_limit; p++) {
00106         if (*p != 0) *q++ = *p;
00107     }
00108     GC_changing_list_start = new_list;
00109     GC_changing_list_limit = new_list + new_size - 1;
00110     GC_changing_list_current = q;
00111     return(TRUE);
00112 }
00113 
00114 /* Add p to changing list.  Clear p on failure.  */
00115 # define ADD_CHANGING(p) \
00116        {      \
00117            register struct hblk * h = HBLKPTR(p);       \
00118            register word index = PHT_HASH(h);    \
00119            \
00120            set_pht_entry_from_index(GC_changed_pages, index);  \
00121        }      \
00122        if (*GC_changing_list_current != 0 \
00123            && ++GC_changing_list_current == GC_changing_list_limit) { \
00124            if (!GC_compact_changing_list()) (p) = 0; \
00125        } \
00126        *GC_changing_list_current = p;
00127 
00128 void GC_change_stubborn(p)
00129 GC_PTR p;
00130 {
00131     DCL_LOCK_STATE;
00132     
00133     DISABLE_SIGNALS();
00134     LOCK();
00135     ADD_CHANGING(p);
00136     UNLOCK();
00137     ENABLE_SIGNALS();
00138 }
00139 
00140 void GC_end_stubborn_change(p)
00141 GC_PTR p;
00142 {
00143 #   ifdef THREADS
00144       register VOLATILE GC_PTR * my_current = GC_changing_list_current;
00145 #   else
00146       register GC_PTR * my_current = GC_changing_list_current;
00147 #   endif
00148     register GC_bool tried_quick;
00149     DCL_LOCK_STATE;
00150     
00151     if (*my_current == p) {
00152         /* Hopefully the normal case.                                 */
00153         /* Compaction could not have been running when we started.    */
00154         *my_current = 0;
00155 #      ifdef THREADS
00156           if (my_current == GC_changing_list_current) {
00157             /* Compaction can't have run in the interim.       */
00158             /* We got away with the quick and dirty approach.   */
00159             return;
00160           }
00161           tried_quick = TRUE;
00162 #      else
00163          return;
00164 #      endif
00165     } else {
00166         tried_quick = FALSE;
00167     }
00168     DISABLE_SIGNALS();
00169     LOCK();
00170     my_current = GC_changing_list_current;
00171     for (; my_current >= GC_changing_list_start; my_current--) {
00172         if (*my_current == p) {
00173             *my_current = 0;
00174             UNLOCK();
00175             ENABLE_SIGNALS();
00176             return;
00177         }
00178     }
00179     if (!tried_quick) {
00180         GC_err_printf1("Bad arg to GC_end_stubborn_change: 0x%lx\n",
00181                      (unsigned long)p);
00182         ABORT("Bad arg to GC_end_stubborn_change");
00183     }
00184     UNLOCK();
00185     ENABLE_SIGNALS();
00186 }
00187 
00188 /* Allocate lb bytes of composite (pointerful) data     */
00189 /* No pointer fields may be changed after a call to     */
00190 /* GC_end_stubborn_change(p) where p is the value       */
00191 /* returned by GC_malloc_stubborn.               */
00192 # ifdef __STDC__
00193     GC_PTR GC_malloc_stubborn(size_t lb)
00194 # else
00195     GC_PTR GC_malloc_stubborn(lb)
00196     size_t lb;
00197 # endif
00198 {
00199 register ptr_t op;
00200 register ptr_t *opp;
00201 register word lw;
00202 ptr_t result;
00203 DCL_LOCK_STATE;
00204 
00205     if( SMALL_OBJ(lb) ) {
00206 #       ifdef MERGE_SIZES
00207          lw = GC_size_map[lb];
00208 #      else
00209          lw = ALIGNED_WORDS(lb);
00210 #       endif
00211        opp = &(GC_sobjfreelist[lw]);
00212        FASTLOCK();
00213         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
00214             FASTUNLOCK();
00215             result = GC_generic_malloc((word)lb, STUBBORN);
00216             goto record;
00217         }
00218         *opp = obj_link(op);
00219         obj_link(op) = 0;
00220         GC_words_allocd += lw;
00221         result = (GC_PTR) op;
00222         ADD_CHANGING(result);
00223         FASTUNLOCK();
00224         return((GC_PTR)result);
00225    } else {
00226        result = (GC_PTR)
00227               GC_generic_malloc((word)lb, STUBBORN);
00228    }
00229 record:
00230    DISABLE_SIGNALS();
00231    LOCK();
00232    ADD_CHANGING(result);
00233    UNLOCK();
00234    ENABLE_SIGNALS();
00235    return((GC_PTR)GC_clear_stack(result));
00236 }
00237 
00238 
00239 /* Functions analogous to GC_read_dirty and GC_page_was_dirty. */
00240 /* Report pages on which stubborn objects were changed.        */
00241 void GC_read_changed()
00242 {
00243     register GC_PTR * p = GC_changing_list_start;
00244     register GC_PTR q;
00245     register struct hblk * h;
00246     register word index;
00247     
00248     if (p == 0) /* initializing */ return;
00249     BCOPY(GC_changed_pages, GC_prev_changed_pages,
00250           (sizeof GC_changed_pages));
00251     BZERO(GC_changed_pages, (sizeof GC_changed_pages));
00252     for (; p <= GC_changing_list_current; p++) {
00253         if ((q = *p) != 0) {
00254             h = HBLKPTR(q);
00255             index = PHT_HASH(h);
00256             set_pht_entry_from_index(GC_changed_pages, index);
00257         }
00258     }
00259 }
00260 
00261 GC_bool GC_page_was_changed(h)
00262 struct hblk * h;
00263 {
00264     register word index = PHT_HASH(h);
00265     
00266     return(get_pht_entry_from_index(GC_prev_changed_pages, index));
00267 }
00268 
00269 /* Remove unreachable entries from changed list. Should only be       */
00270 /* called with mark bits consistent and lock held.             */
00271 void GC_clean_changing_list()
00272 {
00273     register GC_PTR * p = GC_changing_list_start;
00274     register GC_PTR q;
00275     register ptr_t r;
00276     register unsigned long count = 0;
00277     register unsigned long dropped_count = 0;
00278     
00279     if (p == 0) /* initializing */ return;
00280     for (; p <= GC_changing_list_current; p++) {
00281         if ((q = *p) != 0) {
00282             count++;
00283             r = (ptr_t)GC_base(q);
00284             if (r == 0 || !GC_is_marked(r)) {
00285                 *p = 0;
00286                 dropped_count++;
00287            }
00288         }
00289     }
00290 #   ifdef PRINTSTATS
00291       if (count > 0) {
00292         GC_printf2("%lu entries in changing list: reclaimed %lu\n",
00293                   (unsigned long)count, (unsigned long)dropped_count);
00294       }
00295 #   endif
00296 }
00297 
00298 #else /* !STUBBORN_ALLOC */
00299 
00300 # ifdef __STDC__
00301     GC_PTR GC_malloc_stubborn(size_t lb)
00302 # else
00303     GC_PTR GC_malloc_stubborn(lb)
00304     size_t lb;
00305 # endif
00306 {
00307     return(GC_malloc(lb));
00308 }
00309 
00310 /*ARGSUSED*/
00311 void GC_end_stubborn_change(p)
00312 GC_PTR p;
00313 {
00314 }
00315 
00316 /*ARGSUSED*/
00317 void GC_change_stubborn(p)
00318 GC_PTR p;
00319 {
00320 }
00321 
00322 void GC_push_stubborn_structures GC_PROTO((void))
00323 {
00324 }
00325 
00326 #endif