libgfortran/runtime/memory.c

   1 /* Memory mamagement routines.
   2    Copyright 2002 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 (libgfor).
   6
   7 Libgfor is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU Lesser General Public
   9 License as published by the Free Software Foundation; either
  10 version 2.1 of the License, or (at your option) any later version.
  11
  12 Libgfor is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU Lesser General Public License for more details.
  16
  17 You should have received a copy of the GNU Lesser General Public
  18 License along with libgfor; see the file COPYING.LIB.  If not,
  19 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 #include "config.h"
  23 #include <stdlib.h>
  24 #include "libgfortran.h"
  25
  26 /* If GFC_CLEAR_MEMORY is defined, the memory allocation routines will
  27    return memory that is guaranteed to be set to zero.  This can have
  28    a severe efficiency penalty, so it should never be set if good
  29    performance is desired, but it can help when you're debugging code.  */
  30 #define GFC_CLEAR_MEMORY
  31
  32 /* If GFC_CHECK_MEMORY is defined, we do some sanity checks at runtime.
  33    This causes small overhead, but again, it also helps debugging.  */
  34 #define GFC_CHECK_MEMORY
  35
  36 /* We use a double linked list of these structures to keep track of
  37    the memory we allocate internally.  We could also use this for user
  38    allocated memory (ALLOCATE/DEALLOCATE).  This should be stored in a
  39    seperate list.  */
  40 #define malloc_t        prefix(malloc_t)
  41 typedef struct malloc_t
  42 {
  43   int magic;
  44   int marker;
  45   struct malloc_t *prev, *next;
  46
  47   /* The start of the block.  */
  48   void *data;
  49 }
  50 malloc_t;
  51
  52 /* We try to make sure we don't get memory corruption by checking for
  53    a magic number.  */
  54 #define GFC_MALLOC_MAGIC 0x4d353941     /* "G95M" */
  55
  56 #define HEADER_SIZE offsetof (malloc_t, data)
  57 #define DATA_POINTER(pheader) (&((pheader)->data))
  58 #define DATA_HEADER(pdata) ((malloc_t *)((char *) (pdata) - HEADER_SIZE))
  59
  60 /* The root of the circular double linked list for compiler generated
  61    malloc calls.  */
  62 static malloc_t mem_root;
  63
  64
  65 void
  66 memory_init (void)
  67 {
  68
  69   /* The root should never be used directly, so don't set the magic.  */
  70   mem_root.magic = 0;
  71   mem_root.next = &mem_root;
  72   mem_root.prev = &mem_root;
  73   mem_root.marker = 0;
  74 }
  75
  76
  77 /* Doesn't actually do any cleaning up, just throws an error if something
  78    has got out of sync somewhere.  */
  79
  80 void
  81 runtime_cleanup (void)
  82 {
  83   /* Make sure all memory we've allocated is freed on exit.  */
  84   if (mem_root.next != &mem_root)
  85     runtime_error ("Unfreed memory on program termination");
  86 }
  87
  88
  89
  90 void *
  91 get_mem (size_t n)
  92 {
  93   void *p;
  94
  95 #ifdef GFC_CLEAR_MEMORY
  96   p = (void *) calloc (n, 1);
  97 #else
  98 #define temp malloc
  99 #undef malloc
 100   p = (void *) malloc (n);
 101 #define malloc temp
 102 #undef temp
 103 #endif
 104   if (p == NULL)
 105     os_error ("Memory allocation failed");
 106
 107   return p;
 108 }
 109
 110
 111 void
 112 free_mem (void *p)
 113 {
 114
 115   free (p);
 116 }
 117
 118
 119 /* Allocates a block of memory with a size of N bytes.  N does not
 120    include the size of the header.  */
 121
 122 static malloc_t *
 123 malloc_with_header (size_t n)
 124 {
 125   malloc_t *newmem;
 126
 127   n = n + HEADER_SIZE;
 128
 129   newmem = (malloc_t *) get_mem (n);
 130
 131   if (newmem)
 132     {
 133       newmem->magic = GFC_MALLOC_MAGIC;
 134       newmem->marker = 0;
 135     }
 136
 137   return newmem;
 138 }
 139
 140
 141 /* Allocate memory for internal (compiler generated) use.  */
 142
 143 void *
 144 internal_malloc_size (size_t size)
 145 {
 146   malloc_t *newmem;
 147
 148   newmem = malloc_with_header (size);
 149
 150   if (!newmem)
 151     os_error ("Out of memory.");
 152
 153   /* Add to end of list.  */
 154   newmem->next = &mem_root;
 155   newmem->prev = mem_root.prev;
 156   mem_root.prev->next = newmem;
 157   mem_root.prev = newmem;
 158
 159   return DATA_POINTER (newmem);
 160 }
 161
 162
 163 void *
 164 internal_malloc (GFC_INTEGER_4 size)
 165 {
 166 #ifdef GFC_CHECK_MEMORY
 167   /* Under normal circumstances, this is _never_ going to happen!  */
 168   if (size < 0)
 169     runtime_error ("Attempt to allocate a negative amount of memory.");
 170
 171 #endif
 172   return internal_malloc_size ((size_t) size);
 173 }
 174
 175
 176 void *
 177 internal_malloc64 (GFC_INTEGER_8 size)
 178 {
 179 #ifdef GFC_CHECK_MEMORY
 180   /* Under normal circumstances, this is _never_ going to happen!  */
 181   if (size < 0)
 182     runtime_error ("Attempt to allocate a negative amount of memory.");
 183 #endif
 184   return internal_malloc_size ((size_t) size);
 185 }
 186
 187
 188 /* Free internally allocated memory.  Pointer is NULLified.  Also used to
 189    free user allocated memory.  */
 190 /* TODO: keep a list of previously allocated blocks and reuse them.  */
 191
 192 void
 193 internal_free (void *mem)
 194 {
 195   malloc_t *m;
 196
 197   if (!mem)
 198     runtime_error ("Internal: Possible double free of temporary.");
 199
 200   m = DATA_HEADER (mem);
 201
 202   if (m->magic != GFC_MALLOC_MAGIC)
 203     runtime_error ("Internal: No magic memblock marker.  "
 204                    "Possible memory corruption");
 205
 206   /* Move markers up the chain, so they don't get lost.  */
 207   m->prev->marker += m->marker;
 208   /* Remove from list.  */
 209   m->prev->next = m->next;
 210   m->next->prev = m->prev;
 211
 212   free (m);
 213 }
 214
 215
 216 /* User-allocate, one call for each member of the alloc-list of an
 217    ALLOCATE statement. */
 218
 219 static void
 220 allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat)
 221 {
 222   malloc_t *newmem;
 223
 224   if (!mem)
 225     runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
 226
 227   newmem = malloc_with_header (size);
 228   if (!newmem)
 229     {
 230       if (stat)
 231         {
 232           *stat = 1;
 233           return;
 234         }
 235       else
 236         runtime_error ("ALLOCATE: Out of memory.");
 237     }
 238
 239   /* We don't keep a list of these at the moment, so just link to itself. */
 240   newmem->next = newmem;
 241   newmem->prev = newmem;
 242
 243   (*mem) = DATA_POINTER (newmem);
 244
 245   if (stat)
 246     *stat = 0;
 247 }
 248
 249
 250 void
 251 allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
 252 {
 253
 254   if (size < 0)
 255     {
 256       runtime_error ("Attempt to allocate negative amount of memory.  "
 257                      "Possible integer overflow");
 258       abort ();
 259     }
 260
 261   allocate_size (mem, (size_t) size, stat);
 262 }
 263
 264
 265 void
 266 allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
 267 {
 268
 269   if (size < 0)
 270     {
 271       runtime_error
 272         ("ALLOCATE64: Attempt to allocate negative amount of memory. "
 273          "Possible integer overflow");
 274       abort ();
 275     }
 276
 277   allocate_size (mem, (size_t) size, stat);
 278 }
 279
 280
 281 /* User-deallocate; pointer is NULLified. */
 282
 283 void
 284 deallocate (void **mem, GFC_INTEGER_4 * stat)
 285 {
 286
 287   if (!mem)
 288     runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
 289
 290   if (!*mem)
 291     {
 292       if (stat)
 293         {
 294           *stat = 1;
 295           return;
 296         }
 297       else
 298         {
 299           runtime_error
 300             ("Internal: Attempt to DEALLOCATE unallocated memory.");
 301           abort ();
 302         }
 303     }
 304
 305   /* Just use the internal routine.  */
 306   internal_free (*mem);
 307   *mem = NULL;
 308
 309   if (stat)
 310     *stat = 0;
 311 }
 312