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 5This file is part of GNU Fortran. 6 7GNU Fortran is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Fortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Fortran; see the file COPYING. If not, write to 19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 2002111-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 38struct _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 71static void *malloc_reserve_ = NULL; /* For crashes. */ 72#if MALLOC_DEBUG 73static const char *malloc_types_[] = 74{"KS", "KSR", "NF", "NFR", "US", "USR"}; 75#endif 76 77/* Static functions (internal). */ 78 79static void malloc_kill_area_ (mallocPool pool, mallocArea_ a); 80#if MALLOC_DEBUG 81static 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 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 98static void 99malloc_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 123static void 124malloc_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 138void 139malloc_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 154void 155malloc_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 186void 187malloc_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 236mallocPool 237malloc_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 272mallocPool 273malloc_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 286void 287malloc_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 304mallocArea_ 305malloc_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 331void 332malloc_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 360void * 361malloc_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 386void * 387malloc_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 439void * 440malloc_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 457char 458malloc_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 476void * 477malloc_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 515void * 516malloc_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 533void 534malloc_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} 553