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