libguile/gc-malloc.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc.
   2  *
   3  * 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
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42
  43 \f
  44 #include <stdio.h>
  45 #include <errno.h>
  46 #include <string.h>
  47
  48 #ifdef __ia64__
  49 #include <ucontext.h>
  50 extern unsigned long * __libc_ia64_register_backing_store_base;
  51 #endif
  52
  53 #include "libguile/_scm.h"
  54 #include "libguile/eval.h"
  55 #include "libguile/stime.h"
  56 #include "libguile/stackchk.h"
  57 #include "libguile/struct.h"
  58 #include "libguile/smob.h"
  59 #include "libguile/unif.h"
  60 #include "libguile/async.h"
  61 #include "libguile/ports.h"
  62 #include "libguile/root.h"
  63 #include "libguile/strings.h"
  64 #include "libguile/vectors.h"
  65 #include "libguile/weaks.h"
  66 #include "libguile/hashtab.h"
  67 #include "libguile/tags.h"
  68
  69 #include "libguile/validate.h"
  70 #include "libguile/deprecation.h"
  71 #include "libguile/gc.h"
  72
  73 #include "libguile/private-gc.h"
  74
  75 #ifdef GUILE_DEBUG_MALLOC
  76 #include "libguile/debug-malloc.h"
  77 #endif
  78
  79 #ifdef HAVE_MALLOC_H
  80 #include <malloc.h>
  81 #endif
  82
  83 #ifdef HAVE_UNISTD_H
  84 #include <unistd.h>
  85 #endif
  86
  87 /*
  88   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
  89   trigger a GC.
  90
  91   After startup (at the guile> prompt), we have approximately 100k of
  92   alloced memory, which won't go away on GC. Let's set the init such
  93   that we get a nice yield on the next allocation:
  94 */
  95 #define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024
  96 #define SCM_DEFAULT_MALLOC_MINYIELD 40
  97
  98
  99 static int scm_i_minyield_malloc;
 100
 101 void
 102 scm_gc_init_malloc (void)
 103 {
 104   scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
 105                                  SCM_DEFAULT_INIT_MALLOC_LIMIT);
 106   scm_i_minyield_malloc =  scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
 107                                            SCM_DEFAULT_MALLOC_MINYIELD);
 108 }
 109
 110
 111 \f
 112 /* Function for non-cell memory management.
 113  */
 114
 115 void *
 116 scm_realloc (void *mem, size_t size)
 117 {
 118   void *ptr;
 119
 120   SCM_SYSCALL (ptr = realloc (mem, size));
 121   if (ptr)
 122     return ptr;
 123
 124   scm_i_sweep_all_segments ("realloc");
 125
 126   SCM_SYSCALL (ptr = realloc (mem, size));
 127   if (ptr)
 128     return ptr;
 129
 130   scm_igc ("realloc");
 131   scm_i_sweep_all_segments ("realloc");
 132
 133   SCM_SYSCALL (ptr = realloc (mem, size));
 134   if (ptr)
 135     return ptr;
 136
 137   scm_memory_error ("realloc");
 138 }
 139
 140 void *
 141 scm_malloc (size_t sz)
 142 {
 143   return scm_realloc (NULL, sz);
 144 }
 145
 146 /*
 147   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 148   SIZEOF_ELT)? --hwn
 149  */
 150 void *
 151 scm_calloc (size_t sz)
 152 {
 153   void * ptr = scm_realloc (NULL, sz);
 154   memset (ptr, 0x0, sz);
 155   return ptr;
 156 }
 157
 158
 159 char *
 160 scm_strndup (const char *str, size_t n)
 161 {
 162   char *dst = scm_malloc (n+1);
 163   memcpy (dst, str, n);
 164   dst[n] = 0;
 165   return dst;
 166 }
 167
 168 char *
 169 scm_strdup (const char *str)
 170 {
 171   return scm_strndup (str, strlen (str));
 172 }
 173
 174 void
 175 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 176 {
 177   scm_mallocated += size;
 178
 179   /*
 180     we could finish the full sweep (without mark) here, but in
 181     practice this turns out to be ineffective.
 182    */
 183
 184   /*
 185     A program that uses a lot of malloced collectable memory (vectors,
 186     strings), will use a lot of memory off the cell-heap; it needs to
 187     do GC more often (before cells are exhausted), otherwise swapping
 188     and malloc management will tie it down.
 189    */
 190   if (scm_mallocated > scm_mtrigger)
 191     {
 192       long prev_alloced  = scm_mallocated;
 193       float yield;
 194
 195       scm_igc (what);
 196       scm_i_sweep_all_segments("mtrigger");
 197
 198       yield = (prev_alloced - scm_mallocated) / (float) prev_alloced;
 199       scm_gc_malloc_yield_percentage = (int) (100  * yield);
 200       /*
 201       fprintf (stderr,  "prev %lud , now %lud, yield %4.2lf, want %d",
 202                prev_alloced, scm_mallocated, 100.0*yield, scm_i_minyield_malloc);
 203       */
 204
 205       if (yield < scm_i_minyield_malloc /  100.0)
 206         {
 207           /*
 208             We make the trigger a little larger, even; If you have a
 209             program that builds up a lot of data in strings, then the
 210             desired yield will never be satisfied.
 211
 212             Instead of getting bogged down, we let the mtrigger grow
 213             strongly with it.
 214            */
 215           scm_mtrigger = (scm_mallocated * 110) / (100 - scm_i_minyield_malloc);
 216
 217           /*
 218           fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n", scm_mtrigger);
 219           */
 220         }
 221
 222
 223     }
 224
 225 #ifdef GUILE_DEBUG_MALLOC
 226   if (mem)
 227     scm_malloc_register (mem, what);
 228 #endif
 229 }
 230
 231 void
 232 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 233 {
 234   scm_mallocated -= size;
 235   scm_gc_malloc_collected += size;
 236
 237 #ifdef GUILE_DEBUG_MALLOC
 238   if (mem)
 239     scm_malloc_unregister (mem);
 240 #endif
 241 }
 242
 243 void *
 244 scm_gc_malloc (size_t size, const char *what)
 245 {
 246   /*
 247     The straightforward implementation below has the problem
 248      that it might call the GC twice, once in scm_malloc and then
 249      again in scm_gc_register_collectable_memory.  We don't really
 250      want the second GC since it will not find new garbage.
 251
 252
 253      Note: this is a theoretical peeve. In reality, malloc() never
 254      returns NULL. Usually, memory is overcommitted, and when you try
 255      to write it the program is killed with signal 11. --hwn
 256   */
 257
 258   void *ptr = scm_malloc (size);
 259   scm_gc_register_collectable_memory (ptr, size, what);
 260   return ptr;
 261 }
 262
 263 void *
 264 scm_gc_calloc (size_t size, const char *what)
 265 {
 266   void *ptr = scm_gc_malloc (size, what);
 267   memset (ptr, 0x0, size);
 268   return ptr;
 269 }
 270
 271
 272 void *
 273 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 274 {
 275   /* XXX - see scm_gc_malloc. */
 276
 277   void *ptr = scm_realloc (mem, new_size);
 278   scm_gc_unregister_collectable_memory (mem, old_size, what);
 279   scm_gc_register_collectable_memory (ptr, new_size, what);
 280   return ptr;
 281 }
 282
 283 void
 284 scm_gc_free (void *mem, size_t size, const char *what)
 285 {
 286   scm_gc_unregister_collectable_memory (mem, size, what);
 287   free (mem);
 288 }
 289
 290 char *
 291 scm_gc_strndup (const char *str, size_t n, const char *what)
 292 {
 293   char *dst = scm_gc_malloc (n+1, what);
 294   memcpy (dst, str, n);
 295   dst[n] = 0;
 296   return dst;
 297 }
 298
 299 char *
 300 scm_gc_strdup (const char *str, const char *what)
 301 {
 302   return scm_gc_strndup (str, strlen (str), what);
 303 }
 304
 305 #if SCM_ENABLE_DEPRECATED == 1
 306
 307 /* {Deprecated front end to malloc}
 308  *
 309  * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc,
 310  * scm_done_free
 311  *
 312  * These functions provide services comparable to malloc, realloc, and
 313  * free.  They should be used when allocating memory that will be under
 314  * control of the garbage collector, i.e., if the memory may be freed
 315  * during garbage collection.
 316  *
 317  * They are deprecated because they weren't really used the way
 318  * outlined above, and making sure to return the right amount from
 319  * smob free routines was sometimes difficult when dealing with nested
 320  * data structures.  We basically want everybody to review their code
 321  * and use the more symmetrical scm_gc_malloc/scm_gc_free functions
 322  * instead.  In some cases, where scm_must_malloc has been used
 323  * incorrectly (i.e. for non-GC-able memory), use scm_malloc/free.
 324  */
 325
 326 void *
 327 scm_must_malloc (size_t size, const char *what)
 328 {
 329   scm_c_issue_deprecation_warning
 330     ("scm_must_malloc is deprecated.  "
 331      "Use scm_gc_malloc and scm_gc_free instead.");
 332
 333   return scm_gc_malloc (size, what);
 334 }
 335
 336 void *
 337 scm_must_realloc (void *where,
 338                   size_t old_size,
 339                   size_t size,
 340                   const char *what)
 341 {
 342   scm_c_issue_deprecation_warning
 343     ("scm_must_realloc is deprecated.  "
 344      "Use scm_gc_realloc and scm_gc_free instead.");
 345
 346   return scm_gc_realloc (where, old_size, size, what);
 347 }
 348
 349 char *
 350 scm_must_strndup (const char *str, size_t length)
 351 {
 352   scm_c_issue_deprecation_warning
 353     ("scm_must_strndup is deprecated.  "
 354      "Use scm_gc_strndup and scm_gc_free instead.");
 355
 356   return scm_gc_strndup (str, length, "string");
 357 }
 358
 359 char *
 360 scm_must_strdup (const char *str)
 361 {
 362   scm_c_issue_deprecation_warning
 363     ("scm_must_strdup is deprecated.  "
 364      "Use scm_gc_strdup and scm_gc_free instead.");
 365
 366   return scm_gc_strdup (str, "string");
 367 }
 368
 369 void
 370 scm_must_free (void *obj)
 371 #define FUNC_NAME "scm_must_free"
 372 {
 373   scm_c_issue_deprecation_warning
 374     ("scm_must_free is deprecated.  "
 375      "Use scm_gc_malloc and scm_gc_free instead.");
 376
 377 #ifdef GUILE_DEBUG_MALLOC
 378   scm_malloc_unregister (obj);
 379 #endif
 380   if (obj)
 381     free (obj);
 382   else
 383     {
 384       fprintf (stderr,"freeing NULL pointer");
 385       abort ();
 386     }
 387 }
 388 #undef FUNC_NAME
 389
 390
 391 void
 392 scm_done_malloc (long size)
 393 {
 394   scm_c_issue_deprecation_warning
 395     ("scm_done_malloc is deprecated.  "
 396      "Use scm_gc_register_collectable_memory instead.");
 397
 398   scm_gc_register_collectable_memory (NULL, size, "foreign mallocs");
 399 }
 400
 401 void
 402 scm_done_free (long size)
 403 {
 404   scm_c_issue_deprecation_warning
 405     ("scm_done_free is deprecated.  "
 406      "Use scm_gc_unregister_collectable_memory instead.");
 407
 408   scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs");
 409 }
 410
 411 #endif /* SCM_ENABLE_DEPRECATED == 1 */