libgfortran/runtime/memory.c

   1 /* Memory management routines.
   2    Copyright 2002, 2005, 2006, 2007 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
  81 /* Reallocate internal memory MEM so it has SIZE bytes of data.
  82    Allocate a new block if MEM is zero, and free the block if
  83    SIZE is 0.  */
  84
  85 static void *
  86 internal_realloc_size (void *mem, size_t size)
  87 {
  88   if (size == 0)
  89     {
  90       if (mem)
  91         free (mem);
  92       return NULL;
  93     }
  94
  95   if (mem == 0)
  96     return get_mem (size);
  97
  98   mem = realloc (mem, size);
  99   if (!mem)
 100     os_error ("Out of memory.");
 101
 102   return mem;
 103 }
 104
 105 extern void *internal_realloc (void *, index_type);
 106 export_proto(internal_realloc);
 107
 108 void *
 109 internal_realloc (void *mem, index_type size)
 110 {
 111 #ifdef GFC_CHECK_MEMORY
 112   /* Under normal circumstances, this is _never_ going to happen!  */
 113   if (size < 0)
 114     runtime_error ("Attempt to allocate a negative amount of memory.");
 115 #endif
 116   return internal_realloc_size (mem, (size_t) size);
 117 }
 118
 119 /* User-allocate, one call for each member of the alloc-list of an
 120    ALLOCATE statement. */
 121
 122 static void *
 123 allocate_size (size_t size, GFC_INTEGER_4 * stat)
 124 {
 125   void *newmem;
 126
 127   newmem = malloc (size ? size : 1);
 128   if (!newmem)
 129     {
 130       if (stat)
 131         {
 132           *stat = ERROR_ALLOCATION;
 133           return newmem;
 134         }
 135       else
 136         runtime_error ("ALLOCATE: Out of memory.");
 137     }
 138
 139   if (stat)
 140     *stat = 0;
 141
 142   return newmem;
 143 }
 144
 145 extern void *allocate (index_type, GFC_INTEGER_4 *);
 146 export_proto(allocate);
 147
 148 void *
 149 allocate (index_type size, GFC_INTEGER_4 * stat)
 150 {
 151 #ifdef GFC_CHECK_MEMORY
 152   /* The only time this can happen is the size computed by the
 153      frontend wraps around.  */
 154   if (size < 0)
 155     {
 156       if (stat)
 157         {
 158           *stat = ERROR_ALLOCATION;
 159           return NULL;
 160         }
 161       else
 162         runtime_error ("Attempt to allocate negative amount of memory. "
 163                        "Possible integer overflow");
 164     }
 165 #endif
 166   return allocate_size ((size_t) size, stat);
 167 }
 168
 169 /* Function to call in an ALLOCATE statement when the argument is an
 170    allocatable array.  If the array is currently allocated, it is
 171    an error to allocate it again.  */
 172
 173 extern void *allocate_array (void *, index_type, GFC_INTEGER_4 *);
 174 export_proto(allocate_array);
 175
 176 void *
 177 allocate_array (void *mem, index_type size, GFC_INTEGER_4 * stat)
 178 {
 179   if (mem == NULL)
 180     return allocate (size, stat);
 181   if (stat)
 182     {
 183       free (mem);
 184       mem = allocate (size, stat);
 185       *stat = ERROR_ALLOCATION;
 186       return mem;
 187     }
 188
 189   runtime_error ("Attempting to allocate already allocated array.");
 190 }
 191
 192
 193 /* User-deallocate; pointer is then NULLified by the front-end. */
 194
 195 extern void deallocate (void *, GFC_INTEGER_4 *);
 196 export_proto(deallocate);
 197
 198 void
 199 deallocate (void *mem, GFC_INTEGER_4 * stat)
 200 {
 201   if (!mem)
 202     {
 203       if (stat)
 204         {
 205           *stat = 1;
 206           return;
 207         }
 208       else
 209         runtime_error ("Internal: Attempt to DEALLOCATE unallocated memory.");
 210     }
 211
 212   free (mem);
 213
 214   if (stat)
 215     *stat = 0;
 216 }