backport of GC mtrigger fix

[Han-Wen Nienhuys]

This implements the GC that sets a fixed percentage for mtrigger
collects. It turned out to be quite hairy, I still don't know why it
works in this configuration, but I also couldn't find out why it
didn't work in the other configuration (scm_must_malloc aliased to
scm_must_realloc).



(How about a 1.4.2 that has this fix as well?) 

*** oldgc.c     Thu Aug 22 01:51:52 2002
--- gc.c        Thu Aug 22 02:15:33 2002
***************
*** 52,55 ****
--- 52,56 ----
  #include <errno.h>
  #include <string.h>
+ #include <assert.h>
  
  #ifdef __ia64__
***************
*** 241,250 ****
   * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
   * 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.]
   */
  
--- 242,245 ----
***************
*** 285,290 ****
  /* Make heap grow with factor 1.5 */
  #define SCM_EXPHEAP(scm_heap_size) (scm_heap_size / 2)
! #define SCM_INIT_MALLOC_LIMIT 100000
! #define SCM_MTRIGGER_HYSTERESIS (SCM_INIT_MALLOC_LIMIT/10)
  
  /* CELL_UP and CELL_DN are used by scm_init_heap_seg to find (scm_t_cell * 
span)
--- 280,288 ----
  /* Make heap grow with factor 1.5 */
  #define SCM_EXPHEAP(scm_heap_size) (scm_heap_size / 2)
! 
! /*
!   At startup GUILE takes about 100k bytes.  
!  */
! #define SCM_INIT_MALLOC_LIMIT 200000
  
  /* CELL_UP and CELL_DN are used by scm_init_heap_seg to find (scm_t_cell * 
span)
***************
*** 315,319 ****
   */
  
! typedef struct scm_t_freelist {
    /* collected cells */
    SCM cells;
--- 313,318 ----
   */
  
! typedef struct scm_t_freelist
! {
    /* collected cells */
    SCM cells;
***************
*** 348,352 ****
     */
    unsigned long heap_size;
! } scm_t_freelist;
  
  SCM scm_freelist = SCM_EOL;
--- 347,352 ----
     */
    unsigned long heap_size;
! }
! scm_t_freelist;
  
  SCM scm_freelist = SCM_EOL;
***************
*** 1938,1943 ****
   * during garbage collection.
   */
  
! /* scm_must_malloc
   * Return newly malloced storage or throw an error.
   *
--- 1938,1974 ----
   * during garbage collection.
   */
+ static int scm_i_minyield_malloc = 40;
+ static int scm_gc_malloc_yield_percentage = 0;
  
! 
! static void
! check_mtrigger (char const * what )
! {
!   if (scm_mallocated > scm_mtrigger)
!     {
!       long prev_alloced  = scm_mallocated;
!       float yield;
!       scm_igc (what);
!       yield = (prev_alloced - scm_mallocated) / (float) prev_alloced;
!       scm_gc_malloc_yield_percentage = (int) (100  * yield);
! 
!       if (yield < scm_i_minyield_malloc /  100.0)
!       {
!         /*
!           If you have a program that builds up a lot of data in
!           strings, then the desired yield will never be satisfied.
!           So we make the trigger a little larger, even.
! 
!           Instead of getting bogged down, we let the mtrigger grow
!           strongly with it.
! 
!         */
!         scm_mtrigger = (scm_mallocated * 110)
!           / (100 - scm_i_minyield_malloc);
!       }
!     }
! }
! 
! /* scm_must_realloc
   * Return newly malloced storage or throw an error.
   *
***************
*** 1951,1983 ****
   */
  void *
! scm_must_malloc (size_t size, const char *what)
  {
    void *ptr;
!   unsigned long nm = scm_mallocated + size;
! 
!   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;
  
!   if (nm < size)
      /* The byte count of allocated objects has overflowed.  This is
         probably because you forgot to report the correct size of freed
--- 1982,2001 ----
   */
  void *
! scm_must_realloc (void *where,
!                 size_t old_size,
!                 size_t size,
!                 const char *what)
  {
    void *ptr;
!     
!   if (size <= old_size)
!     return where;
  
  
!   /*
!     run a slight risk here, in the unlikely event that realloc would
!     return NULL, but wouldn't if we did the GC in check_mtrigger.
!   */
!   if (scm_mallocated  < 0)
      /* The byte count of allocated objects has overflowed.  This is
         probably because you forgot to report the correct size of freed
***************
*** 1985,2067 ****
      abort ();
  
!   SCM_SYSCALL (ptr = malloc (size));
    if (NULL != ptr)
      {
-       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;
-       }
  #ifdef GUILE_DEBUG_MALLOC
!       scm_malloc_register (ptr, what);
  #endif
! 
        return ptr;
      }
  
    scm_memory_error (what);
  }
  
- 
- /* scm_must_realloc
-  * is similar to scm_must_malloc.
-  */
  void *
! scm_must_realloc (void *where,
!                 size_t old_size,
!                 size_t size,
!                 const char *what)
  {
    void *ptr;
    unsigned long nm;
  
-   if (size <= old_size)
-     return where;
- 
-   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);
  
-   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 ();
! 
!   SCM_SYSCALL (ptr = realloc (where, size));
    if (NULL != ptr)
      {
-       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;
-       }
  #ifdef GUILE_DEBUG_MALLOC
!       scm_malloc_reregister (where, ptr, what);
  #endif
        return ptr;
--- 2003,2064 ----
      abort ();
  
!   /*
!     We don't want to get 0 back if we try to alloc 0 bytes, because
!     scm_must_free() won't take NULL.
!   */
!   scm_mallocated += size - old_size;
!   SCM_SYSCALL (ptr = realloc (where, size));
! 
!   check_mtrigger (what);
!   
    if (NULL != ptr)
      {
  #ifdef GUILE_DEBUG_MALLOC
!       if(where)
!       scm_malloc_reregister (where, ptr, what);
!       else
!       scm_malloc_register (ptr, what);
  #endif
!       
        return ptr;
      }
  
    scm_memory_error (what);
+   assert(0);
+   return NULL;
  }
  
  void *
! scm_must_malloc (size_t size, const char *what)
  {
    void *ptr;
+     
    unsigned long nm;
  
  
  
!   /*
!     run a slight risk here, in the unlikely event that realloc would
!     return NULL, but wouldn't if we did the GC in check_mtrigger.
!   */
!   
!   
!   
!   
!   scm_mallocated += size;
!   SCM_SYSCALL (ptr = malloc (size));
!   check_mtrigger (what);
!   
!   nm = scm_mallocated;
!   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 (NULL != ptr)
      {
  #ifdef GUILE_DEBUG_MALLOC
!       scm_malloc_register (ptr, what);
  #endif
        return ptr;
***************
*** 2069,2074 ****
  
    scm_memory_error (what);
  }
! 
  char *
  scm_must_strndup (const char *str, size_t length)
--- 2066,2073 ----
  
    scm_memory_error (what);
+   assert (0);
+   return NULL;
  }
!  
  char *
  scm_must_strndup (const char *str, size_t length)
***************
*** 2136,2151 ****
  
    scm_mallocated += size;
! 
!   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;
!       }
!     }
  }
  
--- 2135,2139 ----
  
    scm_mallocated += size;
!   check_mtrigger ("foreign mallocs");
  }
  




-- 

Han-Wen Nienhuys   |   address@hidden   |   http://www.cs.uu.nl/~hanwen