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