/[guile]/guile/guile-core/libguile/gc.c
ViewVC logotype

Diff of /guile/guile-core/libguile/gc.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.208.2.8 by ttn, Thu Mar 14 05:26:15 2002 UTC revision 1.208.2.9 by mvo, Sat Apr 19 11:17:23 2003 UTC
# Line 1  Line 1 
1  /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.  /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
2   *   *
3   * This program is free software; you can redistribute it and/or modify   * This program is free software; you can redistribute it and/or modify
4   * it under the terms of the GNU General Public License as published by   * it under the terms of the GNU General Public License as published by
# Line 51  Line 51 
51  #include <stdio.h>  #include <stdio.h>
52  #include <errno.h>  #include <errno.h>
53  #include <string.h>  #include <string.h>
54    #include <assert.h>
55    
56  #ifdef __ia64__  #ifdef __ia64__
57  #include <ucontext.h>  #include <ucontext.h>
# Line 240  SCM_DEFINE (scm_set_debug_cell_accesses_ Line 241  SCM_DEFINE (scm_set_debug_cell_accesses_
241   *   *
242   * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will   * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
243   * trigger a GC.   * trigger a GC.
  *  
  * SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must be  
  * reclaimed by a GC triggered by must_malloc. If less than this is  
  * reclaimed, the trigger threshold is raised. [I don't know what a  
  * good value is. I arbitrarily chose 1/10 of the INIT_MALLOC_LIMIT to  
  * work around a oscillation that caused almost constant GC.]  
244   */   */
245    
246  /*  /*
# Line 282  size_t scm_default_max_segment_size = 20 Line 277  size_t scm_default_max_segment_size = 20
277  #  define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell))  #  define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell))
278  # endif  # endif
279  #endif  #endif
280    
281  /* Make heap grow with factor 1.5 */  /* Make heap grow with factor 1.5 */
282  #define SCM_EXPHEAP(scm_heap_size) (scm_heap_size / 2)  #define SCM_EXPHEAP(scm_heap_size) (scm_heap_size / 2)
283  #define SCM_INIT_MALLOC_LIMIT 100000  
284  #define SCM_MTRIGGER_HYSTERESIS (SCM_INIT_MALLOC_LIMIT/10)  /*
285      At startup GUILE takes about 100k bytes.  
286     */
287    #define SCM_INIT_MALLOC_LIMIT 200000
288    
289  /* CELL_UP and CELL_DN are used by scm_init_heap_seg to find (scm_t_cell * span)  /* CELL_UP and CELL_DN are used by scm_init_heap_seg to find (scm_t_cell * span)
290     aligned inner bounds for allocated storage */     aligned inner bounds for allocated storage */
# Line 314  size_t scm_default_max_segment_size = 20 Line 313  size_t scm_default_max_segment_size = 20
313  /* scm_freelists  /* scm_freelists
314   */   */
315    
316  typedef struct scm_t_freelist {  typedef struct scm_t_freelist
317    {
318    /* collected cells */    /* collected cells */
319    SCM cells;    SCM cells;
320    /* number of cells left to collect before cluster is full */    /* number of cells left to collect before cluster is full */
# Line 347  typedef struct scm_t_freelist { Line 347  typedef struct scm_t_freelist {
347     * belonging to this list.     * belonging to this list.
348     */     */
349    unsigned long heap_size;    unsigned long heap_size;
350  } scm_t_freelist;  }
351    scm_t_freelist;
352    
353  SCM scm_freelist = SCM_EOL;  SCM scm_freelist = SCM_EOL;
354  scm_t_freelist scm_master_freelist = {  scm_t_freelist scm_master_freelist = {
# Line 1938  scm_gc_sweep () Line 1939  scm_gc_sweep ()
1939   * during garbage collection.   * during garbage collection.
1940   */   */
1941    
1942    /*
1943     * scm_i_minyield_malloc is the minimum expected amount of malloc
1944     * storage freed during a GC triggered by scm_must_malloc, etc, in
1945     * percent of the size of the malloc heap.  When this yield is not
1946     * reached, the malloc heap is allowed to grow larger before
1947     * triggering the next GC.
1948     */
1949    
1950    static int scm_i_minyield_malloc = 40;
1951    
1952    static void
1953    check_mtrigger (char const * what )
1954    {
1955      if (scm_mallocated > scm_mtrigger)
1956        {
1957          long prev_alloced  = scm_mallocated;
1958          float yield;
1959          scm_igc (what);
1960          yield = (prev_alloced - scm_mallocated) / (float) prev_alloced;
1961    
1962          if (yield < scm_i_minyield_malloc /  100.0)
1963          {
1964            /*
1965              If you have a program that builds up a lot of data in
1966              strings, then the desired yield will never be satisfied.
1967              So we make the trigger a little larger, even.
1968    
1969              Instead of getting bogged down, we let the mtrigger grow
1970              strongly with it.
1971    
1972            */
1973            scm_mtrigger = (int)((scm_mallocated * 110.0)
1974                                 / (100 - scm_i_minyield_malloc));
1975          }
1976        }
1977    }
1978    
1979  /* scm_must_malloc  /* scm_must_malloc
1980   * Return newly malloced storage or throw an error.   * Return newly malloced storage or throw an error.
1981   *   *
# Line 1949  scm_gc_sweep () Line 1987  scm_gc_sweep ()
1987   *   *
1988   * The limit scm_mtrigger may be raised by this allocation.   * The limit scm_mtrigger may be raised by this allocation.
1989   */   */
1990    
1991  void *  void *
1992  scm_must_malloc (size_t size, const char *what)  scm_must_malloc (size_t size, const char *what)
1993  {  {
1994    void *ptr;    void *ptr;
1995    unsigned long nm = scm_mallocated + size;      
1996      unsigned long nm;
   if (nm < size)  
     /* The byte count of allocated objects has overflowed.  This is  
        probably because you forgot to report the correct size of freed  
        memory in some of your smob free methods. */  
     abort ();  
   
   if (nm <= scm_mtrigger)  
     {  
       SCM_SYSCALL (ptr = malloc (size));  
       if (NULL != ptr)  
         {  
           scm_mallocated = nm;  
 #ifdef GUILE_DEBUG_MALLOC  
           scm_malloc_register (ptr, what);  
 #endif  
           return ptr;  
         }  
     }  
   
   scm_igc (what);  
   
   nm = scm_mallocated + size;  
1997    
1998    if (nm < size)    /*
1999        run a slight risk here, in the unlikely event that realloc would
2000        return NULL, but wouldn't if we did the GC in check_mtrigger.
2001      */
2002      
2003      scm_mallocated += size;
2004      SCM_SYSCALL (ptr = malloc (size));
2005      check_mtrigger (what);
2006      
2007      nm = scm_mallocated;
2008      if (nm  < size)
2009      /* The byte count of allocated objects has overflowed.  This is      /* The byte count of allocated objects has overflowed.  This is
2010         probably because you forgot to report the correct size of freed         probably because you forgot to report the correct size of freed
2011         memory in some of your smob free methods. */         memory in some of your smob free methods. */
2012      abort ();      abort ();
2013      
   SCM_SYSCALL (ptr = malloc (size));  
2014    if (NULL != ptr)    if (NULL != ptr)
2015      {      {
       scm_mallocated = nm;  
       if (nm > scm_mtrigger - SCM_MTRIGGER_HYSTERESIS) {  
         if (nm > scm_mtrigger)  
           scm_mtrigger = nm + nm / 2;  
         else  
           scm_mtrigger += scm_mtrigger / 2;  
       }  
2016  #ifdef GUILE_DEBUG_MALLOC  #ifdef GUILE_DEBUG_MALLOC
2017        scm_malloc_register (ptr, what);        scm_malloc_register (ptr, what);
2018  #endif  #endif
   
2019        return ptr;        return ptr;
2020      }      }
2021    
2022    scm_memory_error (what);    scm_memory_error (what);
2023      assert (0);
2024      return NULL;
2025  }  }
2026    
   
 /* scm_must_realloc  
  * is similar to scm_must_malloc.  
  */  
2027  void *  void *
2028  scm_must_realloc (void *where,  scm_must_realloc (void *where,
2029                    size_t old_size,                    size_t old_size,
# Line 2015  scm_must_realloc (void *where, Line 2031  scm_must_realloc (void *where,
2031                    const char *what)                    const char *what)
2032  {  {
2033    void *ptr;    void *ptr;
2034    unsigned long nm;      
   
2035    if (size <= old_size)    if (size <= old_size)
2036      return where;      return where;
2037    
   nm = scm_mallocated + size - old_size;  
   
   if (nm < (size - old_size))  
     /* The byte count of allocated objects has overflowed.  This is  
        probably because you forgot to report the correct size of freed  
        memory in some of your smob free methods. */  
     abort ();  
   
   if (nm <= scm_mtrigger)  
     {  
       SCM_SYSCALL (ptr = realloc (where, size));  
       if (NULL != ptr)  
         {  
           scm_mallocated = nm;  
 #ifdef GUILE_DEBUG_MALLOC  
           scm_malloc_reregister (where, ptr, what);  
 #endif  
           return ptr;  
         }  
     }  
   
   scm_igc (what);  
2038    
2039    nm = scm_mallocated + size - old_size;    /*
2040        run a slight risk here, in the unlikely event that realloc would
2041    if (nm < (size - old_size))      return NULL, but wouldn't if we did the GC in check_mtrigger.
2042      */
2043      if (scm_mallocated  < 0)
2044      /* The byte count of allocated objects has overflowed.  This is      /* The byte count of allocated objects has overflowed.  This is
2045         probably because you forgot to report the correct size of freed         probably because you forgot to report the correct size of freed
2046         memory in some of your smob free methods. */         memory in some of your smob free methods. */
2047      abort ();      abort ();
2048    
2049      /*
2050        We don't want to get 0 back if we try to alloc 0 bytes, because
2051        scm_must_free() won't take NULL.
2052      */
2053      scm_mallocated += size - old_size;
2054    SCM_SYSCALL (ptr = realloc (where, size));    SCM_SYSCALL (ptr = realloc (where, size));
2055    
2056      check_mtrigger (what);
2057      
2058    if (NULL != ptr)    if (NULL != ptr)
2059      {      {
       scm_mallocated = nm;  
       if (nm > scm_mtrigger - SCM_MTRIGGER_HYSTERESIS) {  
         if (nm > scm_mtrigger)  
           scm_mtrigger = nm + nm / 2;  
         else  
           scm_mtrigger += scm_mtrigger / 2;  
       }  
2060  #ifdef GUILE_DEBUG_MALLOC  #ifdef GUILE_DEBUG_MALLOC
2061        scm_malloc_reregister (where, ptr, what);        if(where)
2062            scm_malloc_reregister (where, ptr, what);
2063          else
2064            scm_malloc_register (ptr, what);
2065  #endif  #endif
2066        return ptr;        return ptr;
2067      }      }
2068    
2069    scm_memory_error (what);    scm_memory_error (what);
2070      assert(0);
2071      return NULL;
2072  }  }
2073    
2074  char *  char *
# Line 2135  scm_done_malloc (long size) Line 2136  scm_done_malloc (long size)
2136    }    }
2137    
2138    scm_mallocated += size;    scm_mallocated += size;
2139      check_mtrigger ("foreign mallocs");
   if (scm_mallocated > scm_mtrigger)  
     {  
       scm_igc ("foreign mallocs");  
       if (scm_mallocated > scm_mtrigger - SCM_MTRIGGER_HYSTERESIS)  
         {  
           if (scm_mallocated > scm_mtrigger)  
             scm_mtrigger = scm_mallocated + scm_mallocated / 2;  
           else  
             scm_mtrigger += scm_mtrigger / 2;  
         }  
     }  
2140  }  }
2141    
2142  void  void

Legend:
Removed from v.1.208.2.8  
changed lines
  Added in v.1.208.2.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26