aboutsummaryrefslogtreecommitdiff
path: root/gcc/f/malloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/f/malloc.c')
-rw-r--r--gcc/f/malloc.c565
1 files changed, 565 insertions, 0 deletions
diff --git a/gcc/f/malloc.c b/gcc/f/malloc.c
new file mode 100644
index 00000000000..3b394ead563
--- /dev/null
+++ b/gcc/f/malloc.c
@@ -0,0 +1,565 @@
+/* malloc.c -- Implementation File (module.c template V1.0)
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING. If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+ Related Modules:
+ None
+
+ Description:
+ Fast pool-based memory allocation.
+
+ Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "malloc.h"
+
+/* For systems where <stdlib.h> is missing: */
+
+void *malloc (size_t size);
+void *realloc (void *ptr, size_t size);
+
+/* Externals defined here. */
+
+struct _malloc_root_ malloc_root_
+=
+{
+ {
+ &malloc_root_.malloc_pool_image_,
+ &malloc_root_.malloc_pool_image_,
+ (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
+ (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
+ (mallocArea_) &malloc_root_.malloc_pool_image_.first,
+ (mallocArea_) &malloc_root_.malloc_pool_image_.first,
+ 0,
+#if MALLOC_DEBUG
+ 0, 0, 0, 0, 0, 0, 0, '/'
+#endif
+ },
+};
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+static void *malloc_reserve_ = NULL; /* For crashes. */
+#if MALLOC_DEBUG
+static char *malloc_types_[] =
+{"KS", "KSR", "NF", "NFR", "US", "USR"};
+#endif
+
+/* Static functions (internal). */
+
+static void malloc_kill_area_ (mallocPool pool, mallocArea_ a);
+#if MALLOC_DEBUG
+static void malloc_verify_area_ (mallocPool pool, mallocArea_ a);
+#endif
+
+/* Internal macros. */
+
+#if MALLOC_DEBUG
+#define malloc_kill_(ptr,s) do {memset((ptr),127,(s));free((ptr));} while(0)
+#else
+#define malloc_kill_(ptr,s) free((ptr))
+#endif
+
+/* malloc_kill_area_ -- Kill storage area and its object
+
+ malloc_kill_area_(mallocPool pool,mallocArea_ area);
+
+ Does the actual killing of a storage area. */
+
+static void
+malloc_kill_area_ (mallocPool pool UNUSED, mallocArea_ a)
+{
+#if MALLOC_DEBUG
+ assert (strcmp (a->name, ((char *) (a->where)) + a->size) == 0);
+#endif
+ malloc_kill_ (a->where, a->size);
+ a->next->previous = a->previous;
+ a->previous->next = a->next;
+#if MALLOC_DEBUG
+ pool->freed += a->size;
+ pool->frees++;
+#endif
+ malloc_kill_ (a,
+ offsetof (struct _malloc_area_, name)
+ + strlen (a->name) + 1);
+}
+
+/* malloc_verify_area_ -- Verify storage area and its object
+
+ malloc_verify_area_(mallocPool pool,mallocArea_ area);
+
+ Does the actual verifying of a storage area. */
+
+#if MALLOC_DEBUG
+static void
+malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a UNUSED)
+{
+ mallocSize s = a->size;
+
+ assert (strcmp (a->name, ((char *) (a->where)) + s) == 0);
+}
+#endif
+
+/* malloc_init -- Initialize malloc cluster
+
+ malloc_init();
+
+ Call malloc_init before you do anything else. */
+
+void
+malloc_init ()
+{
+ if (malloc_reserve_ != NULL)
+ return;
+ malloc_reserve_ = malloc (20 * 1024); /* In case of crash, free this first. */
+ assert (malloc_reserve_ != NULL);
+}
+
+/* malloc_pool_display -- Display a pool
+
+ mallocPool p;
+ malloc_pool_display(p);
+
+ Displays information associated with the pool and its subpools. */
+
+void
+malloc_pool_display (mallocPool p UNUSED)
+{
+#if MALLOC_DEBUG
+ mallocPool q;
+ mallocArea_ a;
+
+ fprintf (dmpout, "Pool \"%s\": bytes allocated=%lu, freed=%lu, old sizes=%lu, new sizes\
+=%lu,\n allocations=%lu, frees=%lu, resizes=%lu, uses=%lu\n Subpools:\n",
+ p->name, p->allocated, p->freed, p->old_sizes, p->new_sizes, p->allocations,
+ p->frees, p->resizes, p->uses);
+
+ for (q = p->eldest; q != (mallocPool) & p->eldest; q = q->next)
+ fprintf (dmpout, " \"%s\"\n", q->name);
+
+ fprintf (dmpout, " Storage areas:\n");
+
+ for (a = p->first; a != (mallocArea_) & p->first; a = a->next)
+ {
+ fprintf (dmpout, " ");
+ malloc_display_ (a);
+ }
+#endif
+}
+
+/* malloc_pool_kill -- Destroy a pool
+
+ mallocPool p;
+ malloc_pool_kill(p);
+
+ Releases all storage associated with the pool and its subpools. */
+
+void
+malloc_pool_kill (mallocPool p)
+{
+ mallocPool q;
+ mallocArea_ a;
+
+ if (--p->uses != 0)
+ return;
+
+#if 0
+ malloc_pool_display (p);
+#endif
+
+ assert (p->next->previous == p);
+ assert (p->previous->next == p);
+
+ /* Kill off all the subpools. */
+
+ while ((q = p->eldest) != (mallocPool) &p->eldest)
+ {
+ q->uses = 1; /* Force the kill. */
+ malloc_pool_kill (q);
+ }
+
+ /* Now free all the storage areas. */
+
+ while ((a = p->first) != (mallocArea_) & p->first)
+ {
+ malloc_kill_area_ (p, a);
+ }
+
+ /* Now remove from list of sibling pools. */
+
+ p->next->previous = p->previous;
+ p->previous->next = p->next;
+
+ /* Finally, free the pool itself. */
+
+ malloc_kill_ (p,
+ offsetof (struct _malloc_pool_, name)
+ + strlen (p->name) + 1);
+}
+
+/* malloc_pool_new -- Make a new pool
+
+ mallocPool p;
+ p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
+
+ Makes a new pool with the given name and default new-chunk allocation. */
+
+mallocPool
+malloc_pool_new (char *name, mallocPool parent,
+ unsigned long chunks UNUSED)
+{
+ mallocPool p;
+
+ if (parent == NULL)
+ parent = malloc_pool_image ();
+
+ p = malloc_new_ (offsetof (struct _malloc_pool_, name)
+ + (MALLOC_DEBUG ? strlen (name) + 1 : 0));
+ p->next = (mallocPool) &(parent->eldest);
+ p->previous = parent->youngest;
+ parent->youngest->next = p;
+ parent->youngest = p;
+ p->eldest = (mallocPool) &(p->eldest);
+ p->youngest = (mallocPool) &(p->eldest);
+ p->first = (mallocArea_) &(p->first);
+ p->last = (mallocArea_) &(p->first);
+ p->uses = 1;
+#if MALLOC_DEBUG
+ p->allocated = p->freed = p->old_sizes = p->new_sizes = p->allocations
+ = p->frees = p->resizes = 0;
+ strcpy (p->name, name);
+#endif
+ return p;
+}
+
+/* malloc_pool_use -- Use an existing pool
+
+ mallocPool p;
+ p = malloc_pool_new(pool);
+
+ Increments use count for pool; means a matching malloc_pool_kill must
+ be performed before a subsequent one will actually kill the pool. */
+
+mallocPool
+malloc_pool_use (mallocPool pool)
+{
+ ++pool->uses;
+ return pool;
+}
+
+/* malloc_display_ -- Display info on a mallocArea_
+
+ mallocArea_ a;
+ malloc_display_(a);
+
+ Simple. */
+
+void
+malloc_display_ (mallocArea_ a UNUSED)
+{
+#if MALLOC_DEBUG
+ fprintf (dmpout, "At %08lX, size=%" mallocSize_f "u, type=%s, \"%s\"\n",
+ (unsigned long) a->where, a->size, malloc_types_[a->type], a->name);
+#endif
+}
+
+/* malloc_find_inpool_ -- Find mallocArea_ for object in pool
+
+ mallocPool pool;
+ void *ptr;
+ mallocArea_ a;
+ a = malloc_find_inpool_(pool,ptr);
+
+ Search for object in list of mallocArea_s, die if not found. */
+
+mallocArea_
+malloc_find_inpool_ (mallocPool pool, void *ptr)
+{
+ mallocArea_ a;
+ mallocArea_ b = (mallocArea_) &pool->first;
+ int n = 0;
+
+ for (a = pool->first; a != (mallocArea_) &pool->first; a = a->next)
+ {
+ assert (("Infinite loop detected" != NULL) && (a != b));
+ if (a->where == ptr)
+ return a;
+ ++n;
+ if (n & 1)
+ b = b->next;
+ }
+ assert ("Couldn't find object in pool!" == NULL);
+ return NULL;
+}
+
+/* malloc_kill_inpool_ -- Kill object
+
+ malloc_kill_inpool_(NULL,MALLOC_typeUS_,ptr,size_in_bytes);
+
+ Find the mallocArea_ for the pointer, make sure the type is proper, and
+ kill both of them. */
+
+void
+malloc_kill_inpool_ (mallocPool pool, mallocType_ type UNUSED,
+ void *ptr, mallocSize s UNUSED)
+{
+ mallocArea_ a;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+#if MALLOC_DEBUG
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+#endif
+
+ a = malloc_find_inpool_ (pool, ptr);
+#if MALLOC_DEBUG
+ assert (a->type == type);
+ if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
+ assert (a->size == s);
+#endif
+ malloc_kill_area_ (pool, a);
+}
+
+/* malloc_new_ -- Allocate new object, die if unable
+
+ ptr = malloc_new_(size_in_bytes);
+
+ Call malloc, bomb if it returns NULL. */
+
+void *
+malloc_new_ (mallocSize s)
+{
+ void *ptr;
+ size_t ss = s;
+
+#if MALLOC_DEBUG
+ assert (s == (mallocSize) ss);/* Else alloc is too big for this
+ library/sys. */
+#endif
+
+ ptr = malloc (ss);
+ if (ptr == NULL)
+ {
+ free (malloc_reserve_);
+ assert (ptr != NULL);
+ }
+#if MALLOC_DEBUG
+ memset (ptr, 126, ss); /* Catch some kinds of errors more
+ quickly/reliably. */
+#endif
+ return ptr;
+}
+
+/* malloc_new_inpool_ -- Allocate new object, die if unable
+
+ ptr = malloc_new_inpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes);
+
+ Allocate the structure and allocate a mallocArea_ to describe it, then
+ add it to the list of mallocArea_s for the pool. */
+
+void *
+malloc_new_inpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize s)
+{
+ void *ptr;
+ mallocArea_ a;
+ unsigned short i;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+#if MALLOC_DEBUG
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+#endif
+
+ ptr = malloc_new_ (s + (i = (MALLOC_DEBUG ? strlen (name) + 1 : 0)));
+#if MALLOC_DEBUG
+ strcpy (((char *) (ptr)) + s, name);
+#endif
+ a = malloc_new_ (offsetof (struct _malloc_area_, name) + i);
+ switch (type)
+ { /* A little optimization to speed up killing
+ of non-permanent stuff. */
+ case MALLOC_typeKP_:
+ case MALLOC_typeKPR_:
+ a->next = (mallocArea_) &pool->first;
+ break;
+
+ default:
+ a->next = pool->first;
+ break;
+ }
+ a->previous = a->next->previous;
+ a->next->previous = a;
+ a->previous->next = a;
+ a->where = ptr;
+#if MALLOC_DEBUG
+ a->size = s;
+ a->type = type;
+ strcpy (a->name, name);
+ pool->allocated += s;
+ pool->allocations++;
+#endif
+ return ptr;
+}
+
+/* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
+
+ ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
+
+ Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
+ you pass it a 0). */
+
+void *
+malloc_new_zinpool_ (mallocPool pool, mallocType_ type, char *name, mallocSize s,
+ int z)
+{
+ void *ptr;
+
+ ptr = malloc_new_inpool_ (pool, type, name, s);
+ memset (ptr, z, s);
+ return ptr;
+}
+
+/* malloc_pool_find_ -- See if pool is a descendant of another pool
+
+ if (malloc_pool_find_(target_pool,parent_pool)) ...;
+
+ Recursive descent on each of the children of the parent pool, after
+ first checking the children themselves. */
+
+char
+malloc_pool_find_ (mallocPool pool, mallocPool parent)
+{
+ mallocPool p;
+
+ for (p = parent->eldest; p != (mallocPool) & parent->eldest; p = p->next)
+ {
+ if ((p == pool) || malloc_pool_find_ (pool, p))
+ return 1;
+ }
+ return 0;
+}
+
+/* malloc_resize_inpool_ -- Resize existing object in pool
+
+ ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
+
+ Find the object's mallocArea_, check it out, then do the resizing. */
+
+void *
+malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED,
+ void *ptr, mallocSize ns, mallocSize os UNUSED)
+{
+ mallocArea_ a;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+#if MALLOC_DEBUG
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+#endif
+
+ a = malloc_find_inpool_ (pool, ptr);
+#if MALLOC_DEBUG
+ assert (a->type == type);
+ if ((type == MALLOC_typeKSR_) || (type == MALLOC_typeKPR_))
+ assert (a->size == os);
+ assert (strcmp (a->name, ((char *) (ptr)) + os) == 0);
+#endif
+ ptr = malloc_resize_ (ptr, ns + (MALLOC_DEBUG ? strlen (a->name) + 1: 0));
+ a->where = ptr;
+#if MALLOC_DEBUG
+ a->size = ns;
+ strcpy (((char *) (ptr)) + ns, a->name);
+ pool->old_sizes += os;
+ pool->new_sizes += ns;
+ pool->resizes++;
+#endif
+ return ptr;
+}
+
+/* malloc_resize_ -- Reallocate object, die if unable
+
+ ptr = malloc_resize_(ptr,size_in_bytes);
+
+ Call realloc, bomb if it returns NULL. */
+
+void *
+malloc_resize_ (void *ptr, mallocSize s)
+{
+ size_t ss = s;
+
+#if MALLOC_DEBUG
+ assert (s == (mallocSize) ss);/* Too big if failure here. */
+#endif
+
+ ptr = realloc (ptr, ss);
+ if (ptr == NULL)
+ {
+ free (malloc_reserve_);
+ assert (ptr != NULL);
+ }
+ return ptr;
+}
+
+/* malloc_verify_inpool_ -- Verify object
+
+ Find the mallocArea_ for the pointer, make sure the type is proper, and
+ verify both of them. */
+
+void
+malloc_verify_inpool_ (mallocPool pool UNUSED, mallocType_ type UNUSED,
+ void *ptr UNUSED, mallocSize s UNUSED)
+{
+#if MALLOC_DEBUG
+ mallocArea_ a;
+
+ if (pool == NULL)
+ pool = malloc_pool_image ();
+
+ assert ((pool == malloc_pool_image ())
+ || malloc_pool_find_ (pool, malloc_pool_image ()));
+
+ a = malloc_find_inpool_ (pool, ptr);
+ assert (a->type == type);
+ if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
+ assert (a->size == s);
+ malloc_verify_area_ (pool, a);
+#endif
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-18 13:13:56 +0000