libguile/gc-malloc.c

   1 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   2  *   2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
   3  *
   4  * This library is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU Lesser General Public License
   6  * as published by the Free Software Foundation; either version 3 of
   7  * the License, or (at your option) any later version.
   8  *
   9  * This library is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * Lesser General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU Lesser General Public
  15  * License along with this library; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  17  * 02110-1301 USA
  18  */
  19
  20
  21 \f
  22 #ifdef HAVE_CONFIG_H
  23 #  include <config.h>
  24 #endif
  25
  26 #include <stdio.h>
  27 #include <errno.h>
  28 #include <string.h>
  29
  30 #ifdef __ia64__
  31 #include <ucontext.h>
  32 extern unsigned long * __libc_ia64_register_backing_store_base;
  33 #endif
  34
  35 #include "libguile/_scm.h"
  36 #include "libguile/eval.h"
  37 #include "libguile/stime.h"
  38 #include "libguile/stackchk.h"
  39 #include "libguile/struct.h"
  40 #include "libguile/smob.h"
  41 #include "libguile/arrays.h"
  42 #include "libguile/async.h"
  43 #include "libguile/ports.h"
  44 #include "libguile/root.h"
  45 #include "libguile/strings.h"
  46 #include "libguile/vectors.h"
  47 #include "libguile/weaks.h"
  48 #include "libguile/hashtab.h"
  49 #include "libguile/tags.h"
  50
  51 #include "libguile/validate.h"
  52 #include "libguile/deprecation.h"
  53 #include "libguile/gc.h"
  54
  55 #include "libguile/private-gc.h"
  56
  57 #ifdef GUILE_DEBUG_MALLOC
  58 #include "libguile/debug-malloc.h"
  59 #endif
  60
  61 #ifdef HAVE_MALLOC_H
  62 #include <malloc.h>
  63 #endif
  64
  65 #ifdef HAVE_UNISTD_H
  66 #include <unistd.h>
  67 #endif
  68
  69 /*
  70   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
  71   trigger a GC.
  72
  73   After startup (at the guile> prompt), we have approximately 100k of
  74   alloced memory, which won't go away on GC. Let's set the init such
  75   that we get a nice yield on the next allocation:
  76 */
  77 #define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024
  78 #define SCM_DEFAULT_MALLOC_MINYIELD 40
  79
  80 /* #define DEBUGINFO */
  81
  82
  83 \f
  84 /* Function for non-cell memory management.
  85  */
  86
  87 void *
  88 scm_realloc (void *mem, size_t size)
  89 {
  90   void *ptr;
  91
  92   scm_gc_register_allocation (size);
  93
  94   SCM_SYSCALL (ptr = realloc (mem, size));
  95   if (ptr)
  96     return ptr;
  97
  98   /* Time is hard: trigger a full, ``stop-the-world'' GC, and try again.  */
  99 #ifdef HAVE_GC_GCOLLECT_AND_UNMAP
 100   GC_gcollect_and_unmap ();
 101 #else
 102   GC_gcollect ();
 103 #endif
 104
 105   SCM_SYSCALL (ptr = realloc (mem, size));
 106   if (ptr)
 107     return ptr;
 108
 109   scm_memory_error ("realloc");
 110 }
 111
 112 void *
 113 scm_malloc (size_t sz)
 114 {
 115   return scm_realloc (NULL, sz);
 116 }
 117
 118 /*
 119   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 120   SIZEOF_ELT)? --hwn
 121  */
 122 void *
 123 scm_calloc (size_t sz)
 124 {
 125   void * ptr;
 126
 127   /*
 128     By default, try to use calloc, as it is likely more efficient than
 129     calling memset by hand.
 130    */
 131   SCM_SYSCALL (ptr = calloc (sz, 1));
 132   if (ptr)
 133     return ptr;
 134
 135   ptr = scm_realloc (NULL, sz);
 136   memset (ptr, 0x0, sz);
 137   return ptr;
 138 }
 139
 140
 141 char *
 142 scm_strndup (const char *str, size_t n)
 143 {
 144   char *dst = scm_malloc (n + 1);
 145   memcpy (dst, str, n);
 146   dst[n] = 0;
 147   return dst;
 148 }
 149
 150 char *
 151 scm_strdup (const char *str)
 152 {
 153   return scm_strndup (str, strlen (str));
 154 }
 155
 156
 157
 158 void
 159 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 160 {
 161   scm_gc_register_allocation (size);
 162
 163 #ifdef GUILE_DEBUG_MALLOC
 164   if (mem)
 165     scm_malloc_register (mem, what);
 166 #endif
 167 }
 168
 169
 170 void
 171 scm_gc_unregister_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_unregister (mem);
 177 #endif
 178 }
 179
 180 /* Allocate SIZE bytes of memory whose contents should not be scanned
 181    for pointers (useful, e.g., for strings).  Note though that this
 182    memory is *not* cleared; be sure to initialize it to prevent
 183    information leaks.  */
 184 void *
 185 scm_gc_malloc_pointerless (size_t size, const char *what)
 186 {
 187   return GC_MALLOC_ATOMIC (size);
 188 }
 189
 190 void *
 191 scm_gc_malloc (size_t size, const char *what)
 192 {
 193   void *ptr;
 194
 195   if (size == 0)
 196     /* `GC_MALLOC ()' doesn't handle zero.  */
 197     size = sizeof (void *);
 198
 199   ptr = GC_MALLOC (size);
 200
 201   return ptr;
 202 }
 203
 204 void *
 205 scm_gc_calloc (size_t size, const char *what)
 206 {
 207   /* `GC_MALLOC ()' always returns a zeroed buffer.  */
 208   return scm_gc_malloc (size, what);
 209 }
 210
 211
 212 void *
 213 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 214 {
 215   void *ptr;
 216
 217   ptr = GC_REALLOC (mem, new_size);
 218
 219 #ifdef GUILE_DEBUG_MALLOC
 220   if (mem)
 221     scm_malloc_reregister (mem, ptr, what);
 222 #endif
 223
 224   return ptr;
 225 }
 226
 227 void
 228 scm_gc_free (void *mem, size_t size, const char *what)
 229 {
 230   scm_gc_unregister_collectable_memory (mem, size, what);
 231   GC_FREE (mem);
 232 }
 233
 234 char *
 235 scm_gc_strndup (const char *str, size_t n, const char *what)
 236 {
 237   char *dst = GC_MALLOC_ATOMIC (n + 1);
 238   memcpy (dst, str, n);
 239   dst[n] = 0;
 240   return dst;
 241 }
 242
 243 char *
 244 scm_gc_strdup (const char *str, const char *what)
 245 {
 246   return scm_gc_strndup (str, strlen (str), what);
 247 }
 248
 249 #if SCM_ENABLE_DEPRECATED == 1
 250
 251 /* {Deprecated front end to malloc}
 252  *
 253  * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc,
 254  * scm_done_free
 255  *
 256  * These functions provide services comparable to malloc, realloc, and
 257  * free.
 258  *
 259  * There has been a fair amount of confusion around the use of these functions;
 260  * see "Memory Blocks" in the manual. They are totally unnecessary in 2.0 given
 261  * the Boehm GC.
 262  */
 263
 264 void *
 265 scm_must_malloc (size_t size, const char *what)
 266 {
 267   scm_c_issue_deprecation_warning
 268     ("scm_must_malloc is deprecated.  "
 269      "Use scm_gc_malloc and scm_gc_free instead.");
 270
 271   return scm_gc_malloc (size, what);
 272 }
 273
 274 void *
 275 scm_must_realloc (void *where,
 276                   size_t old_size,
 277                   size_t size,
 278                   const char *what)
 279 {
 280   scm_c_issue_deprecation_warning
 281     ("scm_must_realloc is deprecated.  "
 282      "Use scm_gc_realloc and scm_gc_free instead.");
 283
 284   return scm_gc_realloc (where, old_size, size, what);
 285 }
 286
 287 char *
 288 scm_must_strndup (const char *str, size_t length)
 289 {
 290   scm_c_issue_deprecation_warning
 291     ("scm_must_strndup is deprecated.  "
 292      "Use scm_gc_strndup and scm_gc_free instead.");
 293
 294   return scm_gc_strndup (str, length, "string");
 295 }
 296
 297 char *
 298 scm_must_strdup (const char *str)
 299 {
 300   scm_c_issue_deprecation_warning
 301     ("scm_must_strdup is deprecated.  "
 302      "Use scm_gc_strdup and scm_gc_free instead.");
 303
 304   return scm_gc_strdup (str, "string");
 305 }
 306
 307 void
 308 scm_must_free (void *obj)
 309 #define FUNC_NAME "scm_must_free"
 310 {
 311   scm_c_issue_deprecation_warning
 312     ("scm_must_free is deprecated.  "
 313      "Use scm_gc_malloc and scm_gc_free instead.");
 314
 315 #ifdef GUILE_DEBUG_MALLOC
 316   scm_malloc_unregister (obj);
 317 #endif
 318
 319   GC_FREE (obj);
 320 }
 321 #undef FUNC_NAME
 322
 323
 324 void
 325 scm_done_malloc (long size)
 326 {
 327   scm_c_issue_deprecation_warning
 328     ("scm_done_malloc is deprecated.  "
 329      "Use scm_gc_register_collectable_memory instead.");
 330
 331   if (size >= 0)
 332     scm_gc_register_collectable_memory (NULL, size, "foreign mallocs");
 333   else
 334     scm_gc_unregister_collectable_memory (NULL, -size, "foreign mallocs");
 335 }
 336
 337 void
 338 scm_done_free (long size)
 339 {
 340   scm_c_issue_deprecation_warning
 341     ("scm_done_free is deprecated.  "
 342      "Use scm_gc_unregister_collectable_memory instead.");
 343
 344   if (size >= 0)
 345     scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs");
 346   else
 347     scm_gc_register_collectable_memory (NULL, -size, "foreign mallocs");
 348 }
 349
 350 #endif /* SCM_ENABLE_DEPRECATED == 1 */