gcc/f/malloc.c

   1 /* malloc.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley.
   4
   5 This file is part of GNU Fortran.
   6
   7 GNU Fortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Fortran 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 General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Fortran; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.
  21
  22    Related Modules:
  23       None
  24
  25    Description:
  26       Fast pool-based memory allocation.
  27
  28    Modifications:
  29 */
  30
  31 /* Include files. */
  32
  33 #include "proj.h"
  34 #include "malloc.h"
  35
  36 /* Externals defined here.  */
  37
  38 struct _malloc_root_ malloc_root_
  39 =
  40 {
  41   {
  42     &malloc_root_.malloc_pool_image_,
  43     &malloc_root_.malloc_pool_image_,
  44     (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
  45     (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
  46     (mallocArea_) &malloc_root_.malloc_pool_image_.first,
  47     (mallocArea_) &malloc_root_.malloc_pool_image_.first,
  48     0,
  49 #if MALLOC_DEBUG
  50     0, 0, 0, 0, 0, 0, 0, { '/' }
  51 #else
  52     { 0 }
  53 #endif
  54   },
  55 };
  56
  57 /* Simple definitions and enumerations. */
  58
  59
  60 /* Internal typedefs. */
  61
  62
  63 /* Private include files. */
  64
  65
  66 /* Internal structure definitions. */
  67
  68
  69 /* Static objects accessed by functions in this module. */
  70
  71 static void *malloc_reserve_ = NULL;    /* For crashes. */
  72 #if MALLOC_DEBUG
  73 static const char *const malloc_types_[] =
  74 {"KS", "KSR", "NF", "NFR", "US", "USR"};
  75 #endif
  76
  77 /* Static functions (internal). */
  78
  79 static void malloc_kill_area_ (mallocPool pool, mallocArea_ a);
  80 #if MALLOC_DEBUG
  81 static void malloc_verify_area_ (mallocPool pool, mallocArea_ a);
  82 #endif
  83
  84 /* Internal macros. */
  85
  86 #if MALLOC_DEBUG
  87 #define malloc_kill_(ptr,s) do {memset((ptr),127,(s));free((ptr));} while(0)
  88 #else
  89 #define malloc_kill_(ptr,s) free((ptr))
  90 #endif
  91 \f
  92 /* malloc_kill_area_ -- Kill storage area and its object
  93
  94    malloc_kill_area_(mallocPool pool,mallocArea_ area);
  95
  96    Does the actual killing of a storage area.  */
  97
  98 static void
  99 malloc_kill_area_ (mallocPool pool UNUSED, mallocArea_ a)
 100 {
 101 #if MALLOC_DEBUG
 102   assert (strcmp (a->name, ((char *) (a->where)) + a->size) == 0);
 103 #endif
 104   malloc_kill_ (a->where, a->size);
 105   a->next->previous = a->previous;
 106   a->previous->next = a->next;
 107 #if MALLOC_DEBUG
 108   pool->freed += a->size;
 109   pool->frees++;
 110 #endif
 111   malloc_kill_ (a,
 112                 offsetof (struct _malloc_area_, name)
 113                 + strlen (a->name) + 1);
 114 }
 115
 116 /* malloc_verify_area_ -- Verify storage area and its object
 117
 118    malloc_verify_area_(mallocPool pool,mallocArea_ area);
 119
 120    Does the actual verifying of a storage area.  */
 121
 122 #if MALLOC_DEBUG
 123 static void
 124 malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a UNUSED)
 125 {
 126   mallocSize s = a->size;
 127
 128   assert (strcmp (a->name, ((char *) (a->where)) + s) == 0);
 129 }
 130 #endif
 131
 132 /* malloc_init -- Initialize malloc cluster
 133
 134    malloc_init();
 135
 136    Call malloc_init before you do anything else.  */
 137
 138 void
 139 malloc_init ()
 140 {
 141   if (malloc_reserve_ != NULL)
 142     return;
 143   malloc_reserve_ = xmalloc (20 * 1024); /* In case of crash, free this first. */
 144 }
 145
 146 /* malloc_pool_display -- Display a pool
 147
 148    mallocPool p;
 149    malloc_pool_display(p);
 150
 151    Displays information associated with the pool and its subpools.  */
 152
 153 void
 154 malloc_pool_display (mallocPool p UNUSED)
 155 {
 156 #if MALLOC_DEBUG
 157   mallocPool q;
 158   mallocArea_ a;
 159
 160   fprintf (dmpout, "Pool \"%s\": bytes allocated=%lu, freed=%lu, old sizes=%lu, new sizes\
 161 =%lu,\n   allocations=%lu, frees=%lu, resizes=%lu, uses=%lu\n   Subpools:\n",
 162            p->name, p->allocated, p->freed, p->old_sizes, p->new_sizes, p->allocations,
 163            p->frees, p->resizes, p->uses);
 164
 165   for (q = p->eldest; q != (mallocPool) & p->eldest; q = q->next)
 166     fprintf (dmpout, "      \"%s\"\n", q->name);
 167
 168   fprintf (dmpout, "   Storage areas:\n");
 169
 170   for (a = p->first; a != (mallocArea_) & p->first; a = a->next)
 171     {
 172       fprintf (dmpout, "      ");
 173       malloc_display_ (a);
 174     }
 175 #endif
 176 }
 177
 178 /* malloc_pool_kill -- Destroy a pool
 179
 180    mallocPool p;
 181    malloc_pool_kill(p);
 182
 183    Releases all storage associated with the pool and its subpools.  */
 184
 185 void
 186 malloc_pool_kill (mallocPool p)
 187 {
 188   mallocPool q;
 189   mallocArea_ a;
 190
 191   if (--p->uses != 0)
 192     return;
 193
 194 #if 0
 195   malloc_pool_display (p);
 196 #endif
 197
 198   assert (p->next->previous == p);
 199   assert (p->previous->next == p);
 200
 201   /* Kill off all the subpools. */
 202
 203   while ((q = p->eldest) != (mallocPool) &p->eldest)
 204     {
 205       q->uses = 1;              /* Force the kill. */
 206       malloc_pool_kill (q);
 207     }
 208
 209   /* Now free all the storage areas. */
 210
 211   while ((a = p->first) != (mallocArea_) & p->first)
 212     {
 213       malloc_kill_area_ (p, a);
 214     }
 215
 216   /* Now remove from list of sibling pools. */
 217
 218   p->next->previous = p->previous;
 219   p->previous->next = p->next;
 220
 221   /* Finally, free the pool itself. */
 222
 223   malloc_kill_ (p,
 224                 offsetof (struct _malloc_pool_, name)
 225                 + strlen (p->name) + 1);
 226 }
 227
 228 /* malloc_pool_new -- Make a new pool
 229
 230    mallocPool p;
 231    p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
 232
 233    Makes a new pool with the given name and default new-chunk allocation.  */
 234
 235 mallocPool
 236 malloc_pool_new (const char *name, mallocPool parent,
 237                  unsigned long chunks UNUSED)
 238 {
 239   mallocPool p;
 240
 241   if (parent == NULL)
 242     parent = malloc_pool_image ();
 243
 244   p = malloc_new_ (offsetof (struct _malloc_pool_, name)
 245                    + (MALLOC_DEBUG ? strlen (name) + 1 : 0));
 246   p->next = (mallocPool) &(parent->eldest);
 247   p->previous = parent->youngest;
 248   parent->youngest->next = p;
 249   parent->youngest = p;
 250   p->eldest = (mallocPool) &(p->eldest);
 251   p->youngest = (mallocPool) &(p->eldest);
 252   p->first = (mallocArea_) &(p->first);
 253   p->last = (mallocArea_) &(p->first);
 254   p->uses = 1;
 255 #if MALLOC_DEBUG
 256   p->allocated = p->freed = p->old_sizes = p->new_sizes = p->allocations
 257     = p->frees = p->resizes = 0;
 258   strcpy (p->name, name);
 259 #endif
 260   return p;
 261 }
 262
 263 /* malloc_pool_use -- Use an existing pool
 264
 265    mallocPool p;
 266    p = malloc_pool_new(pool);
 267
 268    Increments use count for pool; means a matching malloc_pool_kill must
 269    be performed before a subsequent one will actually kill the pool.  */
 270
 271 mallocPool
 272 malloc_pool_use (mallocPool pool)
 273 {
 274   ++pool->uses;
 275   return pool;
 276 }
 277
 278 /* malloc_display_ -- Display info on a mallocArea_
 279
 280    mallocArea_ a;
 281    malloc_display_(a);
 282
 283    Simple.  */
 284
 285 void
 286 malloc_display_ (mallocArea_ a UNUSED)
 287 {
 288 #if MALLOC_DEBUG
 289   fprintf (dmpout, "At %08lX, size=%" mallocSize_f "u, type=%s, \"%s\"\n",
 290         (unsigned long) a->where, a->size, malloc_types_[a->type], a->name);
 291 #endif
 292 }
 293
 294 /* malloc_find_inpool_ -- Find mallocArea_ for object in pool
 295
 296    mallocPool pool;
 297    void *ptr;
 298    mallocArea_ a;
 299    a = malloc_find_inpool_(pool,ptr);
 300
 301    Search for object in list of mallocArea_s, die if not found.  */
 302
 303 mallocArea_
 304 malloc_find_inpool_ (mallocPool pool, void *ptr)
 305 {
 306   mallocArea_ a;
 307   mallocArea_ b = (mallocArea_) &pool->first;
 308   int n = 0;
 309
 310   for (a = pool->first; a != (mallocArea_) &pool->first; a = a->next)
 311     {
 312       assert (("Infinite loop detected" != NULL) && (a != b));
 313       if (a->where == ptr)
 314         return a;
 315       ++n;
 316       if (n & 1)
 317         b = b->next;
 318     }
 319   assert ("Couldn't find object in pool!" == NULL);
 320   return NULL;
 321 }
 322
 323 /* malloc_kill_inpool_ -- Kill object
 324
 325    malloc_kill_inpool_(NULL,MALLOC_typeUS_,ptr,size_in_bytes);
 326
 327    Find the mallocArea_ for the pointer, make sure the type is proper, and
 328    kill both of them.  */
 329
 330 void
 331 malloc_kill_inpool_ (mallocPool pool, mallocType_ type UNUSED,
 332                      void *ptr, mallocSize s UNUSED)
 333 {
 334   mallocArea_ a;
 335
 336   if (pool == NULL)
 337     pool = malloc_pool_image ();
 338
 339 #if MALLOC_DEBUG
 340   assert ((pool == malloc_pool_image ())
 341           || malloc_pool_find_ (pool, malloc_pool_image ()));
 342 #endif
 343
 344   a = malloc_find_inpool_ (pool, ptr);
 345 #if MALLOC_DEBUG
 346   assert (a->type == type);
 347   if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
 348     assert (a->size == s);
 349 #endif
 350   malloc_kill_area_ (pool, a);
 351 }
 352
 353 /* malloc_new_ -- Allocate new object, die if unable
 354
 355    ptr = malloc_new_(size_in_bytes);
 356
 357    Call malloc, bomb if it returns NULL.  */
 358
 359 void *
 360 malloc_new_ (mallocSize s)
 361 {
 362   void *ptr;
 363   unsigned ss = s;
 364
 365 #if MALLOC_DEBUG && 0
 366   assert (s == (mallocSize) ss);/* Else alloc is too big for this
 367                                    library/sys. */
 368 #endif
 369
 370   ptr = xmalloc (ss);
 371 #if MALLOC_DEBUG
 372   memset (ptr, 126, ss);        /* Catch some kinds of errors more
 373                                    quickly/reliably. */
 374 #endif
 375   return ptr;
 376 }
 377
 378 /* malloc_new_inpool_ -- Allocate new object, die if unable
 379
 380    ptr = malloc_new_inpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes);
 381
 382    Allocate the structure and allocate a mallocArea_ to describe it, then
 383    add it to the list of mallocArea_s for the pool.  */
 384
 385 void *
 386 malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s)
 387 {
 388   void *ptr;
 389   mallocArea_ a;
 390   unsigned short i;
 391
 392   if (pool == NULL)
 393     pool = malloc_pool_image ();
 394
 395 #if MALLOC_DEBUG
 396   assert ((pool == malloc_pool_image ())
 397           || malloc_pool_find_ (pool, malloc_pool_image ()));
 398 #endif
 399
 400   ptr = malloc_new_ (s + (i = (MALLOC_DEBUG ? strlen (name) + 1 : 0)));
 401 #if MALLOC_DEBUG
 402   strcpy (((char *) (ptr)) + s, name);
 403 #endif
 404   a = malloc_new_ (offsetof (struct _malloc_area_, name) + i);
 405   switch (type)
 406     {                           /* A little optimization to speed up killing
 407                                    of non-permanent stuff. */
 408     case MALLOC_typeKP_:
 409     case MALLOC_typeKPR_:
 410       a->next = (mallocArea_) &pool->first;
 411       break;
 412
 413     default:
 414       a->next = pool->first;
 415       break;
 416     }
 417   a->previous = a->next->previous;
 418   a->next->previous = a;
 419   a->previous->next = a;
 420   a->where = ptr;
 421 #if MALLOC_DEBUG
 422   a->size = s;
 423   a->type = type;
 424   strcpy (a->name, name);
 425   pool->allocated += s;
 426   pool->allocations++;
 427 #endif
 428   return ptr;
 429 }
 430
 431 /* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
 432
 433    ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
 434
 435    Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
 436    you pass it a 0).  */
 437
 438 void *
 439 malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s,
 440                      int z)
 441 {
 442   void *ptr;
 443
 444   ptr = malloc_new_inpool_ (pool, type, name, s);
 445   memset (ptr, z, s);
 446   return ptr;
 447 }
 448
 449 /* malloc_pool_find_ -- See if pool is a descendant of another pool
 450
 451    if (malloc_pool_find_(target_pool,parent_pool)) ...;
 452
 453    Recursive descent on each of the children of the parent pool, after
 454    first checking the children themselves.  */
 455
 456 char
 457 malloc_pool_find_ (mallocPool pool, mallocPool parent)
 458 {
 459   mallocPool p;
 460
 461   for (p = parent->eldest; p != (mallocPool) & parent->eldest; p = p->next)
 462     {
 463       if ((p == pool) || malloc_pool_find_ (pool, p))
 464         return 1;
 465     }
 466   return 0;
 467 }
 468
 469 /* malloc_resize_inpool_ -- Resize existing object in pool
 470
 471    ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
 472
 473    Find the object's mallocArea_, check it out, then do the resizing.  */
 474
 475 void *
 476 malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED,
 477                        void *ptr, mallocSize ns, mallocSize os UNUSED)
 478 {
 479   mallocArea_ a;
 480
 481   if (pool == NULL)
 482     pool = malloc_pool_image ();
 483
 484 #if MALLOC_DEBUG
 485   assert ((pool == malloc_pool_image ())
 486           || malloc_pool_find_ (pool, malloc_pool_image ()));
 487 #endif
 488
 489   a = malloc_find_inpool_ (pool, ptr);
 490 #if MALLOC_DEBUG
 491   assert (a->type == type);
 492   if ((type == MALLOC_typeKSR_) || (type == MALLOC_typeKPR_))
 493     assert (a->size == os);
 494   assert (strcmp (a->name, ((char *) (ptr)) + os) == 0);
 495 #endif
 496   ptr = malloc_resize_ (ptr, ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0));
 497   a->where = ptr;
 498 #if MALLOC_DEBUG
 499   a->size = ns;
 500   strcpy (((char *) (ptr)) + ns, a->name);
 501   pool->old_sizes += os;
 502   pool->new_sizes += ns;
 503   pool->resizes++;
 504 #endif
 505   return ptr;
 506 }
 507
 508 /* malloc_resize_ -- Reallocate object, die if unable
 509
 510    ptr = malloc_resize_(ptr,size_in_bytes);
 511
 512    Call realloc, bomb if it returns NULL.  */
 513
 514 void *
 515 malloc_resize_ (void *ptr, mallocSize s)
 516 {
 517   int ss = s;
 518
 519 #if MALLOC_DEBUG && 0
 520   assert (s == (mallocSize) ss);/* Too big if failure here. */
 521 #endif
 522
 523   ptr = xrealloc (ptr, ss);
 524   return ptr;
 525 }
 526
 527 /* malloc_verify_inpool_ -- Verify object
 528
 529    Find the mallocArea_ for the pointer, make sure the type is proper, and
 530    verify both of them.  */
 531
 532 void
 533 malloc_verify_inpool_ (mallocPool pool UNUSED, mallocType_ type UNUSED,
 534                        void *ptr UNUSED, mallocSize s UNUSED)
 535 {
 536 #if MALLOC_DEBUG
 537   mallocArea_ a;
 538
 539   if (pool == NULL)
 540     pool = malloc_pool_image ();
 541
 542   assert ((pool == malloc_pool_image ())
 543           || malloc_pool_find_ (pool, malloc_pool_image ()));
 544
 545   a = malloc_find_inpool_ (pool, ptr);
 546   assert (a->type == type);
 547   if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
 548     assert (a->size == s);
 549   malloc_verify_area_ (pool, a);
 550 #endif
 551 }