libguile/gc-malloc.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library 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 GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18
  19 \f
  20 #if HAVE_CONFIG_H
  21 #  include <config.h>
  22 #endif
  23
  24 #include <stdio.h>
  25 #include <errno.h>
  26 #include <string.h>
  27
  28 #ifdef __ia64__
  29 #include <ucontext.h>
  30 extern unsigned long * __libc_ia64_register_backing_store_base;
  31 #endif
  32
  33 #include "libguile/_scm.h"
  34 #include "libguile/eval.h"
  35 #include "libguile/stime.h"
  36 #include "libguile/stackchk.h"
  37 #include "libguile/struct.h"
  38 #include "libguile/smob.h"
  39 #include "libguile/unif.h"
  40 #include "libguile/async.h"
  41 #include "libguile/ports.h"
  42 #include "libguile/root.h"
  43 #include "libguile/strings.h"
  44 #include "libguile/vectors.h"
  45 #include "libguile/weaks.h"
  46 #include "libguile/hashtab.h"
  47 #include "libguile/tags.h"
  48
  49 #include "libguile/validate.h"
  50 #include "libguile/deprecation.h"
  51 #include "libguile/gc.h"
  52
  53 #include "libguile/private-gc.h"
  54
  55 #ifdef GUILE_DEBUG_MALLOC
  56 #include "libguile/debug-malloc.h"
  57 #endif
  58
  59 #ifdef HAVE_MALLOC_H
  60 #include <malloc.h>
  61 #endif
  62
  63 #ifdef HAVE_UNISTD_H
  64 #include <unistd.h>
  65 #endif
  66
  67 /*
  68   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
  69   trigger a GC.
  70
  71   After startup (at the guile> prompt), we have approximately 100k of
  72   alloced memory, which won't go away on GC. Let's set the init such
  73   that we get a nice yield on the next allocation:
  74 */
  75 #define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024
  76 #define SCM_DEFAULT_MALLOC_MINYIELD 40
  77
  78 /* #define DEBUGINFO */
  79
  80 static int scm_i_minyield_malloc;
  81
  82 void
  83 scm_gc_init_malloc (void)
  84 {
  85   scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
  86                                  SCM_DEFAULT_INIT_MALLOC_LIMIT);
  87   scm_i_minyield_malloc =  scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
  88                                            SCM_DEFAULT_MALLOC_MINYIELD);
  89
  90   if (scm_i_minyield_malloc >= 100)
  91     scm_i_minyield_malloc = 99;
  92   if (scm_i_minyield_malloc < 1)
  93     scm_i_minyield_malloc = 1;
  94
  95   if (scm_mtrigger < 0)
  96     scm_mtrigger = SCM_DEFAULT_INIT_MALLOC_LIMIT;
  97 }
  98
  99
 100 \f
 101 /* Function for non-cell memory management.
 102  */
 103
 104 void *
 105 scm_realloc (void *mem, size_t size)
 106 {
 107   void *ptr;
 108
 109   SCM_SYSCALL (ptr = realloc (mem, size));
 110   if (ptr)
 111     return ptr;
 112
 113   /* Time is hard: trigger a full, ``stop-the-world'' GC, and try again.  */
 114   GC_gcollect ();
 115
 116   SCM_SYSCALL (ptr = realloc (mem, size));
 117   if (ptr)
 118     return ptr;
 119
 120   scm_memory_error ("realloc");
 121 }
 122
 123 void *
 124 scm_malloc (size_t sz)
 125 {
 126   return scm_realloc (NULL, sz);
 127 }
 128
 129 /*
 130   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 131   SIZEOF_ELT)? --hwn
 132  */
 133 void *
 134 scm_calloc (size_t sz)
 135 {
 136   void * ptr;
 137
 138   /*
 139     By default, try to use calloc, as it is likely more efficient than
 140     calling memset by hand.
 141    */
 142   SCM_SYSCALL (ptr = calloc (sz, 1));
 143   if (ptr)
 144     return ptr;
 145
 146   ptr = scm_realloc (NULL, sz);
 147   memset (ptr, 0x0, sz);
 148   return ptr;
 149 }
 150
 151
 152 char *
 153 scm_strndup (const char *str, size_t n)
 154 {
 155   char *dst = scm_malloc (n + 1);
 156   memcpy (dst, str, n);
 157   dst[n] = 0;
 158   return dst;
 159 }
 160
 161 char *
 162 scm_strdup (const char *str)
 163 {
 164   return scm_strndup (str, strlen (str));
 165 }
 166
 167
 168
 169 void
 170 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 171 {
 172   /* Nothing to do.  */
 173 #ifdef GUILE_DEBUG_MALLOC
 174   if (mem)
 175     scm_malloc_register (mem);
 176 #endif
 177 }
 178
 179
 180 void
 181 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 182 {
 183   /* Nothing to do.  */
 184 #ifdef GUILE_DEBUG_MALLOC
 185   if (mem)
 186     scm_malloc_unregister (mem);
 187 #endif
 188 }
 189
 190 /* Allocate SIZE bytes of memory whose contents should not be scanned for
 191    pointers (useful, e.g., for strings).  */
 192 void *
 193 scm_gc_malloc_pointerless (size_t size, const char *what)
 194 {
 195   return GC_MALLOC_ATOMIC (size);
 196 }
 197
 198 void *
 199 scm_gc_malloc (size_t size, const char *what)
 200 {
 201   /*
 202     The straightforward implementation below has the problem
 203      that it might call the GC twice, once in scm_malloc and then
 204      again in scm_gc_register_collectable_memory.  We don't really
 205      want the second GC since it will not find new garbage.
 206
 207      Note: this is a theoretical peeve. In reality, malloc() never
 208      returns NULL. Usually, memory is overcommitted, and when you try
 209      to write it the program is killed with signal 11. --hwn
 210   */
 211
 212   void *ptr = GC_MALLOC (size);
 213   return ptr;
 214 }
 215
 216 void *
 217 scm_gc_calloc (size_t size, const char *what)
 218 {
 219   void *ptr = scm_gc_malloc (size, what);
 220   memset (ptr, 0x0, size);
 221   return ptr;
 222 }
 223
 224
 225 void *
 226 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 227 {
 228   void *ptr;
 229
 230   ptr = GC_REALLOC (mem, new_size);
 231
 232 #ifdef GUILE_DEBUG_MALLOC
 233   if (mem)
 234     scm_malloc_reregister (mem, ptr, what);
 235 #endif
 236
 237   return ptr;
 238 }
 239
 240 void
 241 scm_gc_free (void *mem, size_t size, const char *what)
 242 {
 243   scm_gc_unregister_collectable_memory (mem, size, what);
 244   GC_FREE (mem);
 245 }
 246
 247 char *
 248 scm_gc_strndup (const char *str, size_t n, const char *what)
 249 {
 250   char *dst = GC_MALLOC (n+1);
 251   memcpy (dst, str, n);
 252   dst[n] = 0;
 253   return dst;
 254 }
 255
 256 char *
 257 scm_gc_strdup (const char *str, const char *what)
 258 {
 259   return scm_gc_strndup (str, strlen (str), what);
 260 }
 261
 262 #if SCM_ENABLE_DEPRECATED == 1
 263
 264 /* {Deprecated front end to malloc}
 265  *
 266  * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc,
 267  * scm_done_free
 268  *
 269  * These functions provide services comparable to malloc, realloc, and
 270  * free.  They should be used when allocating memory that will be under
 271  * control of the garbage collector, i.e., if the memory may be freed
 272  * during garbage collection.
 273  *
 274  * They are deprecated because they weren't really used the way
 275  * outlined above, and making sure to return the right amount from
 276  * smob free routines was sometimes difficult when dealing with nested
 277  * data structures.  We basically want everybody to review their code
 278  * and use the more symmetrical scm_gc_malloc/scm_gc_free functions
 279  * instead.  In some cases, where scm_must_malloc has been used
 280  * incorrectly (i.e. for non-GC-able memory), use scm_malloc/free.
 281  */
 282
 283 void *
 284 scm_must_malloc (size_t size, const char *what)
 285 {
 286   scm_c_issue_deprecation_warning
 287     ("scm_must_malloc is deprecated.  "
 288      "Use scm_gc_malloc and scm_gc_free instead.");
 289
 290   return scm_gc_malloc (size, what);
 291 }
 292
 293 void *
 294 scm_must_realloc (void *where,
 295                   size_t old_size,
 296                   size_t size,
 297                   const char *what)
 298 {
 299   scm_c_issue_deprecation_warning
 300     ("scm_must_realloc is deprecated.  "
 301      "Use scm_gc_realloc and scm_gc_free instead.");
 302
 303   return scm_gc_realloc (where, old_size, size, what);
 304 }
 305
 306 char *
 307 scm_must_strndup (const char *str, size_t length)
 308 {
 309   scm_c_issue_deprecation_warning
 310     ("scm_must_strndup is deprecated.  "
 311      "Use scm_gc_strndup and scm_gc_free instead.");
 312
 313   return scm_gc_strndup (str, length, "string");
 314 }
 315
 316 char *
 317 scm_must_strdup (const char *str)
 318 {
 319   scm_c_issue_deprecation_warning
 320     ("scm_must_strdup is deprecated.  "
 321      "Use scm_gc_strdup and scm_gc_free instead.");
 322
 323   return scm_gc_strdup (str, "string");
 324 }
 325
 326 void
 327 scm_must_free (void *obj)
 328 #define FUNC_NAME "scm_must_free"
 329 {
 330   scm_c_issue_deprecation_warning
 331     ("scm_must_free is deprecated.  "
 332      "Use scm_gc_malloc and scm_gc_free instead.");
 333
 334 #ifdef GUILE_DEBUG_MALLOC
 335   scm_malloc_unregister (obj);
 336 #endif
 337   if (obj)
 338     free (obj);
 339   else
 340     {
 341       fprintf (stderr,"freeing NULL pointer");
 342       abort ();
 343     }
 344 }
 345 #undef FUNC_NAME
 346
 347
 348 void
 349 scm_done_malloc (long size)
 350 {
 351   scm_c_issue_deprecation_warning
 352     ("scm_done_malloc is deprecated.  "
 353      "Use scm_gc_register_collectable_memory instead.");
 354
 355   if (size >= 0)
 356     scm_gc_register_collectable_memory (NULL, size, "foreign mallocs");
 357   else
 358     scm_gc_unregister_collectable_memory (NULL, -size, "foreign mallocs");
 359 }
 360
 361 void
 362 scm_done_free (long size)
 363 {
 364   scm_c_issue_deprecation_warning
 365     ("scm_done_free is deprecated.  "
 366      "Use scm_gc_unregister_collectable_memory instead.");
 367
 368   if (size >= 0)
 369     scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs");
 370   else
 371     scm_gc_register_collectable_memory (NULL, -size, "foreign mallocs");
 372 }
 373
 374 #endif /* SCM_ENABLE_DEPRECATED == 1 */