libgfortran/runtime/memory.c

   1 /* Memory mamagement routines.
   2    Copyright 2002, 2005 Free Software Foundation, Inc.
   3    Contributed by Paul Brook <paul@nowt.org>
   4
   5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 2 of the License, or (at your option) any later version.
  11
  12 In addition to the permissions in the GNU General Public License, the
  13 Free Software Foundation gives you unlimited permission to link the
  14 compiled version of this file into combinations with other programs,
  15 and to distribute those combinations without any restriction coming
  16 from the use of this file.  (The General Public License restrictions
  17 do apply in other respects; for example, they cover modification of
  18 the file, and distribution when not linked into a combine
  19 executable.)
  20
  21 Libgfortran is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public
  27 License along with libgfortran; see the file COPYING.  If not,
  28 write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  29 Boston, MA 02110-1301, USA.  */
  30
  31 #include "config.h"
  32 #include <stdlib.h>
  33 #include "libgfortran.h"
  34
  35 /* If GFC_CLEAR_MEMORY is defined, the memory allocation routines will
  36    return memory that is guaranteed to be set to zero.  This can have
  37    a severe efficiency penalty, so it should never be set if good
  38    performance is desired, but it can help when you're debugging code.  */
  39 /* #define GFC_CLEAR_MEMORY */
  40
  41 /* If GFC_CHECK_MEMORY is defined, we do some sanity checks at runtime.
  42    This causes small overhead, but again, it also helps debugging.  */
  43 #define GFC_CHECK_MEMORY
  44
  45 void *
  46 get_mem (size_t n)
  47 {
  48   void *p;
  49
  50 #ifdef GFC_CLEAR_MEMORY
  51   p = (void *) calloc (1, n);
  52 #else
  53   p = (void *) malloc (n);
  54 #endif
  55   if (p == NULL)
  56     os_error ("Memory allocation failed");
  57
  58   return p;
  59 }
  60
  61
  62 void
  63 free_mem (void *p)
  64 {
  65   free (p);
  66 }
  67
  68
  69 /* Allocate memory for internal (compiler generated) use.  */
  70
  71 void *
  72 internal_malloc_size (size_t size)
  73 {
  74   if (size == 0)
  75     return NULL;
  76
  77   return get_mem (size);
  78 }
  79
  80 extern void *internal_malloc (GFC_INTEGER_4);
  81 export_proto(internal_malloc);
  82
  83 void *
  84 internal_malloc (GFC_INTEGER_4 size)
  85 {
  86 #ifdef GFC_CHECK_MEMORY
  87   /* Under normal circumstances, this is _never_ going to happen!  */
  88   if (size < 0)
  89     runtime_error ("Attempt to allocate a negative amount of memory.");
  90
  91 #endif
  92   return internal_malloc_size ((size_t) size);
  93 }
  94
  95 extern void *internal_malloc64 (GFC_INTEGER_8);
  96 export_proto(internal_malloc64);
  97
  98 void *
  99 internal_malloc64 (GFC_INTEGER_8 size)
 100 {
 101 #ifdef GFC_CHECK_MEMORY
 102   /* Under normal circumstances, this is _never_ going to happen!  */
 103   if (size < 0)
 104     runtime_error ("Attempt to allocate a negative amount of memory.");
 105 #endif
 106   return internal_malloc_size ((size_t) size);
 107 }
 108
 109
 110 /* Free internally allocated memory.  Pointer is NULLified.  Also used to
 111    free user allocated memory.  */
 112
 113 void
 114 internal_free (void *mem)
 115 {
 116   if (mem != NULL)
 117     free (mem);
 118 }
 119 iexport(internal_free);
 120
 121 /* Reallocate internal memory MEM so it has SIZE bytes of data.
 122    Allocate a new block if MEM is zero, and free the block if
 123    SIZE is 0.  */
 124
 125 static void *
 126 internal_realloc_size (void *mem, size_t size)
 127 {
 128   if (size == 0)
 129     {
 130       if (mem)
 131         free (mem);
 132       return NULL;
 133     }
 134
 135   if (mem == 0)
 136     return get_mem (size);
 137
 138   mem = realloc (mem, size);
 139   if (!mem)
 140     os_error ("Out of memory.");
 141
 142   return mem;
 143 }
 144
 145 extern void *internal_realloc (void *, GFC_INTEGER_4);
 146 export_proto(internal_realloc);
 147
 148 void *
 149 internal_realloc (void *mem, GFC_INTEGER_4 size)
 150 {
 151 #ifdef GFC_CHECK_MEMORY
 152   /* Under normal circumstances, this is _never_ going to happen!  */
 153   if (size < 0)
 154     runtime_error ("Attempt to allocate a negative amount of memory.");
 155 #endif
 156   return internal_realloc_size (mem, (size_t) size);
 157 }
 158
 159 extern void *internal_realloc64 (void *, GFC_INTEGER_8);
 160 export_proto(internal_realloc64);
 161
 162 void *
 163 internal_realloc64 (void *mem, GFC_INTEGER_8 size)
 164 {
 165 #ifdef GFC_CHECK_MEMORY
 166   /* Under normal circumstances, this is _never_ going to happen!  */
 167   if (size < 0)
 168     runtime_error ("Attempt to allocate a negative amount of memory.");
 169 #endif
 170   return internal_realloc_size (mem, (size_t) size);
 171 }
 172
 173
 174 /* User-allocate, one call for each member of the alloc-list of an
 175    ALLOCATE statement. */
 176
 177 static void
 178 allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat)
 179 {
 180   void *newmem;
 181
 182   if (!mem)
 183     runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
 184
 185   newmem = malloc (size ? size : 1);
 186   if (!newmem)
 187     {
 188       if (stat)
 189         {
 190           *stat = 1;
 191           return;
 192         }
 193       else
 194         runtime_error ("ALLOCATE: Out of memory.");
 195     }
 196
 197   (*mem) = newmem;
 198
 199   if (stat)
 200     *stat = 0;
 201 }
 202
 203 extern void allocate (void **, GFC_INTEGER_4, GFC_INTEGER_4 *);
 204 export_proto(allocate);
 205
 206 void
 207 allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
 208 {
 209   if (size < 0)
 210     {
 211       runtime_error ("Attempt to allocate negative amount of memory.  "
 212                      "Possible integer overflow");
 213       abort ();
 214     }
 215
 216   allocate_size (mem, (size_t) size, stat);
 217 }
 218
 219 extern void allocate64 (void **, GFC_INTEGER_8, GFC_INTEGER_4 *);
 220 export_proto(allocate64);
 221
 222 void
 223 allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
 224 {
 225   if (size < 0)
 226     {
 227       runtime_error
 228         ("ALLOCATE64: Attempt to allocate negative amount of memory. "
 229          "Possible integer overflow");
 230       abort ();
 231     }
 232
 233   allocate_size (mem, (size_t) size, stat);
 234 }
 235
 236
 237 /* User-deallocate; pointer is NULLified. */
 238
 239 extern void deallocate (void **, GFC_INTEGER_4 *);
 240 export_proto(deallocate);
 241
 242 void
 243 deallocate (void **mem, GFC_INTEGER_4 * stat)
 244 {
 245   if (!mem)
 246     runtime_error ("Internal: NULL mem pointer in DEALLOCATE.");
 247
 248   if (!*mem)
 249     {
 250       if (stat)
 251         {
 252           *stat = 1;
 253           return;
 254         }
 255       else
 256         {
 257           runtime_error
 258             ("Internal: Attempt to DEALLOCATE unallocated memory.");
 259           abort ();
 260         }
 261     }
 262
 263   free (*mem);
 264   *mem = NULL;
 265
 266   if (stat)
 267     *stat = 0;
 268 }