Back to index

plt-scheme  4.2.1
headers.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) 1996 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  * This implements:
00018  * 1. allocation of heap block headers
00019  * 2. A map from addresses to heap block addresses to heap block headers
00020  *
00021  * Access speed is crucial.  We implement an index structure based on a 2
00022  * level tree.
00023  */
00024  
00025 # include "private/gc_priv.h"
00026 
00027 bottom_index * GC_all_bottom_indices = 0;
00028                             /* Pointer to first (lowest addr) */
00029                             /* bottom_index.              */
00030 
00031 bottom_index * GC_all_bottom_indices_end = 0;
00032                             /* Pointer to last (highest addr) */
00033                             /* bottom_index.              */
00034  
00035 /* Non-macro version of header location routine */
00036 hdr * GC_find_header(h)
00037 ptr_t h;
00038 {
00039 #   ifdef HASH_TL
00040        register hdr * result;
00041        GET_HDR(h, result);
00042        return(result);
00043 #   else
00044        return(HDR_INNER(h));
00045 #   endif
00046 }
00047  
00048 /* Routines to dynamically allocate collector data structures that will */
00049 /* never be freed.                                              */
00050  
00051 static ptr_t scratch_free_ptr = 0;
00052  
00053 /* GC_scratch_last_end_ptr is end point of last obtained scratch area.  */
00054 /* GC_scratch_end_ptr is end point of current scratch area.           */
00055  
00056 ptr_t GC_scratch_alloc(bytes)
00057 register word bytes;
00058 {
00059     register ptr_t result = scratch_free_ptr;
00060 
00061 #   ifdef ALIGN_DOUBLE
00062 #      define GRANULARITY (2 * sizeof(word))
00063 #   else
00064 #      define GRANULARITY sizeof(word)
00065 #   endif
00066     bytes += GRANULARITY-1;
00067     bytes &= ~(GRANULARITY-1);
00068     scratch_free_ptr += bytes;
00069     if (scratch_free_ptr <= GC_scratch_end_ptr) {
00070         return(result);
00071     }
00072     {
00073         word bytes_to_get = MINHINCR * HBLKSIZE;
00074          
00075         if (bytes_to_get <= bytes) {
00076           /* Undo the damage, and get memory directly */
00077            bytes_to_get = bytes;
00078 #          ifdef USE_MMAP
00079               bytes_to_get += GC_page_size - 1;
00080               bytes_to_get &= ~(GC_page_size - 1);
00081 #          endif
00082            result = (ptr_t)GET_MEM(bytes_to_get);
00083             scratch_free_ptr -= bytes;
00084            GC_scratch_last_end_ptr = result + bytes;
00085             return(result);
00086         }
00087         result = (ptr_t)GET_MEM(bytes_to_get);
00088         if (result == 0) {
00089 #          ifdef PRINTSTATS
00090                 GC_printf0("Out of memory - trying to allocate less\n");
00091 #          endif
00092             scratch_free_ptr -= bytes;
00093            bytes_to_get = bytes;
00094 #          ifdef USE_MMAP
00095               bytes_to_get += GC_page_size - 1;
00096               bytes_to_get &= ~(GC_page_size - 1);
00097 #          endif
00098             return((ptr_t)GET_MEM(bytes_to_get));
00099         }
00100         scratch_free_ptr = result;
00101         GC_scratch_end_ptr = scratch_free_ptr + bytes_to_get;
00102         GC_scratch_last_end_ptr = GC_scratch_end_ptr;
00103         return(GC_scratch_alloc(bytes));
00104     }
00105 }
00106 
00107 static hdr * hdr_free_list = 0;
00108 
00109 /* Return an uninitialized header */
00110 static hdr * alloc_hdr()
00111 {
00112     register hdr * result;
00113     
00114     if (hdr_free_list == 0) {
00115         result = (hdr *) GC_scratch_alloc((word)(sizeof(hdr)));
00116     } else {
00117         result = hdr_free_list;
00118         hdr_free_list = (hdr *) (result -> hb_next);
00119     }
00120     return(result);
00121 }
00122 
00123 static void free_hdr(hhdr)
00124 hdr * hhdr;
00125 {
00126     hhdr -> hb_next = (struct hblk *) hdr_free_list;
00127     hdr_free_list = hhdr;
00128 }
00129 
00130 hdr * GC_invalid_header;
00131 
00132 #ifdef USE_HDR_CACHE
00133   word GC_hdr_cache_hits = 0;
00134   word GC_hdr_cache_misses = 0;
00135 #endif
00136  
00137 void GC_init_headers()
00138 {
00139     register unsigned i;
00140     
00141     GC_all_nils = (bottom_index *)GC_scratch_alloc((word)sizeof(bottom_index));
00142     BZERO(GC_all_nils, sizeof(bottom_index));
00143     for (i = 0; i < TOP_SZ; i++) {
00144         GC_top_index[i] = GC_all_nils;
00145     }
00146     GC_invalid_header = alloc_hdr();
00147     GC_invalidate_map(GC_invalid_header);
00148 }
00149 
00150 /* Make sure that there is a bottom level index block for address addr  */
00151 /* Return FALSE on failure.                                    */
00152 static GC_bool get_index(addr)
00153 word addr;
00154 {
00155     word hi = (word)(addr) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
00156     bottom_index * r;
00157     bottom_index * p;
00158     bottom_index ** prev;
00159     bottom_index *pi;
00160     
00161 #   ifdef HASH_TL
00162       unsigned i = TL_HASH(hi);
00163       bottom_index * old;
00164       
00165       old = p = GC_top_index[i];
00166       while(p != GC_all_nils) {
00167           if (p -> key == hi) return(TRUE);
00168           p = p -> hash_link;
00169       }
00170       r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
00171       if (r == 0) return(FALSE);
00172       BZERO(r, sizeof (bottom_index));
00173       r -> hash_link = old;
00174       GC_top_index[i] = r;
00175 #   else
00176       if (GC_top_index[hi] != GC_all_nils) return(TRUE);
00177       r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
00178       if (r == 0) return(FALSE);
00179       GC_top_index[hi] = r;
00180       BZERO(r, sizeof (bottom_index));
00181 #   endif
00182     r -> key = hi;
00183     /* Add it to the list of bottom indices */
00184       prev = &GC_all_bottom_indices;      /* pointer to p */
00185       pi = 0;                      /* bottom_index preceding p */
00186       while ((p = *prev) != 0 && p -> key < hi) {
00187        pi = p;
00188        prev = &(p -> asc_link);
00189       }
00190       r -> desc_link = pi;
00191       if (0 == p) {
00192        GC_all_bottom_indices_end = r;
00193       } else {
00194        p -> desc_link = r;
00195       }
00196       r -> asc_link = p;
00197       *prev = r;
00198     return(TRUE);
00199 }
00200 
00201 /* Install a header for block h.   */
00202 /* The header is uninitialized.           */
00203 /* Returns the header or 0 on failure.    */
00204 struct hblkhdr * GC_install_header(h)
00205 register struct hblk * h;
00206 {
00207     hdr * result;
00208     
00209     if (!get_index((word) h)) return(0);
00210     result = alloc_hdr();
00211     SET_HDR(h, result);
00212 #   ifdef USE_MUNMAP
00213        result -> hb_last_reclaimed = (unsigned short)GC_gc_no;
00214 #   endif
00215     return(result);
00216 }
00217 
00218 /* Set up forwarding counts for block h of size sz */
00219 GC_bool GC_install_counts(h, sz)
00220 register struct hblk * h;
00221 register word sz; /* bytes */
00222 {
00223     register struct hblk * hbp;
00224     register int i;
00225     
00226     for (hbp = h; (char *)hbp < (char *)h + sz; hbp += BOTTOM_SZ) {
00227         if (!get_index((word) hbp)) return(FALSE);
00228     }
00229     if (!get_index((word)h + sz - 1)) return(FALSE);
00230     for (hbp = h + 1; (char *)hbp < (char *)h + sz; hbp += 1) {
00231         i = HBLK_PTR_DIFF(hbp, h);
00232         SET_HDR(hbp, (hdr *)(i > MAX_JUMP? MAX_JUMP : i));
00233     }
00234     return(TRUE);
00235 }
00236 
00237 /* Remove the header for block h */
00238 void GC_remove_header(h)
00239 register struct hblk * h;
00240 {
00241     hdr ** ha;
00242     
00243     GET_HDR_ADDR(h, ha);
00244     free_hdr(*ha);
00245     *ha = 0;
00246 }
00247 
00248 /* Remove forwarding counts for h */
00249 void GC_remove_counts(h, sz)
00250 register struct hblk * h;
00251 register word sz; /* bytes */
00252 {
00253     register struct hblk * hbp;
00254     
00255     for (hbp = h+1; (char *)hbp < (char *)h + sz; hbp += 1) {
00256         SET_HDR(hbp, 0);
00257     }
00258 }
00259 
00260 /* Apply fn to all allocated blocks */
00261 /*VARARGS1*/
00262 void GC_apply_to_all_blocks(fn, client_data)
00263 void (*fn) GC_PROTO((struct hblk *h, word client_data));
00264 word client_data;
00265 {
00266     register int j;
00267     register bottom_index * index_p;
00268     
00269     for (index_p = GC_all_bottom_indices; index_p != 0;
00270          index_p = index_p -> asc_link) {
00271         for (j = BOTTOM_SZ-1; j >= 0;) {
00272             if (!IS_FORWARDING_ADDR_OR_NIL(index_p->index[j])) {
00273                 if (index_p->index[j]->hb_map != GC_invalid_map) {
00274                     (*fn)(((struct hblk *)
00275                            (((index_p->key << LOG_BOTTOM_SZ) + (word)j)
00276                             << LOG_HBLKSIZE)),
00277                           client_data);
00278                 }
00279                 j--;
00280              } else if (index_p->index[j] == 0) {
00281                 j--;
00282              } else {
00283                 j -= (word)(index_p->index[j]);
00284              }
00285          }
00286      }
00287 }
00288 
00289 /* Get the next valid block whose address is at least h */
00290 /* Return 0 if there is none.                           */
00291 struct hblk * GC_next_used_block(h)
00292 struct hblk * h;
00293 {
00294     register bottom_index * bi;
00295     register word j = ((word)h >> LOG_HBLKSIZE) & (BOTTOM_SZ-1);
00296     
00297     GET_BI(h, bi);
00298     if (bi == GC_all_nils) {
00299         register word hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
00300         bi = GC_all_bottom_indices;
00301         while (bi != 0 && bi -> key < hi) bi = bi -> asc_link;
00302         j = 0;
00303     }
00304     while(bi != 0) {
00305         while (j < BOTTOM_SZ) {
00306            hdr * hhdr = bi -> index[j];
00307             if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
00308                 j++;
00309             } else {
00310                 if (hhdr->hb_map != GC_invalid_map) {
00311                     return((struct hblk *)
00312                            (((bi -> key << LOG_BOTTOM_SZ) + j)
00313                             << LOG_HBLKSIZE));
00314                 } else {
00315                     j += divHBLKSZ(hhdr -> hb_sz);
00316                 }
00317             }
00318         }
00319         j = 0;
00320         bi = bi -> asc_link;
00321     }
00322     return(0);
00323 }
00324 
00325 /* Get the last (highest address) block whose address is       */
00326 /* at most h.  Return 0 if there is none.               */
00327 /* Unlike the above, this may return a free block.             */
00328 struct hblk * GC_prev_block(h)
00329 struct hblk * h;
00330 {
00331     register bottom_index * bi;
00332     register signed_word j = ((word)h >> LOG_HBLKSIZE) & (BOTTOM_SZ-1);
00333     
00334     GET_BI(h, bi);
00335     if (bi == GC_all_nils) {
00336         register word hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
00337         bi = GC_all_bottom_indices_end;
00338         while (bi != 0 && bi -> key > hi) bi = bi -> desc_link;
00339         j = BOTTOM_SZ - 1;
00340     }
00341     while(bi != 0) {
00342         while (j >= 0) {
00343            hdr * hhdr = bi -> index[j];
00344            if (0 == hhdr) {
00345               --j;
00346             } else if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
00347                 j -= (signed_word)hhdr;
00348             } else {
00349                 return((struct hblk *)
00350                           (((bi -> key << LOG_BOTTOM_SZ) + j)
00351                             << LOG_HBLKSIZE));
00352             }
00353         }
00354         j = BOTTOM_SZ - 1;
00355         bi = bi -> desc_link;
00356     }
00357     return(0);
00358 }