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 #include <stdlib.h>
  30
  31 #ifdef __ia64__
  32 #include <ucontext.h>
  33 extern unsigned long * __libc_ia64_register_backing_store_base;
  34 #endif
  35
  36 #include "libguile/_scm.h"
  37 #include "libguile/eval.h"
  38 #include "libguile/stime.h"
  39 #include "libguile/stackchk.h"
  40 #include "libguile/struct.h"
  41 #include "libguile/smob.h"
  42 #include "libguile/arrays.h"
  43 #include "libguile/async.h"
  44 #include "libguile/ports.h"
  45 #include "libguile/root.h"
  46 #include "libguile/strings.h"
  47 #include "libguile/vectors.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_UNISTD_H
  62 #include <unistd.h>
  63 #endif
  64
  65 /*
  66   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
  67   trigger a GC.
  68
  69   After startup (at the guile> prompt), we have approximately 100k of
  70   alloced memory, which won't go away on GC. Let's set the init such
  71   that we get a nice yield on the next allocation:
  72 */
  73 #define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024
  74 #define SCM_DEFAULT_MALLOC_MINYIELD 40
  75
  76 /* #define DEBUGINFO */
  77
  78
  79 \f
  80 /* Function for non-cell memory management.
  81  */
  82
  83 void *
  84 scm_realloc (void *mem, size_t size)
  85 {
  86   void *ptr;
  87
  88   scm_gc_register_allocation (size);
  89
  90   SCM_SYSCALL (ptr = realloc (mem, size));
  91   if (ptr)
  92     return ptr;
  93
  94   /* Time is hard: trigger a full, ``stop-the-world'' GC, and try again.  */
  95 #ifdef HAVE_GC_GCOLLECT_AND_UNMAP
  96   GC_gcollect_and_unmap ();
  97 #else
  98   GC_gcollect ();
  99 #endif
 100
 101   SCM_SYSCALL (ptr = realloc (mem, size));
 102   if (ptr)
 103     return ptr;
 104
 105   scm_memory_error ("realloc");
 106 }
 107
 108 void *
 109 scm_malloc (size_t sz)
 110 {
 111   return scm_realloc (NULL, sz);
 112 }
 113
 114 /*
 115   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 116   SIZEOF_ELT)? --hwn
 117  */
 118 void *
 119 scm_calloc (size_t sz)
 120 {
 121   void * ptr;
 122
 123   /*
 124     By default, try to use calloc, as it is likely more efficient than
 125     calling memset by hand.
 126    */
 127   SCM_SYSCALL (ptr = calloc (sz, 1));
 128   if (ptr)
 129     return ptr;
 130
 131   ptr = scm_realloc (NULL, sz);
 132   memset (ptr, 0x0, sz);
 133   return ptr;
 134 }
 135
 136
 137 char *
 138 scm_strndup (const char *str, size_t n)
 139 {
 140   char *dst = scm_malloc (n + 1);
 141   memcpy (dst, str, n);
 142   dst[n] = 0;
 143   return dst;
 144 }
 145
 146 char *
 147 scm_strdup (const char *str)
 148 {
 149   return scm_strndup (str, strlen (str));
 150 }
 151
 152
 153
 154 void
 155 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 156 {
 157   scm_gc_register_allocation (size);
 158
 159 #ifdef GUILE_DEBUG_MALLOC
 160   if (mem)
 161     scm_malloc_register (mem, what);
 162 #endif
 163 }
 164
 165
 166 void
 167 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 168 {
 169   /* Nothing to do.  */
 170 #ifdef GUILE_DEBUG_MALLOC
 171   if (mem)
 172     scm_malloc_unregister (mem);
 173 #endif
 174 }
 175
 176 /* Allocate SIZE bytes of memory whose contents should not be scanned
 177    for pointers (useful, e.g., for strings).  Note though that this
 178    memory is *not* cleared; be sure to initialize it to prevent
 179    information leaks.  */
 180 void *
 181 scm_gc_malloc_pointerless (size_t size, const char *what)
 182 {
 183   return GC_MALLOC_ATOMIC (size);
 184 }
 185
 186 void *
 187 scm_gc_malloc (size_t size, const char *what)
 188 {
 189   void *ptr;
 190
 191   if (size == 0)
 192     /* `GC_MALLOC ()' doesn't handle zero.  */
 193     size = sizeof (void *);
 194
 195   ptr = GC_MALLOC (size);
 196
 197   return ptr;
 198 }
 199
 200 void *
 201 scm_gc_calloc (size_t size, const char *what)
 202 {
 203   /* `GC_MALLOC ()' always returns a zeroed buffer.  */
 204   return scm_gc_malloc (size, what);
 205 }
 206
 207
 208 void *
 209 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 210 {
 211   void *ptr;
 212
 213   ptr = GC_REALLOC (mem, new_size);
 214
 215 #ifdef GUILE_DEBUG_MALLOC
 216   if (mem)
 217     scm_malloc_reregister (mem, ptr, what);
 218 #endif
 219
 220   return ptr;
 221 }
 222
 223 void
 224 scm_gc_free (void *mem, size_t size, const char *what)
 225 {
 226   scm_gc_unregister_collectable_memory (mem, size, what);
 227   GC_FREE (mem);
 228 }
 229
 230 char *
 231 scm_gc_strndup (const char *str, size_t n, const char *what)
 232 {
 233   char *dst = GC_MALLOC_ATOMIC (n + 1);
 234   memcpy (dst, str, n);
 235   dst[n] = 0;
 236   return dst;
 237 }
 238
 239 char *
 240 scm_gc_strdup (const char *str, const char *what)
 241 {
 242   return scm_gc_strndup (str, strlen (str), what);
 243 }