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/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_gc_register_allocation (size);
  92
  93   SCM_SYSCALL (ptr = realloc (mem, size));
  94   if (ptr)
  95     return ptr;
  96
  97   /* Time is hard: trigger a full, ``stop-the-world'' GC, and try again.  */
  98   GC_gcollect_and_unmap ();
  99
 100   SCM_SYSCALL (ptr = realloc (mem, size));
 101   if (ptr)
 102     return ptr;
 103
 104   scm_memory_error ("realloc");
 105 }
 106
 107 void *
 108 scm_malloc (size_t sz)
 109 {
 110   return scm_realloc (NULL, sz);
 111 }
 112
 113 /*
 114   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 115   SIZEOF_ELT)? --hwn
 116  */
 117 void *
 118 scm_calloc (size_t sz)
 119 {
 120   void * ptr;
 121
 122   /*
 123     By default, try to use calloc, as it is likely more efficient than
 124     calling memset by hand.
 125    */
 126   SCM_SYSCALL (ptr = calloc (sz, 1));
 127   if (ptr)
 128     return ptr;
 129
 130   ptr = scm_realloc (NULL, sz);
 131   memset (ptr, 0x0, sz);
 132   return ptr;
 133 }
 134
 135
 136 char *
 137 scm_strndup (const char *str, size_t n)
 138 {
 139   char *dst = scm_malloc (n + 1);
 140   memcpy (dst, str, n);
 141   dst[n] = 0;
 142   return dst;
 143 }
 144
 145 char *
 146 scm_strdup (const char *str)
 147 {
 148   return scm_strndup (str, strlen (str));
 149 }
 150
 151
 152
 153 void
 154 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 155 {
 156   /* Nothing to do.  */
 157 #ifdef GUILE_DEBUG_MALLOC
 158   if (mem)
 159     scm_malloc_register (mem, what);
 160 #endif
 161 }
 162
 163
 164 void
 165 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 166 {
 167   /* Nothing to do.  */
 168 #ifdef GUILE_DEBUG_MALLOC
 169   if (mem)
 170     scm_malloc_unregister (mem);
 171 #endif
 172 }
 173
 174 /* Allocate SIZE bytes of memory whose contents should not be scanned
 175    for pointers (useful, e.g., for strings).  Note though that this
 176    memory is *not* cleared; be sure to initialize it to prevent
 177    information leaks.  */
 178 void *
 179 scm_gc_malloc_pointerless (size_t size, const char *what)
 180 {
 181   return GC_MALLOC_ATOMIC (size);
 182 }
 183
 184 void *
 185 scm_gc_malloc (size_t size, const char *what)
 186 {
 187   void *ptr;
 188
 189   if (size == 0)
 190     /* `GC_MALLOC ()' doesn't handle zero.  */
 191     size = sizeof (void *);
 192
 193   ptr = GC_MALLOC (size);
 194
 195   return ptr;
 196 }
 197
 198 void *
 199 scm_gc_calloc (size_t size, const char *what)
 200 {
 201   /* `GC_MALLOC ()' always returns a zeroed buffer.  */
 202   return scm_gc_malloc (size, what);
 203 }
 204
 205
 206 void *
 207 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 208 {
 209   void *ptr;
 210
 211   ptr = GC_REALLOC (mem, new_size);
 212
 213 #ifdef GUILE_DEBUG_MALLOC
 214   if (mem)
 215     scm_malloc_reregister (mem, ptr, what);
 216 #endif
 217
 218   return ptr;
 219 }
 220
 221 void
 222 scm_gc_free (void *mem, size_t size, const char *what)
 223 {
 224   scm_gc_unregister_collectable_memory (mem, size, what);
 225   GC_FREE (mem);
 226 }
 227
 228 char *
 229 scm_gc_strndup (const char *str, size_t n, const char *what)
 230 {
 231   char *dst = GC_MALLOC_ATOMIC (n + 1);
 232   memcpy (dst, str, n);
 233   dst[n] = 0;
 234   return dst;
 235 }
 236
 237 char *
 238 scm_gc_strdup (const char *str, const char *what)
 239 {
 240   return scm_gc_strndup (str, strlen (str), what);
 241 }