libguile/gc-malloc.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 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/arrays.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
  82 \f
  83 /* Function for non-cell memory management.
  84  */
  85
  86 void *
  87 scm_realloc (void *mem, size_t size)
  88 {
  89   void *ptr;
  90
  91   SCM_SYSCALL (ptr = realloc (mem, size));
  92   if (ptr)
  93     return ptr;
  94
  95   /* Time is hard: trigger a full, ``stop-the-world'' GC, and try again.  */
  96   GC_gcollect ();
  97
  98   SCM_SYSCALL (ptr = realloc (mem, size));
  99   if (ptr)
 100     return ptr;
 101
 102   scm_memory_error ("realloc");
 103 }
 104
 105 void *
 106 scm_malloc (size_t sz)
 107 {
 108   return scm_realloc (NULL, sz);
 109 }
 110
 111 /*
 112   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 113   SIZEOF_ELT)? --hwn
 114  */
 115 void *
 116 scm_calloc (size_t sz)
 117 {
 118   void * ptr;
 119
 120   /*
 121     By default, try to use calloc, as it is likely more efficient than
 122     calling memset by hand.
 123    */
 124   SCM_SYSCALL (ptr = calloc (sz, 1));
 125   if (ptr)
 126     return ptr;
 127
 128   ptr = scm_realloc (NULL, sz);
 129   memset (ptr, 0x0, sz);
 130   return ptr;
 131 }
 132
 133
 134 char *
 135 scm_strndup (const char *str, size_t n)
 136 {
 137   char *dst = scm_malloc (n + 1);
 138   memcpy (dst, str, n);
 139   dst[n] = 0;
 140   return dst;
 141 }
 142
 143 char *
 144 scm_strdup (const char *str)
 145 {
 146   return scm_strndup (str, strlen (str));
 147 }
 148
 149
 150
 151 void
 152 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 153 {
 154   /* Nothing to do.  */
 155 #ifdef GUILE_DEBUG_MALLOC
 156   if (mem)
 157     scm_malloc_register (mem);
 158 #endif
 159 }
 160
 161
 162 void
 163 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 164 {
 165   /* Nothing to do.  */
 166 #ifdef GUILE_DEBUG_MALLOC
 167   if (mem)
 168     scm_malloc_unregister (mem);
 169 #endif
 170 }
 171
 172 /* Allocate SIZE bytes of memory whose contents should not be scanned for
 173    pointers (useful, e.g., for strings).  */
 174 void *
 175 scm_gc_malloc_pointerless (size_t size, const char *what)
 176 {
 177   return GC_MALLOC_ATOMIC (size);
 178 }
 179
 180 void *
 181 scm_gc_malloc (size_t size, const char *what)
 182 {
 183   /*
 184     The straightforward implementation below has the problem
 185      that it might call the GC twice, once in scm_malloc and then
 186      again in scm_gc_register_collectable_memory.  We don't really
 187      want the second GC since it will not find new garbage.
 188
 189      Note: this is a theoretical peeve. In reality, malloc () never
 190      returns NULL. Usually, memory is overcommitted, and when you try
 191      to write it the program is killed with signal 11. --hwn
 192   */
 193
 194   void *ptr;
 195
 196   if (size == 0)
 197     /* `GC_MALLOC ()' doesn't handle zero.  */
 198     size = sizeof (void *);
 199
 200   ptr = GC_MALLOC (size);
 201
 202   return ptr;
 203 }
 204
 205 void *
 206 scm_gc_calloc (size_t size, const char *what)
 207 {
 208   void *ptr = scm_gc_malloc (size, what);
 209   memset (ptr, 0x0, size);
 210   return ptr;
 211 }
 212
 213
 214 void *
 215 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 216 {
 217   void *ptr;
 218
 219   ptr = GC_REALLOC (mem, new_size);
 220
 221 #ifdef GUILE_DEBUG_MALLOC
 222   if (mem)
 223     scm_malloc_reregister (mem, ptr, what);
 224 #endif
 225
 226   return ptr;
 227 }
 228
 229 void
 230 scm_gc_free (void *mem, size_t size, const char *what)
 231 {
 232   scm_gc_unregister_collectable_memory (mem, size, what);
 233   GC_FREE (mem);
 234 }
 235
 236 char *
 237 scm_gc_strndup (const char *str, size_t n, const char *what)
 238 {
 239   char *dst = GC_MALLOC (n+1);
 240   memcpy (dst, str, n);
 241   dst[n] = 0;
 242   return dst;
 243 }
 244
 245 char *
 246 scm_gc_strdup (const char *str, const char *what)
 247 {
 248   return scm_gc_strndup (str, strlen (str), what);
 249 }
 250
 251 #if SCM_ENABLE_DEPRECATED == 1
 252
 253 /* {Deprecated front end to malloc}
 254  *
 255  * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc,
 256  * scm_done_free
 257  *
 258  * These functions provide services comparable to malloc, realloc, and
 259  * free.  They should be used when allocating memory that will be under
 260  * control of the garbage collector, i.e., if the memory may be freed
 261  * during garbage collection.
 262  *
 263  * They are deprecated because they weren't really used the way
 264  * outlined above, and making sure to return the right amount from
 265  * smob free routines was sometimes difficult when dealing with nested
 266  * data structures.  We basically want everybody to review their code
 267  * and use the more symmetrical scm_gc_malloc/scm_gc_free functions
 268  * instead.  In some cases, where scm_must_malloc has been used
 269  * incorrectly (i.e. for non-GC-able memory), use scm_malloc/free.
 270  */
 271
 272 void *
 273 scm_must_malloc (size_t size, const char *what)
 274 {
 275   scm_c_issue_deprecation_warning
 276     ("scm_must_malloc is deprecated.  "
 277      "Use scm_gc_malloc and scm_gc_free instead.");
 278
 279   return scm_gc_malloc (size, what);
 280 }
 281
 282 void *
 283 scm_must_realloc (void *where,
 284                   size_t old_size,
 285                   size_t size,
 286                   const char *what)
 287 {
 288   scm_c_issue_deprecation_warning
 289     ("scm_must_realloc is deprecated.  "
 290      "Use scm_gc_realloc and scm_gc_free instead.");
 291
 292   return scm_gc_realloc (where, old_size, size, what);
 293 }
 294
 295 char *
 296 scm_must_strndup (const char *str, size_t length)
 297 {
 298   scm_c_issue_deprecation_warning
 299     ("scm_must_strndup is deprecated.  "
 300      "Use scm_gc_strndup and scm_gc_free instead.");
 301
 302   return scm_gc_strndup (str, length, "string");
 303 }
 304
 305 char *
 306 scm_must_strdup (const char *str)
 307 {
 308   scm_c_issue_deprecation_warning
 309     ("scm_must_strdup is deprecated.  "
 310      "Use scm_gc_strdup and scm_gc_free instead.");
 311
 312   return scm_gc_strdup (str, "string");
 313 }
 314
 315 void
 316 scm_must_free (void *obj)
 317 #define FUNC_NAME "scm_must_free"
 318 {
 319   scm_c_issue_deprecation_warning
 320     ("scm_must_free is deprecated.  "
 321      "Use scm_gc_malloc and scm_gc_free instead.");
 322
 323 #ifdef GUILE_DEBUG_MALLOC
 324   scm_malloc_unregister (obj);
 325 #endif
 326   if (obj)
 327     free (obj);
 328   else
 329     {
 330       fprintf (stderr,"freeing NULL pointer");
 331       abort ();
 332     }
 333 }
 334 #undef FUNC_NAME
 335
 336
 337 void
 338 scm_done_malloc (long size)
 339 {
 340   scm_c_issue_deprecation_warning
 341     ("scm_done_malloc is deprecated.  "
 342      "Use scm_gc_register_collectable_memory instead.");
 343
 344   if (size >= 0)
 345     scm_gc_register_collectable_memory (NULL, size, "foreign mallocs");
 346   else
 347     scm_gc_unregister_collectable_memory (NULL, -size, "foreign mallocs");
 348 }
 349
 350 void
 351 scm_done_free (long size)
 352 {
 353   scm_c_issue_deprecation_warning
 354     ("scm_done_free is deprecated.  "
 355      "Use scm_gc_unregister_collectable_memory instead.");
 356
 357   if (size >= 0)
 358     scm_gc_unregister_collectable_memory (NULL, size, "foreign mallocs");
 359   else
 360     scm_gc_register_collectable_memory (NULL, -size, "foreign mallocs");
 361 }
 362
 363 #endif /* SCM_ENABLE_DEPRECATED == 1 */