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 (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., 59 Temple Place - Suite 330,
  29 Boston, MA 02111-1307, 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 /* We use a double linked list of these structures to keep track of
  46    the memory we allocate internally.  We could also use this for user
  47    allocated memory (ALLOCATE/DEALLOCATE).  This should be stored in a
  48    seperate list.  */
  49 typedef struct malloc_t
  50 {
  51   int magic;
  52   int marker;
  53   struct malloc_t *prev, *next;
  54
  55   /* The start of the block.  */
  56   void *data;
  57 }
  58 malloc_t;
  59
  60 /* We try to make sure we don't get memory corruption by checking for
  61    a magic number.  */
  62 #define GFC_MALLOC_MAGIC 0x4d353941     /* "G95M" */
  63
  64 #define HEADER_SIZE offsetof (malloc_t, data)
  65 #define DATA_POINTER(pheader) (&((pheader)->data))
  66 #define DATA_HEADER(pdata) ((malloc_t *)((char *) (pdata) - HEADER_SIZE))
  67
  68 /* The root of the circular double linked list for compiler generated
  69    malloc calls.  */
  70 static malloc_t mem_root = {
  71         .next = &mem_root,
  72         .prev = &mem_root
  73 };
  74
  75 #if 0
  76 /* ??? Disabled because, well, it wasn't being called before transforming
  77    it to a destructor, and turning it on causes testsuite failures.  */
  78 /* Doesn't actually do any cleaning up, just throws an error if something
  79    has got out of sync somewhere.  */
  80
  81 static void __attribute__((destructor))
  82 runtime_cleanup (void)
  83 {
  84   /* Make sure all memory we've allocated is freed on exit.  */
  85   if (mem_root.next != &mem_root)
  86     runtime_error ("Unfreed memory on program termination");
  87 }
  88 #endif
  89
  90
  91 void *
  92 get_mem (size_t n)
  93 {
  94   void *p;
  95
  96 #ifdef GFC_CLEAR_MEMORY
  97   p = (void *) calloc (1, n);
  98 #else
  99   p = (void *) malloc (n);
 100 #endif
 101   if (p == NULL)
 102     os_error ("Memory allocation failed");
 103
 104   return p;
 105 }
 106
 107
 108 void
 109 free_mem (void *p)
 110 {
 111   free (p);
 112 }
 113
 114
 115 /* Allocates a block of memory with a size of N bytes.  N does not
 116    include the size of the header.  */
 117
 118 static malloc_t *
 119 malloc_with_header (size_t n)
 120 {
 121   malloc_t *newmem;
 122
 123   n = n + HEADER_SIZE;
 124
 125   newmem = (malloc_t *) get_mem (n);
 126
 127   if (newmem)
 128     {
 129       newmem->magic = GFC_MALLOC_MAGIC;
 130       newmem->marker = 0;
 131     }
 132
 133   return newmem;
 134 }
 135
 136
 137 /* Allocate memory for internal (compiler generated) use.  */
 138
 139 void *
 140 internal_malloc_size (size_t size)
 141 {
 142   malloc_t *newmem;
 143
 144   newmem = malloc_with_header (size);
 145
 146   if (!newmem)
 147     os_error ("Out of memory.");
 148
 149   /* Add to end of list.  */
 150   newmem->next = &mem_root;
 151   newmem->prev = mem_root.prev;
 152   mem_root.prev->next = newmem;
 153   mem_root.prev = newmem;
 154
 155   return DATA_POINTER (newmem);
 156 }
 157
 158 extern void *internal_malloc (GFC_INTEGER_4);
 159 export_proto(internal_malloc);
 160
 161 void *
 162 internal_malloc (GFC_INTEGER_4 size)
 163 {
 164 #ifdef GFC_CHECK_MEMORY
 165   /* Under normal circumstances, this is _never_ going to happen!  */
 166   if (size < 0)
 167     runtime_error ("Attempt to allocate a negative amount of memory.");
 168
 169 #endif
 170   return internal_malloc_size ((size_t) size);
 171 }
 172
 173 extern void *internal_malloc64 (GFC_INTEGER_8);
 174 export_proto(internal_malloc64);
 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 iexport(internal_free);
 215
 216
 217 /* User-allocate, one call for each member of the alloc-list of an
 218    ALLOCATE statement. */
 219
 220 static void
 221 allocate_size (void **mem, size_t size, GFC_INTEGER_4 * stat)
 222 {
 223   malloc_t *newmem;
 224
 225   if (!mem)
 226     runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
 227
 228   newmem = malloc_with_header (size);
 229   if (!newmem)
 230     {
 231       if (stat)
 232         {
 233           *stat = 1;
 234           return;
 235         }
 236       else
 237         runtime_error ("ALLOCATE: Out of memory.");
 238     }
 239
 240   /* We don't keep a list of these at the moment, so just link to itself. */
 241   newmem->next = newmem;
 242   newmem->prev = newmem;
 243
 244   (*mem) = DATA_POINTER (newmem);
 245
 246   if (stat)
 247     *stat = 0;
 248 }
 249
 250 extern void allocate (void **, GFC_INTEGER_4, GFC_INTEGER_4 *);
 251 export_proto(allocate);
 252
 253 void
 254 allocate (void **mem, GFC_INTEGER_4 size, GFC_INTEGER_4 * stat)
 255 {
 256   if (size < 0)
 257     {
 258       runtime_error ("Attempt to allocate negative amount of memory.  "
 259                      "Possible integer overflow");
 260       abort ();
 261     }
 262
 263   allocate_size (mem, (size_t) size, stat);
 264 }
 265
 266 extern void allocate64 (void **, GFC_INTEGER_8, GFC_INTEGER_4 *);
 267 export_proto(allocate64);
 268
 269 void
 270 allocate64 (void **mem, GFC_INTEGER_8 size, GFC_INTEGER_4 * stat)
 271 {
 272   if (size < 0)
 273     {
 274       runtime_error
 275         ("ALLOCATE64: Attempt to allocate negative amount of memory. "
 276          "Possible integer overflow");
 277       abort ();
 278     }
 279
 280   allocate_size (mem, (size_t) size, stat);
 281 }
 282
 283
 284 /* User-deallocate; pointer is NULLified. */
 285
 286 extern void deallocate (void **, GFC_INTEGER_4 *);
 287 export_proto(deallocate);
 288
 289 void
 290 deallocate (void **mem, GFC_INTEGER_4 * stat)
 291 {
 292   if (!mem)
 293     runtime_error ("Internal: NULL mem pointer in ALLOCATE.");
 294
 295   if (!*mem)
 296     {
 297       if (stat)
 298         {
 299           *stat = 1;
 300           return;
 301         }
 302       else
 303         {
 304           runtime_error
 305             ("Internal: Attempt to DEALLOCATE unallocated memory.");
 306           abort ();
 307         }
 308     }
 309
 310   /* Just use the internal routine.  */
 311   internal_free (*mem);
 312   *mem = NULL;
 313
 314   if (stat)
 315     *stat = 0;
 316 }