libguile/gc-malloc.c

   1 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
   2  *   2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013,
   3  *   2014 Free Software Foundation, Inc.
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public License
   7  * as published by the Free Software Foundation; either version 3 of
   8  * the License, or (at your option) any later version.
   9  *
  10  * This library is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18  * 02110-1301 USA
  19  */
  20
  21
  22 \f
  23 #ifdef HAVE_CONFIG_H
  24 #  include <config.h>
  25 #endif
  26
  27 #include <stdio.h>
  28 #include <errno.h>
  29 #include <string.h>
  30 #include <stdlib.h>
  31
  32 #ifdef __ia64__
  33 #include <ucontext.h>
  34 extern unsigned long * __libc_ia64_register_backing_store_base;
  35 #endif
  36
  37 #include "libguile/_scm.h"
  38 #include "libguile/eval.h"
  39 #include "libguile/stime.h"
  40 #include "libguile/stackchk.h"
  41 #include "libguile/struct.h"
  42 #include "libguile/smob.h"
  43 #include "libguile/arrays.h"
  44 #include "libguile/async.h"
  45 #include "libguile/ports.h"
  46 #include "libguile/root.h"
  47 #include "libguile/strings.h"
  48 #include "libguile/vectors.h"
  49 #include "libguile/hashtab.h"
  50 #include "libguile/tags.h"
  51
  52 #include "libguile/validate.h"
  53 #include "libguile/deprecation.h"
  54 #include "libguile/gc.h"
  55
  56 #ifdef GUILE_DEBUG_MALLOC
  57 #include "libguile/debug-malloc.h"
  58 #endif
  59
  60 #include <unistd.h>
  61
  62 /*
  63   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
  64   trigger a GC.
  65
  66   After startup (at the guile> prompt), we have approximately 100k of
  67   alloced memory, which won't go away on GC. Let's set the init such
  68   that we get a nice yield on the next allocation:
  69 */
  70 #define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024
  71 #define SCM_DEFAULT_MALLOC_MINYIELD 40
  72
  73 /* #define DEBUGINFO */
  74
  75
  76 \f
  77
  78 static void*
  79 do_realloc (void *from, size_t new_size)
  80 {
  81   scm_gc_register_allocation (new_size);
  82   return realloc (from, new_size);
  83 }
  84
  85 static void*
  86 do_calloc (size_t n, size_t size)
  87 {
  88   scm_gc_register_allocation (size);
  89   return calloc (n, size);
  90 }
  91
  92 static void*
  93 do_gc_malloc (size_t size, const char *what)
  94 {
  95   /* Ensure nonzero size to be compatible with always-nonzero return of
  96      glibc malloc.  */
  97   return GC_MALLOC (size ? size : sizeof (void *));
  98 }
  99
 100 static void*
 101 do_gc_malloc_atomic (size_t size, const char *what)
 102 {
 103   return GC_MALLOC_ATOMIC (size ? size : sizeof (void *));
 104 }
 105
 106 static void*
 107 do_gc_realloc (void *from, size_t size, const char *what)
 108 {
 109   return GC_REALLOC (from, size ? size : sizeof (void *));
 110 }
 111
 112 static void
 113 do_gc_free (void *ptr)
 114 {
 115   GC_FREE (ptr);
 116 }
 117
 118
 119 \f
 120 /* Function for non-cell memory management.
 121  */
 122
 123 void *
 124 scm_realloc (void *mem, size_t size)
 125 {
 126   void *ptr;
 127
 128   ptr = do_realloc (mem, size);
 129
 130   if (ptr || size == 0)
 131     return ptr;
 132
 133   /* Time is hard: trigger a full, ``stop-the-world'' GC, and try again.  */
 134   GC_gcollect_and_unmap ();
 135
 136   ptr = do_realloc (mem, size);
 137   if (ptr)
 138     return ptr;
 139
 140   scm_report_out_of_memory ();
 141
 142   /* Not reached.  */
 143   return NULL;
 144 }
 145
 146 void *
 147 scm_malloc (size_t sz)
 148 {
 149   return scm_realloc (NULL, sz);
 150 }
 151
 152 /*
 153   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 154   SIZEOF_ELT)? --hwn
 155  */
 156 void *
 157 scm_calloc (size_t sz)
 158 {
 159   void * ptr;
 160
 161   /*
 162     By default, try to use calloc, as it is likely more efficient than
 163     calling memset by hand.
 164    */
 165   ptr = do_calloc (sz, 1);
 166   if (ptr || sz == 0)
 167     return ptr;
 168
 169   ptr = scm_realloc (NULL, sz);
 170   memset (ptr, 0x0, sz);
 171   return ptr;
 172 }
 173
 174
 175 char *
 176 scm_strndup (const char *str, size_t n)
 177 {
 178   char *dst = scm_malloc (n + 1);
 179   memcpy (dst, str, n);
 180   dst[n] = 0;
 181   return dst;
 182 }
 183
 184 char *
 185 scm_strdup (const char *str)
 186 {
 187   return scm_strndup (str, strlen (str));
 188 }
 189
 190
 191
 192 void
 193 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 194 {
 195   scm_gc_register_allocation (size);
 196
 197 #ifdef GUILE_DEBUG_MALLOC
 198   if (mem)
 199     scm_malloc_register (mem, what);
 200 #endif
 201 }
 202
 203
 204 void
 205 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 206 {
 207   /* Nothing to do.  */
 208 #ifdef GUILE_DEBUG_MALLOC
 209   if (mem)
 210     scm_malloc_unregister (mem);
 211 #endif
 212 }
 213
 214 /* Allocate SIZE bytes of memory whose contents should not be scanned
 215    for pointers (useful, e.g., for strings).  Note though that this
 216    memory is *not* cleared; be sure to initialize it to prevent
 217    information leaks.  */
 218 void *
 219 scm_gc_malloc_pointerless (size_t size, const char *what)
 220 {
 221   return do_gc_malloc_atomic (size, what);
 222 }
 223
 224 void *
 225 scm_gc_malloc (size_t size, const char *what)
 226 {
 227   return do_gc_malloc (size, what);
 228 }
 229
 230 void *
 231 scm_gc_calloc (size_t size, const char *what)
 232 {
 233   /* `GC_MALLOC ()' always returns a zeroed buffer.  */
 234   return do_gc_malloc (size, what);
 235 }
 236
 237 void *
 238 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 239 {
 240   return do_gc_realloc (mem, new_size, what);
 241 }
 242
 243 void
 244 scm_gc_free (void *mem, size_t size, const char *what)
 245 {
 246   do_gc_free (mem);
 247 }
 248
 249 char *
 250 scm_gc_strndup (const char *str, size_t n, const char *what)
 251 {
 252   char *dst = do_gc_malloc_atomic (n + 1, what);
 253   memcpy (dst, str, n);
 254   dst[n] = 0;
 255   return dst;
 256 }
 257
 258 char *
 259 scm_gc_strdup (const char *str, const char *what)
 260 {
 261   return scm_gc_strndup (str, strlen (str), what);
 262 }