Back to index

plt-scheme  4.2.1
malloc.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) 2000 by Hewlett-Packard Company.  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 /* Boehm, February 7, 1996 4:32 pm PST */
00016  
00017 #include <stdio.h>
00018 #include <string.h>
00019 #include <errno.h>
00020 #include "private/gc_priv.h"
00021 
00022 extern ptr_t GC_clear_stack();     /* in misc.c, behaves like identity */
00023 void GC_extend_size_map();  /* in misc.c. */
00024 
00025 /* Allocate reclaim list for kind: */
00026 /* Return TRUE on success          */
00027 GC_bool GC_alloc_reclaim_list(kind)
00028 register struct obj_kind * kind;
00029 {
00030     struct hblk ** result = (struct hblk **)
00031               GC_scratch_alloc((MAXOBJSZ+1) * sizeof(struct hblk *));
00032     if (result == 0) return(FALSE);
00033     BZERO(result, (MAXOBJSZ+1)*sizeof(struct hblk *));
00034     kind -> ok_reclaim_list = result;
00035     return(TRUE);
00036 }
00037 
00038 /* Allocate a large block of size lw words.      */
00039 /* The block is not cleared.                     */
00040 /* Flags is 0 or IGNORE_OFF_PAGE.         */
00041 /* We hold the allocation lock.                  */
00042 ptr_t GC_alloc_large(lw, k, flags)
00043 word lw;
00044 int k;
00045 unsigned flags;
00046 {
00047     struct hblk * h;
00048     word n_blocks = OBJ_SZ_TO_BLOCKS(lw);
00049     ptr_t result;
00050        
00051     if (!GC_is_initialized) GC_init_inner();
00052     /* Do our share of marking work */
00053         if(GC_incremental && !GC_dont_gc)
00054            GC_collect_a_little_inner((int)n_blocks);
00055     h = GC_allochblk(lw, k, flags);
00056 #   ifdef USE_MUNMAP
00057        if (0 == h) {
00058            GC_merge_unmapped();
00059            h = GC_allochblk(lw, k, flags);
00060        }
00061 #   endif
00062     while (0 == h && GC_collect_or_expand(n_blocks, (flags != 0))) {
00063        h = GC_allochblk(lw, k, flags);
00064     }
00065     if (h == 0) {
00066        result = 0;
00067     } else {
00068        int total_bytes = n_blocks * HBLKSIZE;
00069        if (n_blocks > 1) {
00070            GC_large_allocd_bytes += total_bytes;
00071            if (GC_large_allocd_bytes > GC_max_large_allocd_bytes)
00072                GC_max_large_allocd_bytes = GC_large_allocd_bytes;
00073        }
00074        result = (ptr_t) (h -> hb_body);
00075        GC_words_wasted += BYTES_TO_WORDS(total_bytes) - lw;
00076     }
00077     return result;
00078 }
00079 
00080 
00081 /* Allocate a large block of size lb bytes.  Clear if appropriate.    */
00082 /* We hold the allocation lock.                                       */
00083 ptr_t GC_alloc_large_and_clear(lw, k, flags)
00084 word lw;
00085 int k;
00086 unsigned flags;
00087 {
00088     ptr_t result = GC_alloc_large(lw, k, flags);
00089     word n_blocks = OBJ_SZ_TO_BLOCKS(lw);
00090 
00091     if (0 == result) return 0;
00092     if (GC_debugging_started || GC_obj_kinds[k].ok_init) {
00093        /* Clear the whole block, in case of GC_realloc call. */
00094        BZERO(result, n_blocks * HBLKSIZE);
00095     }
00096     return result;
00097 }
00098 
00099 /* allocate lb bytes for an object of kind k.    */
00100 /* Should not be used to directly to allocate    */
00101 /* objects such as STUBBORN objects that  */
00102 /* require special handling on allocation.       */
00103 /* First a version that assumes we already       */
00104 /* hold lock:                             */
00105 ptr_t GC_generic_malloc_inner(lb, k)
00106 register word lb;
00107 register int k;
00108 {
00109 register word lw;
00110 register ptr_t op;
00111 register ptr_t *opp;
00112 
00113     if( SMALL_OBJ(lb) ) {
00114         register struct obj_kind * kind = GC_obj_kinds + k;
00115 #       ifdef MERGE_SIZES
00116          lw = GC_size_map[lb];
00117 #      else
00118          lw = ALIGNED_WORDS(lb);
00119          if (lw == 0) lw = MIN_WORDS;
00120 #       endif
00121        opp = &(kind -> ok_freelist[lw]);
00122         if( (op = *opp) == 0 ) {
00123 #          ifdef MERGE_SIZES
00124              if (GC_size_map[lb] == 0) {
00125                if (!GC_is_initialized)  GC_init_inner();
00126                if (GC_size_map[lb] == 0) GC_extend_size_map(lb);
00127                return(GC_generic_malloc_inner(lb, k));
00128              }
00129 #          else
00130              if (!GC_is_initialized) {
00131                GC_init_inner();
00132                return(GC_generic_malloc_inner(lb, k));
00133              }
00134 #          endif
00135            if (kind -> ok_reclaim_list == 0) {
00136               if (!GC_alloc_reclaim_list(kind)) goto out;
00137            }
00138            op = GC_allocobj(lw, k);
00139            if (op == 0) goto out;
00140         }
00141         /* Here everything is in a consistent state.    */
00142         /* We assume the following assignment is */
00143         /* atomic.  If we get aborted                   */
00144         /* after the assignment, we lose an object,     */
00145         /* but that's benign.                           */
00146         /* Volatile declarations may need to be added   */
00147         /* to prevent the compiler from breaking things.*/
00148        /* If we only execute the second of the   */
00149        /* following assignments, we lose the free       */
00150        /* list, but that should still be OK, at least   */
00151        /* for garbage collected memory.          */
00152         *opp = obj_link(op);
00153         obj_link(op) = 0;
00154     } else {
00155        lw = ROUNDED_UP_WORDS(lb);
00156        op = (ptr_t)GC_alloc_large_and_clear(lw, k, 0);
00157     }
00158     GC_words_allocd += lw;
00159     
00160 out:
00161     return op;
00162 }
00163 
00164 /* Allocate a composite object of size n bytes.  The caller guarantees  */
00165 /* that pointers past the first page are not relevant.  Caller holds    */
00166 /* allocation lock.                                                     */
00167 ptr_t GC_generic_malloc_inner_ignore_off_page(lb, k)
00168 register size_t lb;
00169 register int k;
00170 {
00171     register word lw;
00172     ptr_t op;
00173 
00174     if (lb <= HBLKSIZE)
00175         return(GC_generic_malloc_inner((word)lb, k));
00176     lw = ROUNDED_UP_WORDS(lb);
00177     op = (ptr_t)GC_alloc_large_and_clear(lw, k, IGNORE_OFF_PAGE);
00178     GC_words_allocd += lw;
00179     return op;
00180 }
00181 
00182 ptr_t GC_generic_malloc(lb, k)
00183 register word lb;
00184 register int k;
00185 {
00186     ptr_t result;
00187     DCL_LOCK_STATE;
00188 
00189     if (GC_have_errors) GC_print_all_errors();
00190     GC_INVOKE_FINALIZERS();
00191     if (SMALL_OBJ(lb)) {
00192        DISABLE_SIGNALS();
00193        LOCK();
00194         result = GC_generic_malloc_inner((word)lb, k);
00195        UNLOCK();
00196        ENABLE_SIGNALS();
00197     } else {
00198        word lw;
00199        word n_blocks;
00200        GC_bool init;
00201        lw = ROUNDED_UP_WORDS(lb);
00202        n_blocks = OBJ_SZ_TO_BLOCKS(lw);
00203        init = GC_obj_kinds[k].ok_init;
00204        DISABLE_SIGNALS();
00205        LOCK();
00206        result = (ptr_t)GC_alloc_large(lw, k, 0);
00207        if (0 != result) {
00208          if (GC_debugging_started) {
00209            BZERO(result, n_blocks * HBLKSIZE);
00210          } else {
00211 #           ifdef THREADS
00212              /* Clear any memory that might be used for GC descriptors */
00213              /* before we release the lock.                          */
00214                ((word *)result)[0] = 0;
00215                ((word *)result)[1] = 0;
00216                ((word *)result)[lw-1] = 0;
00217                ((word *)result)[lw-2] = 0;
00218 #          endif
00219          }
00220        }
00221        GC_words_allocd += lw;
00222        UNLOCK();
00223        ENABLE_SIGNALS();
00224        if (init && !GC_debugging_started && 0 != result) {
00225            BZERO(result, n_blocks * HBLKSIZE);
00226         }
00227     }
00228     if (0 == result) {
00229         return((*GC_oom_fn)(lb));
00230     } else {
00231         return(result);
00232     }
00233 }   
00234 
00235 
00236 #define GENERAL_MALLOC(lb,k) \
00237     (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
00238 /* We make the GC_clear_stack_call a tail call, hoping to get more of */
00239 /* the stack.                                                  */
00240 
00241 /* Allocate lb bytes of atomic (pointerfree) data */
00242 # ifdef __STDC__
00243     GC_PTR GC_malloc_atomic(size_t lb)
00244 # else
00245     GC_PTR GC_malloc_atomic(lb)
00246     size_t lb;
00247 # endif
00248 {
00249 register ptr_t op;
00250 register ptr_t * opp;
00251 register word lw;
00252 DCL_LOCK_STATE;
00253 
00254     if( EXPECT(SMALL_OBJ(lb), 1) ) {
00255 #       ifdef MERGE_SIZES
00256          lw = GC_size_map[lb];
00257 #      else
00258          lw = ALIGNED_WORDS(lb);
00259 #       endif
00260        opp = &(GC_aobjfreelist[lw]);
00261        FASTLOCK();
00262         if( EXPECT(!FASTLOCK_SUCCEEDED() || (op = *opp) == 0, 0) ) {
00263             FASTUNLOCK();
00264             return(GENERAL_MALLOC((word)lb, PTRFREE));
00265         }
00266         /* See above comment on signals.  */
00267         *opp = obj_link(op);
00268         GC_words_allocd += lw;
00269         FASTUNLOCK();
00270         return((GC_PTR) op);
00271    } else {
00272        return(GENERAL_MALLOC((word)lb, PTRFREE));
00273    }
00274 }
00275 
00276 /* provide a version of strdup() that uses the collector to allocate the
00277    copy of the string */
00278 # ifdef __STDC__
00279     char *GC_strdup(const char *s)
00280 # else
00281     char *GC_strdup(s)
00282     char *s;
00283 #endif
00284 {
00285   char *copy;
00286 
00287   if (s == NULL) return NULL;
00288   if ((copy = GC_malloc_atomic(strlen(s) + 1)) == NULL) {
00289     errno = ENOMEM;
00290     return NULL;
00291   }
00292   strcpy(copy, s);
00293   return copy;
00294 }
00295 
00296 /* Allocate lb bytes of composite (pointerful) data */
00297 # ifdef __STDC__
00298     GC_PTR GC_malloc(size_t lb)
00299 # else
00300     GC_PTR GC_malloc(lb)
00301     size_t lb;
00302 # endif
00303 {
00304 register ptr_t op;
00305 register ptr_t *opp;
00306 register word lw;
00307 DCL_LOCK_STATE;
00308 
00309     if( EXPECT(SMALL_OBJ(lb), 1) ) {
00310 #       ifdef MERGE_SIZES
00311          lw = GC_size_map[lb];
00312 #      else
00313          lw = ALIGNED_WORDS(lb);
00314 #       endif
00315        opp = &(GC_objfreelist[lw]);
00316        FASTLOCK();
00317         if( EXPECT(!FASTLOCK_SUCCEEDED() || (op = *opp) == 0, 0) ) {
00318             FASTUNLOCK();
00319             return(GENERAL_MALLOC((word)lb, NORMAL));
00320         }
00321         /* See above comment on signals.  */
00322        GC_ASSERT(0 == obj_link(op)
00323                 || (word)obj_link(op)
00324                      <= (word)GC_greatest_plausible_heap_addr
00325                    && (word)obj_link(op)
00326                      >= (word)GC_least_plausible_heap_addr);
00327         *opp = obj_link(op);
00328         obj_link(op) = 0;
00329         GC_words_allocd += lw;
00330         FASTUNLOCK();
00331         return((GC_PTR) op);
00332    } else {
00333        return(GENERAL_MALLOC((word)lb, NORMAL));
00334    }
00335 }
00336 
00337 # ifdef REDIRECT_MALLOC
00338 
00339 /* Avoid unnecessary nested procedure calls here, by #defining some   */
00340 /* malloc replacements.  Otherwise we end up saving a                 */
00341 /* meaningless return address in the object.  It also speeds things up,      */
00342 /* but it is admittedly quite ugly.                                   */
00343 # ifdef GC_ADD_CALLER
00344 #   define RA GC_RETURN_ADDR,
00345 # else
00346 #   define RA
00347 # endif
00348 # define GC_debug_malloc_replacement(lb) \
00349        GC_debug_malloc(lb, RA "unknown", 0)
00350 
00351 # ifdef __STDC__
00352     GC_PTR malloc(size_t lb)
00353 # else
00354     GC_PTR malloc(lb)
00355     size_t lb;
00356 # endif
00357   {
00358     /* It might help to manually inline the GC_malloc call here.      */
00359     /* But any decent compiler should reduce the extra procedure call */
00360     /* to at most a jump instruction in this case.                    */
00361 #   if defined(I386) && defined(GC_SOLARIS_THREADS)
00362       /*
00363        * Thread initialisation can call malloc before
00364        * we're ready for it.
00365        * It's not clear that this is enough to help matters.
00366        * The thread implementation may well call malloc at other
00367        * inopportune times.
00368        */
00369       if (!GC_is_initialized) return sbrk(lb);
00370 #   endif /* I386 && GC_SOLARIS_THREADS */
00371     return((GC_PTR)REDIRECT_MALLOC(lb));
00372   }
00373 
00374 # ifdef __STDC__
00375     GC_PTR calloc(size_t n, size_t lb)
00376 # else
00377     GC_PTR calloc(n, lb)
00378     size_t n, lb;
00379 # endif
00380   {
00381     return((GC_PTR)REDIRECT_MALLOC(n*lb));
00382   }
00383 
00384 #ifndef strdup
00385 # include <string.h>
00386 # ifdef __STDC__
00387     char *strdup(const char *s)
00388 # else
00389     char *strdup(s)
00390     char *s;
00391 # endif
00392   {
00393     size_t len = strlen(s) + 1;
00394     char * result = ((char *)REDIRECT_MALLOC(len+1));
00395     if (result == 0) {
00396       errno = ENOMEM;
00397       return 0;
00398     }
00399     BCOPY(s, result, len+1);
00400     return result;
00401   }
00402 #endif /* !defined(strdup) */
00403  /* If strdup is macro defined, we assume that it actually calls malloc, */
00404  /* and thus the right thing will happen even without overriding it.   */
00405  /* This seems to be true on most Linux systems.                */
00406 
00407 #undef GC_debug_malloc_replacement
00408 
00409 # endif /* REDIRECT_MALLOC */
00410 
00411 /* Explicitly deallocate an object p.                          */
00412 # ifdef __STDC__
00413     void GC_free(GC_PTR p)
00414 # else
00415     void GC_free(p)
00416     GC_PTR p;
00417 # endif
00418 {
00419     register struct hblk *h;
00420     register hdr *hhdr;
00421     register signed_word sz;
00422     register ptr_t * flh;
00423     register int knd;
00424     register struct obj_kind * ok;
00425     DCL_LOCK_STATE;
00426 
00427     if (p == 0) return;
00428        /* Required by ANSI.  It's not my fault ...      */
00429     h = HBLKPTR(p);
00430     hhdr = HDR(h);
00431     GC_ASSERT(GC_base(p) == p);
00432 #   if defined(REDIRECT_MALLOC) && \
00433        (defined(GC_SOLARIS_THREADS) || defined(GC_LINUX_THREADS) \
00434         || defined(__MINGW32__)) /* Should this be MSWIN32 in general? */
00435        /* For Solaris, we have to redirect malloc calls during        */
00436        /* initialization.  For the others, this seems to happen       */
00437        /* implicitly.                                                 */
00438        /* Don't try to deallocate that memory.                        */
00439        if (0 == hhdr) return;
00440 #   endif
00441     knd = hhdr -> hb_obj_kind;
00442     sz = hhdr -> hb_sz;
00443     ok = &GC_obj_kinds[knd];
00444     if (EXPECT((sz <= MAXOBJSZ), 1)) {
00445 #      ifdef THREADS
00446            DISABLE_SIGNALS();
00447            LOCK();
00448 #      endif
00449        GC_mem_freed += sz;
00450        /* A signal here can make GC_mem_freed and GC_non_gc_bytes     */
00451        /* inconsistent.  We claim this is benign.                     */
00452        if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
00453               /* Its unnecessary to clear the mark bit.  If the       */
00454               /* object is reallocated, it doesn't matter.  O.w. the  */
00455               /* collector will do it, since it's on a free list.     */
00456        if (ok -> ok_init) {
00457            BZERO((word *)p + 1, WORDS_TO_BYTES(sz-1));
00458        }
00459        flh = &(ok -> ok_freelist[sz]);
00460        obj_link(p) = *flh;
00461        *flh = (ptr_t)p;
00462 #      ifdef THREADS
00463            UNLOCK();
00464            ENABLE_SIGNALS();
00465 #      endif
00466     } else {
00467        DISABLE_SIGNALS();
00468         LOCK();
00469         GC_mem_freed += sz;
00470        if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
00471         GC_freehblk(h);
00472         UNLOCK();
00473         ENABLE_SIGNALS();
00474     }
00475 }
00476 
00477 /* Explicitly deallocate an object p when we already hold lock.              */
00478 /* Only used for internally allocated objects, so we can take some    */
00479 /* shortcuts.                                                  */
00480 #ifdef THREADS
00481 void GC_free_inner(GC_PTR p)
00482 {
00483     register struct hblk *h;
00484     register hdr *hhdr;
00485     register signed_word sz;
00486     register ptr_t * flh;
00487     register int knd;
00488     register struct obj_kind * ok;
00489     DCL_LOCK_STATE;
00490 
00491     h = HBLKPTR(p);
00492     hhdr = HDR(h);
00493     knd = hhdr -> hb_obj_kind;
00494     sz = hhdr -> hb_sz;
00495     ok = &GC_obj_kinds[knd];
00496     if (sz <= MAXOBJSZ) {
00497        GC_mem_freed += sz;
00498        if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
00499        if (ok -> ok_init) {
00500            BZERO((word *)p + 1, WORDS_TO_BYTES(sz-1));
00501        }
00502        flh = &(ok -> ok_freelist[sz]);
00503        obj_link(p) = *flh;
00504        *flh = (ptr_t)p;
00505     } else {
00506         GC_mem_freed += sz;
00507        if (IS_UNCOLLECTABLE(knd)) GC_non_gc_bytes -= WORDS_TO_BYTES(sz);
00508         GC_freehblk(h);
00509     }
00510 }
00511 #endif /* THREADS */
00512 
00513 # if defined(REDIRECT_MALLOC) && !defined(REDIRECT_FREE)
00514 #   define REDIRECT_FREE GC_free
00515 # endif
00516 # ifdef REDIRECT_FREE
00517 #   ifdef __STDC__
00518       void free(GC_PTR p)
00519 #   else
00520       void free(p)
00521       GC_PTR p;
00522 #   endif
00523   {
00524 #   ifndef IGNORE_FREE
00525       REDIRECT_FREE(p);
00526 #   endif
00527   }
00528 # endif  /* REDIRECT_MALLOC */