libguile/gc-malloc.c

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