libgfortran/runtime/memory.c

   1 /* Memory management routines.
   2    Copyright 2002, 2005, 2006 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 (size_t size, GFC_INTEGER_4 * stat)
 179 {
 180   void *newmem;
 181
 182   newmem = malloc (size ? size : 1);
 183   if (!newmem)
 184     {
 185       if (stat)
 186         {
 187           *stat = 1;
 188           return newmem;
 189         }
 190       else
 191         runtime_error ("ALLOCATE: Out of memory.");
 192     }
 193
 194   if (stat)
 195     *stat = 0;
 196
 197   return newmem;
 198 }
 199
 200 extern void *allocate (GFC_INTEGER_4, GFC_INTEGER_4 *);
 201 export_proto(allocate);
 202
 203 void *
 204 allocate (GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
 205 {
 206   if (size < 0)
 207     runtime_error ("Attempt to allocate negative amount of memory.  "
 208                    "Possible integer overflow");
 209
 210   return allocate_size ((size_t) size, stat);
 211 }
 212
 213 extern void *allocate64 (GFC_INTEGER_8, GFC_INTEGER_4 *);
 214 export_proto(allocate64);
 215
 216 void *
 217 allocate64 (GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
 218 {
 219   if (size < 0)
 220     runtime_error ("ALLOCATE64: Attempt to allocate negative amount of "
 221                    "memory. Possible integer overflow");
 222
 223   return allocate_size ((size_t) size, stat);
 224 }
 225
 226 /* Function to call in an ALLOCATE statement when the argument is an
 227    allocatable array.  If the array is currently allocated, it is
 228    an error to allocate it again.  32-bit version.  */
 229
 230 extern void *allocate_array (void *, GFC_INTEGER_4, GFC_INTEGER_4 *);
 231 export_proto(allocate_array);
 232
 233 void *
 234 allocate_array (void *mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
 235 {
 236   if (mem == NULL)
 237     return allocate (size, stat);
 238   if (stat)
 239     {
 240       free (mem);
 241       mem = allocate (size, stat);
 242       *stat = ERROR_ALLOCATION;
 243       return mem;
 244     }
 245
 246   runtime_error ("Attempting to allocate already allocated array.");
 247 }
 248
 249 /* Function to call in an ALLOCATE statement when the argument is an
 250    allocatable array.  If the array is currently allocated, it is
 251    an error to allocate it again.  64-bit version.  */
 252
 253 extern void *allocate64_array (void *, GFC_INTEGER_8, GFC_INTEGER_4 *);
 254 export_proto(allocate64_array);
 255
 256 void *
 257 allocate64_array (void *mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
 258 {
 259   if (mem == NULL)
 260     return allocate64 (size, stat);
 261   if (stat)
 262     {
 263       free (mem);
 264       mem = allocate (size, stat);
 265       *stat = ERROR_ALLOCATION;
 266       return mem;
 267     }
 268
 269   runtime_error ("Attempting to allocate already allocated array.");
 270 }
 271
 272 /* User-deallocate; pointer is NULLified. */
 273
 274 extern void deallocate (void *, GFC_INTEGER_4 *);
 275 export_proto(deallocate);
 276
 277 void
 278 deallocate (void *mem, GFC_INTEGER_4 * stat)
 279 {
 280   if (!mem)
 281     {
 282       if (stat)
 283         {
 284           *stat = 1;
 285           return;
 286         }
 287       else
 288         runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory.");
 289     }
 290
 291   free (mem);
 292
 293   if (stat)
 294     *stat = 0;
 295 }