1 /* malloc.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
5 This file is part of GNU Fortran.
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)
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.
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
26 Fast pool-based memory allocation.
36 /* Externals defined here. */
38 struct _malloc_root_ malloc_root_
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
,
50 0, 0, 0, 0, 0, 0, 0, { '/' }
57 /* Simple definitions and enumerations. */
60 /* Internal typedefs. */
63 /* Private include files. */
66 /* Internal structure definitions. */
69 /* Static objects accessed by functions in this module. */
71 static void *malloc_reserve_
= NULL
; /* For crashes. */
73 static const char *malloc_types_
[] =
74 {"KS", "KSR", "NF", "NFR", "US", "USR"};
77 /* Static functions (internal). */
79 static void malloc_kill_area_ (mallocPool pool
, mallocArea_ a
);
81 static void malloc_verify_area_ (mallocPool pool
, mallocArea_ a
);
84 /* Internal macros. */
87 #define malloc_kill_(ptr,s) do {memset((ptr),127,(s));free((ptr));} while(0)
89 #define malloc_kill_(ptr,s) free((ptr))
92 /* malloc_kill_area_ -- Kill storage area and its object
94 malloc_kill_area_(mallocPool pool,mallocArea_ area);
96 Does the actual killing of a storage area. */
99 malloc_kill_area_ (mallocPool pool UNUSED
, mallocArea_ a
)
102 assert (strcmp (a
->name
, ((char *) (a
->where
)) + a
->size
) == 0);
104 malloc_kill_ (a
->where
, a
->size
);
105 a
->next
->previous
= a
->previous
;
106 a
->previous
->next
= a
->next
;
108 pool
->freed
+= a
->size
;
112 offsetof (struct _malloc_area_
, name
)
113 + strlen (a
->name
) + 1);
116 /* malloc_verify_area_ -- Verify storage area and its object
118 malloc_verify_area_(mallocPool pool,mallocArea_ area);
120 Does the actual verifying of a storage area. */
124 malloc_verify_area_ (mallocPool pool UNUSED
, mallocArea_ a UNUSED
)
126 mallocSize s
= a
->size
;
128 assert (strcmp (a
->name
, ((char *) (a
->where
)) + s
) == 0);
132 /* malloc_init -- Initialize malloc cluster
136 Call malloc_init before you do anything else. */
141 if (malloc_reserve_
!= NULL
)
143 malloc_reserve_
= malloc (20 * 1024); /* In case of crash, free this first. */
144 assert (malloc_reserve_
!= NULL
);
147 /* malloc_pool_display -- Display a pool
150 malloc_pool_display(p);
152 Displays information associated with the pool and its subpools. */
155 malloc_pool_display (mallocPool p UNUSED
)
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
);
166 for (q
= p
->eldest
; q
!= (mallocPool
) & p
->eldest
; q
= q
->next
)
167 fprintf (dmpout
, " \"%s\"\n", q
->name
);
169 fprintf (dmpout
, " Storage areas:\n");
171 for (a
= p
->first
; a
!= (mallocArea_
) & p
->first
; a
= a
->next
)
173 fprintf (dmpout
, " ");
179 /* malloc_pool_kill -- Destroy a pool
184 Releases all storage associated with the pool and its subpools. */
187 malloc_pool_kill (mallocPool p
)
196 malloc_pool_display (p
);
199 assert (p
->next
->previous
== p
);
200 assert (p
->previous
->next
== p
);
202 /* Kill off all the subpools. */
204 while ((q
= p
->eldest
) != (mallocPool
) &p
->eldest
)
206 q
->uses
= 1; /* Force the kill. */
207 malloc_pool_kill (q
);
210 /* Now free all the storage areas. */
212 while ((a
= p
->first
) != (mallocArea_
) & p
->first
)
214 malloc_kill_area_ (p
, a
);
217 /* Now remove from list of sibling pools. */
219 p
->next
->previous
= p
->previous
;
220 p
->previous
->next
= p
->next
;
222 /* Finally, free the pool itself. */
225 offsetof (struct _malloc_pool_
, name
)
226 + strlen (p
->name
) + 1);
229 /* malloc_pool_new -- Make a new pool
232 p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
234 Makes a new pool with the given name and default new-chunk allocation. */
237 malloc_pool_new (const char *name
, mallocPool parent
,
238 unsigned long chunks UNUSED
)
243 parent
= malloc_pool_image ();
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
);
257 p
->allocated
= p
->freed
= p
->old_sizes
= p
->new_sizes
= p
->allocations
258 = p
->frees
= p
->resizes
= 0;
259 strcpy (p
->name
, name
);
264 /* malloc_pool_use -- Use an existing pool
267 p = malloc_pool_new(pool);
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. */
273 malloc_pool_use (mallocPool pool
)
279 /* malloc_display_ -- Display info on a mallocArea_
287 malloc_display_ (mallocArea_ a UNUSED
)
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
);
295 /* malloc_find_inpool_ -- Find mallocArea_ for object in pool
300 a = malloc_find_inpool_(pool,ptr);
302 Search for object in list of mallocArea_s, die if not found. */
305 malloc_find_inpool_ (mallocPool pool
, void *ptr
)
308 mallocArea_ b
= (mallocArea_
) &pool
->first
;
311 for (a
= pool
->first
; a
!= (mallocArea_
) &pool
->first
; a
= a
->next
)
313 assert (("Infinite loop detected" != NULL
) && (a
!= b
));
320 assert ("Couldn't find object in pool!" == NULL
);
324 /* malloc_kill_inpool_ -- Kill object
326 malloc_kill_inpool_(NULL,MALLOC_typeUS_,ptr,size_in_bytes);
328 Find the mallocArea_ for the pointer, make sure the type is proper, and
329 kill both of them. */
332 malloc_kill_inpool_ (mallocPool pool
, mallocType_ type UNUSED
,
333 void *ptr
, mallocSize s UNUSED
)
338 pool
= malloc_pool_image ();
341 assert ((pool
== malloc_pool_image ())
342 || malloc_pool_find_ (pool
, malloc_pool_image ()));
345 a
= malloc_find_inpool_ (pool
, ptr
);
347 assert (a
->type
== type
);
348 if ((type
!= MALLOC_typeUS_
) && (type
!= MALLOC_typeUSR_
))
349 assert (a
->size
== s
);
351 malloc_kill_area_ (pool
, a
);
354 /* malloc_new_ -- Allocate new object, die if unable
356 ptr = malloc_new_(size_in_bytes);
358 Call malloc, bomb if it returns NULL. */
361 malloc_new_ (mallocSize s
)
366 #if MALLOC_DEBUG && 0
367 assert (s
== (mallocSize
) ss
);/* Else alloc is too big for this
373 memset (ptr
, 126, ss
); /* Catch some kinds of errors more
379 /* malloc_new_inpool_ -- Allocate new object, die if unable
381 ptr = malloc_new_inpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes);
383 Allocate the structure and allocate a mallocArea_ to describe it, then
384 add it to the list of mallocArea_s for the pool. */
387 malloc_new_inpool_ (mallocPool pool
, mallocType_ type
, const char *name
, mallocSize s
)
394 pool
= malloc_pool_image ();
397 assert ((pool
== malloc_pool_image ())
398 || malloc_pool_find_ (pool
, malloc_pool_image ()));
401 ptr
= malloc_new_ (s
+ (i
= (MALLOC_DEBUG
? strlen (name
) + 1 : 0)));
403 strcpy (((char *) (ptr
)) + s
, name
);
405 a
= malloc_new_ (offsetof (struct _malloc_area_
, name
) + i
);
407 { /* A little optimization to speed up killing
408 of non-permanent stuff. */
410 case MALLOC_typeKPR_
:
411 a
->next
= (mallocArea_
) &pool
->first
;
415 a
->next
= pool
->first
;
418 a
->previous
= a
->next
->previous
;
419 a
->next
->previous
= a
;
420 a
->previous
->next
= a
;
425 strcpy (a
->name
, name
);
426 pool
->allocated
+= s
;
432 /* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
434 ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
436 Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
440 malloc_new_zinpool_ (mallocPool pool
, mallocType_ type
, const char *name
, mallocSize s
,
445 ptr
= malloc_new_inpool_ (pool
, type
, name
, s
);
450 /* malloc_pool_find_ -- See if pool is a descendant of another pool
452 if (malloc_pool_find_(target_pool,parent_pool)) ...;
454 Recursive descent on each of the children of the parent pool, after
455 first checking the children themselves. */
458 malloc_pool_find_ (mallocPool pool
, mallocPool parent
)
462 for (p
= parent
->eldest
; p
!= (mallocPool
) & parent
->eldest
; p
= p
->next
)
464 if ((p
== pool
) || malloc_pool_find_ (pool
, p
))
470 /* malloc_resize_inpool_ -- Resize existing object in pool
472 ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
474 Find the object's mallocArea_, check it out, then do the resizing. */
477 malloc_resize_inpool_ (mallocPool pool
, mallocType_ type UNUSED
,
478 void *ptr
, mallocSize ns
, mallocSize os UNUSED
)
483 pool
= malloc_pool_image ();
486 assert ((pool
== malloc_pool_image ())
487 || malloc_pool_find_ (pool
, malloc_pool_image ()));
490 a
= malloc_find_inpool_ (pool
, ptr
);
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);
497 ptr
= malloc_resize_ (ptr
, ns
+ (MALLOC_DEBUG
? strlen (a
->name
) + 1: 0));
501 strcpy (((char *) (ptr
)) + ns
, a
->name
);
502 pool
->old_sizes
+= os
;
503 pool
->new_sizes
+= ns
;
509 /* malloc_resize_ -- Reallocate object, die if unable
511 ptr = malloc_resize_(ptr,size_in_bytes);
513 Call realloc, bomb if it returns NULL. */
516 malloc_resize_ (void *ptr
, mallocSize s
)
520 #if MALLOC_DEBUG && 0
521 assert (s
== (mallocSize
) ss
);/* Too big if failure here. */
524 ptr
= xrealloc (ptr
, ss
);
528 /* malloc_verify_inpool_ -- Verify object
530 Find the mallocArea_ for the pointer, make sure the type is proper, and
531 verify both of them. */
534 malloc_verify_inpool_ (mallocPool pool UNUSED
, mallocType_ type UNUSED
,
535 void *ptr UNUSED
, mallocSize s UNUSED
)
541 pool
= malloc_pool_image ();
543 assert ((pool
== malloc_pool_image ())
544 || malloc_pool_find_ (pool
, malloc_pool_image ()));
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
);