1 /* malloc.c -- Implementation File (module.c template V1.0)
2    Copyright (C) 1995, 2003 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 struct max_alignment {
87   char c;
88   union {
89     HOST_WIDEST_INT i;
90     long double d;
91   } u;
92 };
93 
94 #define MAX_ALIGNMENT (offsetof (struct max_alignment, u))
95 #define ROUNDED_AREA_SIZE (MAX_ALIGNMENT * ((sizeof(mallocArea_) + MAX_ALIGNMENT - 1) / MAX_ALIGNMENT))
96 
97 #if MALLOC_DEBUG
98 #define malloc_kill_(ptr,s) do {memset((ptr),127,(s));free((ptr));} while(0)
99 #else
100 #define malloc_kill_(ptr,s) free((ptr))
101 #endif
102 
103 /* malloc_kill_area_ -- Kill storage area and its object
104 
105    malloc_kill_area_(mallocPool pool,mallocArea_ area);
106 
107    Does the actual killing of a storage area.  */
108 
109 static void
malloc_kill_area_(mallocPool pool UNUSED,mallocArea_ a)110 malloc_kill_area_ (mallocPool pool UNUSED, mallocArea_ a)
111 {
112 #if MALLOC_DEBUG
113   assert (strcmp (a->name, ((char *) (a->where)) + a->size) == 0);
114 #endif
115   malloc_kill_ (a->where - ROUNDED_AREA_SIZE, a->size);
116   a->next->previous = a->previous;
117   a->previous->next = a->next;
118 #if MALLOC_DEBUG
119   pool->freed += a->size;
120   pool->frees++;
121 #endif
122 
123   malloc_kill_ (a,
124 		offsetof (struct _malloc_area_, name)
125 		+ strlen (a->name) + 1);
126 }
127 
128 /* malloc_verify_area_ -- Verify storage area and its object
129 
130    malloc_verify_area_(mallocPool pool,mallocArea_ area);
131 
132    Does the actual verifying of a storage area.  */
133 
134 #if MALLOC_DEBUG
135 static void
malloc_verify_area_(mallocPool pool UNUSED,mallocArea_ a UNUSED)136 malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a UNUSED)
137 {
138   mallocSize s = a->size;
139 
140   assert (strcmp (a->name, ((char *) (a->where)) + s) == 0);
141 }
142 #endif
143 
144 /* malloc_init -- Initialize malloc cluster
145 
146    malloc_init();
147 
148    Call malloc_init before you do anything else.  */
149 
150 void
malloc_init(void)151 malloc_init (void)
152 {
153   if (malloc_reserve_ != NULL)
154     return;
155   malloc_reserve_ = xmalloc (20 * 1024); /* In case of crash, free this first. */
156 }
157 
158 /* malloc_pool_display -- Display a pool
159 
160    mallocPool p;
161    malloc_pool_display(p);
162 
163    Displays information associated with the pool and its subpools.  */
164 
165 void
malloc_pool_display(mallocPool p UNUSED)166 malloc_pool_display (mallocPool p UNUSED)
167 {
168 #if MALLOC_DEBUG
169   mallocPool q;
170   mallocArea_ a;
171 
172   fprintf (dmpout, "Pool \"%s\": bytes allocated=%lu, freed=%lu, old sizes=%lu, new sizes\
173 =%lu,\n   allocations=%lu, frees=%lu, resizes=%lu, uses=%lu\n   Subpools:\n",
174 	   p->name, p->allocated, p->freed, p->old_sizes, p->new_sizes, p->allocations,
175 	   p->frees, p->resizes, p->uses);
176 
177   for (q = p->eldest; q != (mallocPool) & p->eldest; q = q->next)
178     fprintf (dmpout, "      \"%s\"\n", q->name);
179 
180   fprintf (dmpout, "   Storage areas:\n");
181 
182   for (a = p->first; a != (mallocArea_) & p->first; a = a->next)
183     {
184       fprintf (dmpout, "      ");
185       malloc_display_ (a);
186     }
187 #endif
188 }
189 
190 /* malloc_pool_kill -- Destroy a pool
191 
192    mallocPool p;
193    malloc_pool_kill(p);
194 
195    Releases all storage associated with the pool and its subpools.  */
196 
197 void
malloc_pool_kill(mallocPool p)198 malloc_pool_kill (mallocPool p)
199 {
200   mallocPool q;
201   mallocArea_ a;
202 
203   if (--p->uses != 0)
204     return;
205 
206 #if 0
207   malloc_pool_display (p);
208 #endif
209 
210   assert (p->next->previous == p);
211   assert (p->previous->next == p);
212 
213   /* Kill off all the subpools. */
214 
215   while ((q = p->eldest) != (mallocPool) &p->eldest)
216     {
217       q->uses = 1;		/* Force the kill. */
218       malloc_pool_kill (q);
219     }
220 
221   /* Now free all the storage areas. */
222 
223   while ((a = p->first) != (mallocArea_) & p->first)
224     {
225       malloc_kill_area_ (p, a);
226     }
227 
228   /* Now remove from list of sibling pools. */
229 
230   p->next->previous = p->previous;
231   p->previous->next = p->next;
232 
233   /* Finally, free the pool itself. */
234 
235   malloc_kill_ (p,
236 		offsetof (struct _malloc_pool_, name)
237 		+ strlen (p->name) + 1);
238 }
239 
240 /* malloc_pool_new -- Make a new pool
241 
242    mallocPool p;
243    p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
244 
245    Makes a new pool with the given name and default new-chunk allocation.  */
246 
247 mallocPool
malloc_pool_new(const char * name,mallocPool parent,unsigned long chunks UNUSED)248 malloc_pool_new (const char *name, mallocPool parent,
249 		 unsigned long chunks UNUSED)
250 {
251   mallocPool p;
252 
253   if (parent == NULL)
254     parent = malloc_pool_image ();
255 
256   p = malloc_new_ (offsetof (struct _malloc_pool_, name)
257 		   + (MALLOC_DEBUG ? strlen (name) + 1 : 0));
258   p->next = (mallocPool) &(parent->eldest);
259   p->previous = parent->youngest;
260   parent->youngest->next = p;
261   parent->youngest = p;
262   p->eldest = (mallocPool) &(p->eldest);
263   p->youngest = (mallocPool) &(p->eldest);
264   p->first = (mallocArea_) &(p->first);
265   p->last = (mallocArea_) &(p->first);
266   p->uses = 1;
267 #if MALLOC_DEBUG
268   p->allocated = p->freed = p->old_sizes = p->new_sizes = p->allocations
269     = p->frees = p->resizes = 0;
270   strcpy (p->name, name);
271 #endif
272   return p;
273 }
274 
275 /* malloc_pool_use -- Use an existing pool
276 
277    mallocPool p;
278    p = malloc_pool_new(pool);
279 
280    Increments use count for pool; means a matching malloc_pool_kill must
281    be performed before a subsequent one will actually kill the pool.  */
282 
283 mallocPool
malloc_pool_use(mallocPool pool)284 malloc_pool_use (mallocPool pool)
285 {
286   ++pool->uses;
287   return pool;
288 }
289 
290 /* malloc_display_ -- Display info on a mallocArea_
291 
292    mallocArea_ a;
293    malloc_display_(a);
294 
295    Simple.  */
296 
297 void
malloc_display_(mallocArea_ a UNUSED)298 malloc_display_ (mallocArea_ a UNUSED)
299 {
300 #if MALLOC_DEBUG
301   fprintf (dmpout, "At %08lX, size=%" mallocSize_f "u, type=%s, \"%s\"\n",
302 	(unsigned long) a->where, a->size, malloc_types_[a->type], a->name);
303 #endif
304 }
305 
306 /* malloc_find_inpool_ -- Find mallocArea_ for object in pool
307 
308    mallocPool pool;
309    void *ptr;
310    mallocArea_ a;
311    a = malloc_find_inpool_(pool,ptr);
312 
313    Search for object in list of mallocArea_s, die if not found.	 */
314 
315 mallocArea_
malloc_find_inpool_(mallocPool pool UNUSED,void * ptr)316 malloc_find_inpool_ (mallocPool pool UNUSED, void *ptr)
317 {
318   mallocArea_ *t;
319   t = (mallocArea_ *) (ptr - ROUNDED_AREA_SIZE);
320   return *t;
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
malloc_kill_inpool_(mallocPool pool,mallocType_ type UNUSED,void * ptr,mallocSize s UNUSED)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 *
malloc_new_(mallocSize s)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 *
malloc_new_inpool_(mallocPool pool,mallocType_ type,const char * name,mallocSize s)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   mallocArea_ *temp;
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_ (ROUNDED_AREA_SIZE + 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   temp = (mallocArea_ *) ptr;
407   *temp = a;
408   ptr = ptr + ROUNDED_AREA_SIZE;
409   switch (type)
410     {				/* A little optimization to speed up killing
411 				   of non-permanent stuff. */
412     case MALLOC_typeKP_:
413     case MALLOC_typeKPR_:
414       a->next = (mallocArea_) &pool->first;
415       break;
416 
417     default:
418       a->next = pool->first;
419       break;
420     }
421   a->previous = a->next->previous;
422   a->next->previous = a;
423   a->previous->next = a;
424   a->where = ptr;
425 #if MALLOC_DEBUG
426   a->size = s;
427   a->type = type;
428   strcpy (a->name, name);
429   pool->allocated += s;
430   pool->allocations++;
431 #endif
432   return ptr;
433 }
434 
435 /* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
436 
437    ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
438 
439    Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
440    you pass it a 0).  */
441 
442 void *
malloc_new_zinpool_(mallocPool pool,mallocType_ type,const char * name,mallocSize s,int z)443 malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s,
444 		     int z)
445 {
446   void *ptr;
447 
448   ptr = malloc_new_inpool_ (pool, type, name, s);
449   memset (ptr, z, s);
450   return ptr;
451 }
452 
453 /* malloc_pool_find_ -- See if pool is a descendant of another pool
454 
455    if (malloc_pool_find_(target_pool,parent_pool)) ...;
456 
457    Recursive descent on each of the children of the parent pool, after
458    first checking the children themselves.  */
459 
460 char
malloc_pool_find_(mallocPool pool,mallocPool parent)461 malloc_pool_find_ (mallocPool pool, mallocPool parent)
462 {
463   mallocPool p;
464 
465   for (p = parent->eldest; p != (mallocPool) & parent->eldest; p = p->next)
466     {
467       if ((p == pool) || malloc_pool_find_ (pool, p))
468 	return 1;
469     }
470   return 0;
471 }
472 
473 /* malloc_resize_inpool_ -- Resize existing object in pool
474 
475    ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
476 
477    Find the object's mallocArea_, check it out, then do the resizing.  */
478 
479 void *
malloc_resize_inpool_(mallocPool pool,mallocType_ type UNUSED,void * ptr,mallocSize ns,mallocSize os UNUSED)480 malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED,
481 		       void *ptr, mallocSize ns, mallocSize os UNUSED)
482 {
483   mallocArea_ a;
484   mallocArea_ *temp;
485 
486   if (pool == NULL)
487     pool = malloc_pool_image ();
488 
489 #if MALLOC_DEBUG
490   assert ((pool == malloc_pool_image ())
491 	  || malloc_pool_find_ (pool, malloc_pool_image ()));
492 #endif
493 
494   a = malloc_find_inpool_ (pool, ptr);
495 #if MALLOC_DEBUG
496   assert (a->type == type);
497   if ((type == MALLOC_typeKSR_) || (type == MALLOC_typeKPR_))
498     assert (a->size == os);
499   assert (strcmp (a->name, ((char *) (ptr)) + os) == 0);
500 #endif
501   ptr = malloc_resize_ (ptr - ROUNDED_AREA_SIZE, ROUNDED_AREA_SIZE + ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0));
502   temp = (mallocArea_ *) ptr;
503   *temp = a;
504   ptr = ptr + ROUNDED_AREA_SIZE;
505   a->where = ptr;
506 #if MALLOC_DEBUG
507   a->size = ns;
508   strcpy (((char *) (ptr)) + ns, a->name);
509   pool->old_sizes += os;
510   pool->new_sizes += ns;
511   pool->resizes++;
512 #endif
513   return ptr;
514 }
515 
516 /* malloc_resize_ -- Reallocate object, die if unable
517 
518    ptr = malloc_resize_(ptr,size_in_bytes);
519 
520    Call realloc, bomb if it returns NULL.  */
521 
522 void *
malloc_resize_(void * ptr,mallocSize s)523 malloc_resize_ (void *ptr, mallocSize s)
524 {
525   int ss = s;
526 
527 #if MALLOC_DEBUG && 0
528   assert (s == (mallocSize) ss);/* Too big if failure here. */
529 #endif
530 
531   ptr = xrealloc (ptr, ss);
532   return ptr;
533 }
534 
535 /* malloc_verify_inpool_ -- Verify object
536 
537    Find the mallocArea_ for the pointer, make sure the type is proper, and
538    verify both of them.  */
539 
540 void
malloc_verify_inpool_(mallocPool pool UNUSED,mallocType_ type UNUSED,void * ptr UNUSED,mallocSize s UNUSED)541 malloc_verify_inpool_ (mallocPool pool UNUSED, mallocType_ type UNUSED,
542 		       void *ptr UNUSED, mallocSize s UNUSED)
543 {
544 #if MALLOC_DEBUG
545   mallocArea_ a;
546 
547   if (pool == NULL)
548     pool = malloc_pool_image ();
549 
550   assert ((pool == malloc_pool_image ())
551 	  || malloc_pool_find_ (pool, malloc_pool_image ()));
552 
553   a = malloc_find_inpool_ (pool, ptr);
554   assert (a->type == type);
555   if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
556     assert (a->size == s);
557   malloc_verify_area_ (pool, a);
558 #endif
559 }
560