contrib/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 *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_ = malloc (20 * 1024); /* In case of crash, free this first. */
 144   assert (malloc_reserve_ != NULL);
 145 }
 146
 147 /* malloc_pool_display -- Display a pool
 148
 149    mallocPool p;
 150    malloc_pool_display(p);
 151
 152    Displays information associated with the pool and its subpools.  */
 153
 154 void
 155 malloc_pool_display (mallocPool p UNUSED)
 156 {
 157 #if MALLOC_DEBUG
 158   mallocPool q;
 159   mallocArea_ a;
 160
 161   fprintf (dmpout, "Pool \"%s\": bytes allocated=%lu, freed=%lu, old sizes=%lu, new sizes\
 162 =%lu,\n   allocations=%lu, frees=%lu, resizes=%lu, uses=%lu\n   Subpools:\n",
 163            p->name, p->allocated, p->freed, p->old_sizes, p->new_sizes, p->allocations,
 164            p->frees, p->resizes, p->uses);
 165
 166   for (q = p->eldest; q != (mallocPool) & p->eldest; q = q->next)
 167     fprintf (dmpout, "      \"%s\"\n", q->name);
 168
 169   fprintf (dmpout, "   Storage areas:\n");
 170
 171   for (a = p->first; a != (mallocArea_) & p->first; a = a->next)
 172     {
 173       fprintf (dmpout, "      ");
 174       malloc_display_ (a);
 175     }
 176 #endif
 177 }
 178
 179 /* malloc_pool_kill -- Destroy a pool
 180
 181    mallocPool p;
 182    malloc_pool_kill(p);
 183
 184    Releases all storage associated with the pool and its subpools.  */
 185
 186 void
 187 malloc_pool_kill (mallocPool p)
 188 {
 189   mallocPool q;
 190   mallocArea_ a;
 191
 192   if (--p->uses != 0)
 193     return;
 194
 195 #if 0
 196   malloc_pool_display (p);
 197 #endif
 198
 199   assert (p->next->previous == p);
 200   assert (p->previous->next == p);
 201
 202   /* Kill off all the subpools. */
 203
 204   while ((q = p->eldest) != (mallocPool) &p->eldest)
 205     {
 206       q->uses = 1;              /* Force the kill. */
 207       malloc_pool_kill (q);
 208     }
 209
 210   /* Now free all the storage areas. */
 211
 212   while ((a = p->first) != (mallocArea_) & p->first)
 213     {
 214       malloc_kill_area_ (p, a);
 215     }
 216
 217   /* Now remove from list of sibling pools. */
 218
 219   p->next->previous = p->previous;
 220   p->previous->next = p->next;
 221
 222   /* Finally, free the pool itself. */
 223
 224   malloc_kill_ (p,
 225                 offsetof (struct _malloc_pool_, name)
 226                 + strlen (p->name) + 1);
 227 }
 228
 229 /* malloc_pool_new -- Make a new pool
 230
 231    mallocPool p;
 232    p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
 233
 234    Makes a new pool with the given name and default new-chunk allocation.  */
 235
 236 mallocPool
 237 malloc_pool_new (const char *name, mallocPool parent,
 238                  unsigned long chunks UNUSED)
 239 {
 240   mallocPool p;
 241
 242   if (parent == NULL)
 243     parent = malloc_pool_image ();
 244
 245   p = malloc_new_ (offsetof (struct _malloc_pool_, name)
 246                    + (MALLOC_DEBUG ? strlen (name) + 1 : 0));
 247   p->next = (mallocPool) &(parent->eldest);
 248   p->previous = parent->youngest;
 249   parent->youngest->next = p;
 250   parent->youngest = p;
 251   p->eldest = (mallocPool) &(p->eldest);
 252   p->youngest = (mallocPool) &(p->eldest);
 253   p->first = (mallocArea_) &(p->first);
 254   p->last = (mallocArea_) &(p->first);
 255   p->uses = 1;
 256 #if MALLOC_DEBUG
 257   p->allocated = p->freed = p->old_sizes = p->new_sizes = p->allocations
 258     = p->frees = p->resizes = 0;
 259   strcpy (p->name, name);
 260 #endif
 261   return p;
 262 }
 263
 264 /* malloc_pool_use -- Use an existing pool
 265
 266    mallocPool p;
 267    p = malloc_pool_new(pool);
 268
 269    Increments use count for pool; means a matching malloc_pool_kill must
 270    be performed before a subsequent one will actually kill the pool.  */
 271
 272 mallocPool
 273 malloc_pool_use (mallocPool pool)
 274 {
 275   ++pool->uses;
 276   return pool;
 277 }
 278
 279 /* malloc_display_ -- Display info on a mallocArea_
 280
 281    mallocArea_ a;
 282    malloc_display_(a);
 283
 284    Simple.  */
 285
 286 void
 287 malloc_display_ (mallocArea_ a UNUSED)
 288 {
 289 #if MALLOC_DEBUG
 290   fprintf (dmpout, "At %08lX, size=%" mallocSize_f "u, type=%s, \"%s\"\n",
 291         (unsigned long) a->where, a->size, malloc_types_[a->type], a->name);
 292 #endif
 293 }
 294
 295 /* malloc_find_inpool_ -- Find mallocArea_ for object in pool
 296
 297    mallocPool pool;
 298    void *ptr;
 299    mallocArea_ a;
 300    a = malloc_find_inpool_(pool,ptr);
 301
 302    Search for object in list of mallocArea_s, die if not found.  */
 303
 304 mallocArea_
 305 malloc_find_inpool_ (mallocPool pool, void *ptr)
 306 {
 307   mallocArea_ a;
 308   mallocArea_ b = (mallocArea_) &pool->first;
 309   int n = 0;
 310
 311   for (a = pool->first; a != (mallocArea_) &pool->first; a = a->next)
 312     {
 313       assert (("Infinite loop detected" != NULL) && (a != b));
 314       if (a->where == ptr)
 315         return a;
 316       ++n;
 317       if (n & 1)
 318         b = b->next;
 319     }
 320   assert ("Couldn't find object in pool!" == NULL);
 321   return NULL;
 322 }
 323
 324 /* malloc_kill_inpool_ -- Kill object
 325
 326    malloc_kill_inpool_(NULL,MALLOC_typeUS_,ptr,size_in_bytes);
 327
 328    Find the mallocArea_ for the pointer, make sure the type is proper, and
 329    kill both of them.  */
 330
 331 void
 332 malloc_kill_inpool_ (mallocPool pool, mallocType_ type UNUSED,
 333                      void *ptr, mallocSize s UNUSED)
 334 {
 335   mallocArea_ a;
 336
 337   if (pool == NULL)
 338     pool = malloc_pool_image ();
 339
 340 #if MALLOC_DEBUG
 341   assert ((pool == malloc_pool_image ())
 342           || malloc_pool_find_ (pool, malloc_pool_image ()));
 343 #endif
 344
 345   a = malloc_find_inpool_ (pool, ptr);
 346 #if MALLOC_DEBUG
 347   assert (a->type == type);
 348   if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
 349     assert (a->size == s);
 350 #endif
 351   malloc_kill_area_ (pool, a);
 352 }
 353
 354 /* malloc_new_ -- Allocate new object, die if unable
 355
 356    ptr = malloc_new_(size_in_bytes);
 357
 358    Call malloc, bomb if it returns NULL.  */
 359
 360 void *
 361 malloc_new_ (mallocSize s)
 362 {
 363   void *ptr;
 364   unsigned ss = s;
 365
 366 #if MALLOC_DEBUG && 0
 367   assert (s == (mallocSize) ss);/* Else alloc is too big for this
 368                                    library/sys. */
 369 #endif
 370
 371   ptr = xmalloc (ss);
 372 #if MALLOC_DEBUG
 373   memset (ptr, 126, ss);        /* Catch some kinds of errors more
 374                                    quickly/reliably. */
 375 #endif
 376   return ptr;
 377 }
 378
 379 /* malloc_new_inpool_ -- Allocate new object, die if unable
 380
 381    ptr = malloc_new_inpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes);
 382
 383    Allocate the structure and allocate a mallocArea_ to describe it, then
 384    add it to the list of mallocArea_s for the pool.  */
 385
 386 void *
 387 malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s)
 388 {
 389   void *ptr;
 390   mallocArea_ a;
 391   unsigned short i;
 392
 393   if (pool == NULL)
 394     pool = malloc_pool_image ();
 395
 396 #if MALLOC_DEBUG
 397   assert ((pool == malloc_pool_image ())
 398           || malloc_pool_find_ (pool, malloc_pool_image ()));
 399 #endif
 400
 401   ptr = malloc_new_ (s + (i = (MALLOC_DEBUG ? strlen (name) + 1 : 0)));
 402 #if MALLOC_DEBUG
 403   strcpy (((char *) (ptr)) + s, name);
 404 #endif
 405   a = malloc_new_ (offsetof (struct _malloc_area_, name) + i);
 406   switch (type)
 407     {                           /* A little optimization to speed up killing
 408                                    of non-permanent stuff. */
 409     case MALLOC_typeKP_:
 410     case MALLOC_typeKPR_:
 411       a->next = (mallocArea_) &pool->first;
 412       break;
 413
 414     default:
 415       a->next = pool->first;
 416       break;
 417     }
 418   a->previous = a->next->previous;
 419   a->next->previous = a;
 420   a->previous->next = a;
 421   a->where = ptr;
 422 #if MALLOC_DEBUG
 423   a->size = s;
 424   a->type = type;
 425   strcpy (a->name, name);
 426   pool->allocated += s;
 427   pool->allocations++;
 428 #endif
 429   return ptr;
 430 }
 431
 432 /* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
 433
 434    ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
 435
 436    Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
 437    you pass it a 0).  */
 438
 439 void *
 440 malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s,
 441                      int z)
 442 {
 443   void *ptr;
 444
 445   ptr = malloc_new_inpool_ (pool, type, name, s);
 446   memset (ptr, z, s);
 447   return ptr;
 448 }
 449
 450 /* malloc_pool_find_ -- See if pool is a descendant of another pool
 451
 452    if (malloc_pool_find_(target_pool,parent_pool)) ...;
 453
 454    Recursive descent on each of the children of the parent pool, after
 455    first checking the children themselves.  */
 456
 457 char
 458 malloc_pool_find_ (mallocPool pool, mallocPool parent)
 459 {
 460   mallocPool p;
 461
 462   for (p = parent->eldest; p != (mallocPool) & parent->eldest; p = p->next)
 463     {
 464       if ((p == pool) || malloc_pool_find_ (pool, p))
 465         return 1;
 466     }
 467   return 0;
 468 }
 469
 470 /* malloc_resize_inpool_ -- Resize existing object in pool
 471
 472    ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
 473
 474    Find the object's mallocArea_, check it out, then do the resizing.  */
 475
 476 void *
 477 malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED,
 478                        void *ptr, mallocSize ns, mallocSize os UNUSED)
 479 {
 480   mallocArea_ a;
 481
 482   if (pool == NULL)
 483     pool = malloc_pool_image ();
 484
 485 #if MALLOC_DEBUG
 486   assert ((pool == malloc_pool_image ())
 487           || malloc_pool_find_ (pool, malloc_pool_image ()));
 488 #endif
 489
 490   a = malloc_find_inpool_ (pool, ptr);
 491 #if MALLOC_DEBUG
 492   assert (a->type == type);
 493   if ((type == MALLOC_typeKSR_) || (type == MALLOC_typeKPR_))
 494     assert (a->size == os);
 495   assert (strcmp (a->name, ((char *) (ptr)) + os) == 0);
 496 #endif
 497   ptr = malloc_resize_ (ptr, ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0));
 498   a->where = ptr;
 499 #if MALLOC_DEBUG
 500   a->size = ns;
 501   strcpy (((char *) (ptr)) + ns, a->name);
 502   pool->old_sizes += os;
 503   pool->new_sizes += ns;
 504   pool->resizes++;
 505 #endif
 506   return ptr;
 507 }
 508
 509 /* malloc_resize_ -- Reallocate object, die if unable
 510
 511    ptr = malloc_resize_(ptr,size_in_bytes);
 512
 513    Call realloc, bomb if it returns NULL.  */
 514
 515 void *
 516 malloc_resize_ (void *ptr, mallocSize s)
 517 {
 518   int ss = s;
 519
 520 #if MALLOC_DEBUG && 0
 521   assert (s == (mallocSize) ss);/* Too big if failure here. */
 522 #endif
 523
 524   ptr = xrealloc (ptr, ss);
 525   return ptr;
 526 }
 527
 528 /* malloc_verify_inpool_ -- Verify object
 529
 530    Find the mallocArea_ for the pointer, make sure the type is proper, and
 531    verify both of them.  */
 532
 533 void
 534 malloc_verify_inpool_ (mallocPool pool UNUSED, mallocType_ type UNUSED,
 535                        void *ptr UNUSED, mallocSize s UNUSED)
 536 {
 537 #if MALLOC_DEBUG
 538   mallocArea_ a;
 539
 540   if (pool == NULL)
 541     pool = malloc_pool_image ();
 542
 543   assert ((pool == malloc_pool_image ())
 544           || malloc_pool_find_ (pool, malloc_pool_image ()));
 545
 546   a = malloc_find_inpool_ (pool, ptr);
 547   assert (a->type == type);
 548   if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
 549     assert (a->size == s);
 550   malloc_verify_area_ (pool, a);
 551 #endif
 552 }