libguile/gc-malloc.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010, 2011 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/hashtab.h"
  47 #include "libguile/tags.h"
  48
  49 #include "libguile/validate.h"
  50 #include "libguile/deprecation.h"
  51 #include "libguile/gc.h"
  52
  53 #include "libguile/private-gc.h"
  54
  55 #ifdef GUILE_DEBUG_MALLOC
  56 #include "libguile/debug-malloc.h"
  57 #endif
  58
  59 #ifdef HAVE_MALLOC_H
  60 #include <malloc.h>
  61 #endif
  62
  63 #ifdef HAVE_UNISTD_H
  64 #include <unistd.h>
  65 #endif
  66
  67 /*
  68   INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
  69   trigger a GC.
  70
  71   After startup (at the guile> prompt), we have approximately 100k of
  72   alloced memory, which won't go away on GC. Let's set the init such
  73   that we get a nice yield on the next allocation:
  74 */
  75 #define SCM_DEFAULT_INIT_MALLOC_LIMIT 200*1024
  76 #define SCM_DEFAULT_MALLOC_MINYIELD 40
  77
  78 /* #define DEBUGINFO */
  79
  80
  81 \f
  82 /* Function for non-cell memory management.
  83  */
  84
  85 void *
  86 scm_realloc (void *mem, size_t size)
  87 {
  88   void *ptr;
  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   GC_gcollect ();
  96
  97   SCM_SYSCALL (ptr = realloc (mem, size));
  98   if (ptr)
  99     return ptr;
 100
 101   scm_memory_error ("realloc");
 102 }
 103
 104 void *
 105 scm_malloc (size_t sz)
 106 {
 107   return scm_realloc (NULL, sz);
 108 }
 109
 110 /*
 111   Hmm. Should we use the C convention for arguments (i.e. N_ELTS,
 112   SIZEOF_ELT)? --hwn
 113  */
 114 void *
 115 scm_calloc (size_t sz)
 116 {
 117   void * ptr;
 118
 119   /*
 120     By default, try to use calloc, as it is likely more efficient than
 121     calling memset by hand.
 122    */
 123   SCM_SYSCALL (ptr = calloc (sz, 1));
 124   if (ptr)
 125     return ptr;
 126
 127   ptr = scm_realloc (NULL, sz);
 128   memset (ptr, 0x0, sz);
 129   return ptr;
 130 }
 131
 132
 133 char *
 134 scm_strndup (const char *str, size_t n)
 135 {
 136   char *dst = scm_malloc (n + 1);
 137   memcpy (dst, str, n);
 138   dst[n] = 0;
 139   return dst;
 140 }
 141
 142 char *
 143 scm_strdup (const char *str)
 144 {
 145   return scm_strndup (str, strlen (str));
 146 }
 147
 148
 149
 150 void
 151 scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
 152 {
 153   /* Nothing to do.  */
 154 #ifdef GUILE_DEBUG_MALLOC
 155   if (mem)
 156     scm_malloc_register (mem);
 157 #endif
 158 }
 159
 160
 161 void
 162 scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
 163 {
 164   /* Nothing to do.  */
 165 #ifdef GUILE_DEBUG_MALLOC
 166   if (mem)
 167     scm_malloc_unregister (mem);
 168 #endif
 169 }
 170
 171 /* Allocate SIZE bytes of memory whose contents should not be scanned
 172    for pointers (useful, e.g., for strings).  Note though that this
 173    memory is *not* cleared; be sure to initialize it to prevent
 174    information leaks.  */
 175 void *
 176 scm_gc_malloc_pointerless (size_t size, const char *what)
 177 {
 178   return GC_MALLOC_ATOMIC (size);
 179 }
 180
 181 void *
 182 scm_gc_malloc (size_t size, const char *what)
 183 {
 184   void *ptr;
 185
 186   if (size == 0)
 187     /* `GC_MALLOC ()' doesn't handle zero.  */
 188     size = sizeof (void *);
 189
 190   ptr = GC_MALLOC (size);
 191
 192   return ptr;
 193 }
 194
 195 void *
 196 scm_gc_calloc (size_t size, const char *what)
 197 {
 198   /* `GC_MALLOC ()' always returns a zeroed buffer.  */
 199   return scm_gc_malloc (size, what);
 200 }
 201
 202
 203 void *
 204 scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
 205 {
 206   void *ptr;
 207
 208   ptr = GC_REALLOC (mem, new_size);
 209
 210 #ifdef GUILE_DEBUG_MALLOC
 211   if (mem)
 212     scm_malloc_reregister (mem, ptr, what);
 213 #endif
 214
 215   return ptr;
 216 }
 217
 218 void
 219 scm_gc_free (void *mem, size_t size, const char *what)
 220 {
 221   scm_gc_unregister_collectable_memory (mem, size, what);
 222   GC_FREE (mem);
 223 }
 224
 225 char *
 226 scm_gc_strndup (const char *str, size_t n, const char *what)
 227 {
 228   char *dst = GC_MALLOC_ATOMIC (n + 1);
 229   memcpy (dst, str, n);
 230   dst[n] = 0;
 231   return dst;
 232 }
 233
 234 char *
 235 scm_gc_strdup (const char *str, const char *what)
 236 {
 237   return scm_gc_strndup (str, strlen (str), what);
 238 }