Cosmetic malloc patch

	Message-Id: <199811100003.TAA05815@monk.mps.ohio-state.edu>

p4raw-id: //depot/perl@2320

diff --git a/malloc.c b/malloc.c
index 79122fd..2006e3f 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -3,7 +3,8 @@
  */
 
 /*
-  Here are some notes on configuring Perl's malloc.
+  Here are some notes on configuring Perl's malloc.  (For non-perl
+  usage see below.)
  
   There are two macros which serve as bulk disablers of advanced
   features of this malloc: NO_FANCY_MALLOC, PLAIN_MALLOC (undef by
@@ -111,6 +112,43 @@
 
  */
 
+/*
+   If used outside of Perl environment, it may be useful to redefine
+   the following macros (listed below with defaults):
+
+     # Type of address returned by allocation functions
+     Malloc_t                          void *
+
+     # Type of size argument for allocation functions
+     MEM_SIZE                          unsigned long
+
+     # Maximal value in LONG
+     LONG_MAX                          0x7FFFFFFF
+
+     # Unsigned integer type big enough to keep a pointer
+     UV                                        unsigned long
+
+     # Type of pointer with 1-byte granularity
+     caddr_t                           char *
+
+     # Type returned by free()
+     Free_t                            void
+
+     # Fatal error reporting function
+     croak(format, arg)                        warn(idem) + exit(1)
+  
+     # Error reporting function
+     warn(format, arg)                 fprintf(stderr, idem)
+
+     # Locking/unlocking for MT operation
+     MALLOC_LOCK                       MUTEX_LOCK(PL_malloc_mutex)
+     MALLOC_UNLOCK                     MUTEX_UNLOCK(PL_malloc_mutex)
+
+     # Locking/unlocking mutex for MT operation
+     MUTEX_LOCK(l)                     void
+     MUTEX_UNLOCK(l)                   void
+ */
+
 #ifndef NO_FANCY_MALLOC
 #  ifndef SMALL_BUCKET_VIA_TABLE
 #    define SMALL_BUCKET_VIA_TABLE
@@ -167,7 +205,18 @@
  * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long.
  * If PACK_MALLOC is defined, small blocks are 2^n bytes long.
  * This is designed for use in a program that uses vast quantities of memory,
- * but bombs when it runs out. 
+ * but bombs when it runs out.
+ * 
+ * Modifications Copyright Ilya Zakharevich 1996-98.
+ * 
+ * Still very quick, but much more thrifty.  (Std config is 10% slower
+ * than it was, and takes 67% of old heap size for typical usage.)
+ *
+ * Allocations of small blocks are now table-driven to many different
+ * buckets.  Sizes of really big buckets are increased to accomodata
+ * common size=power-of-2 blocks.  Running-out-of-memory is made into
+ * an exception.  Deeply configurable and thread-safe.
+ * 
  */
 
 #ifdef PERL_CORE
@@ -206,10 +255,10 @@
 #    define PerlIO_stderr() stderr
 #  endif
 #  ifndef croak                                /* make depend */
-#    define croak(mess, arg) warn((mess), (arg)); exit(1);
+#    define croak(mess, arg) (warn((mess), (arg)), exit(1))
 #  endif 
 #  ifndef warn
-#    define warn(mess, arg) fprintf(stderr, (mess), (arg));
+#    define warn(mess, arg) fprintf(stderr, (mess), (arg))
 #  endif 
 #  ifdef DEBUG_m
 #    undef DEBUG_m
@@ -228,6 +277,14 @@
 #  define MUTEX_UNLOCK(l)
 #endif 
 
+#ifndef MALLOC_LOCK
+#  define MALLOC_LOCK          MUTEX_LOCK(PL_malloc_mutex)
+#endif 
+
+#ifndef MALLOC_UNLOCK
+#  define MALLOC_UNLOCK                MUTEX_UNLOCK(PL_malloc_mutex)
+#endif 
+
 #ifdef DEBUGGING
 #  undef DEBUG_m
 #  define DEBUG_m(a)  if (PL_debug & 128)   a
@@ -588,7 +645,7 @@ emergency_sbrk(MEM_SIZE size)
 
     if (size >= BIG_SIZE) {
        /* Give the possibility to recover: */
-       MUTEX_UNLOCK(&PL_malloc_mutex);
+       MALLOC_UNLOCK;
        croak("Out of memory during \"large\" request for %i bytes", size);
     }
 
@@ -635,7 +692,7 @@ emergency_sbrk(MEM_SIZE size)
        SvCUR(sv) = SvLEN(sv) = 0;
     }
   do_croak:
-    MUTEX_UNLOCK(&PL_malloc_mutex);
+    MALLOC_UNLOCK;
     croak("Out of memory during request for %i bytes", size);
 }
 
@@ -706,7 +763,7 @@ malloc(register size_t nbytes)
                croak("%s", "panic: malloc");
 #endif
 
-       MUTEX_LOCK(&PL_malloc_mutex);
+       MALLOC_LOCK;
        /*
         * Convert amount of memory requested into
         * closest block size stored in hash buckets
@@ -745,7 +802,7 @@ malloc(register size_t nbytes)
        if (nextf[bucket] == NULL)    
                morecore(bucket);
        if ((p = nextf[bucket]) == NULL) {
-               MUTEX_UNLOCK(&PL_malloc_mutex);
+               MALLOC_UNLOCK;
 #ifdef PERL_CORE
                if (!PL_nomemok) {
                    PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
@@ -795,7 +852,7 @@ malloc(register size_t nbytes)
            *((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
        }
 #endif
-       MUTEX_UNLOCK(&PL_malloc_mutex);
+       MALLOC_UNLOCK;
        return ((Malloc_t)(p + CHUNK_SHIFT));
 }
 
@@ -980,7 +1037,7 @@ getpages(int needed, int *nblksp, int bucket)
                                      "failed to fix bad sbrk()\n"));
 #ifdef PACK_MALLOC
                if (slack) {
-                   MUTEX_UNLOCK(&PL_malloc_mutex);
+                   MALLOC_UNLOCK;
                    croak("%s", "panic: Off-page sbrk");
                }
 #endif
@@ -1096,7 +1153,7 @@ morecore(register int bucket)
        if (nextf[bucket])
                return;
        if (bucket == sizeof(MEM_SIZE)*8*BUCKETS_PER_POW2) {
-           MUTEX_UNLOCK(&PL_malloc_mutex);
+           MALLOC_UNLOCK;
            croak("%s", "Out of memory during ridiculously large request");
        }
        if (bucket > max_bucket)
@@ -1225,7 +1282,7 @@ free(void *mp)
 #endif
                return;                         /* sanity */
            }
-       MUTEX_LOCK(&PL_malloc_mutex);
+       MALLOC_LOCK;
 #ifdef RCHECK
        ASSERT(ovp->ov_rmagic == RMAGIC, "chunk's head overwrite");
        if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) {
@@ -1248,7 +1305,7 @@ free(void *mp)
        size = OV_INDEX(ovp);
        ovp->ov_next = nextf[size];
        nextf[size] = ovp;
-       MUTEX_UNLOCK(&PL_malloc_mutex);
+       MALLOC_UNLOCK;
 }
 
 /*
@@ -1286,7 +1343,7 @@ realloc(void *mp, size_t nbytes)
        if (!cp)
                return malloc(nbytes);
 
-       MUTEX_LOCK(&PL_malloc_mutex);
+       MALLOC_LOCK;
        ovp = (union overhead *)((caddr_t)cp 
                                - sizeof (union overhead) * CHUNK_SHIFT);
        bucket = OV_INDEX(ovp);
@@ -1384,7 +1441,7 @@ realloc(void *mp, size_t nbytes)
                }
 #endif
                res = cp;
-               MUTEX_UNLOCK(&PL_malloc_mutex);
+               MALLOC_UNLOCK;
                DEBUG_m(PerlIO_printf(Perl_debug_log, 
                              "0x%lx: (%05lu) realloc %ld bytes inplace\n",
                              (unsigned long)res,(unsigned long)(PL_an++),
@@ -1416,7 +1473,7 @@ realloc(void *mp, size_t nbytes)
                goto hard_way;
        } else {
          hard_way:
-           MUTEX_UNLOCK(&PL_malloc_mutex);
+           MALLOC_UNLOCK;
            DEBUG_m(PerlIO_printf(Perl_debug_log, 
                              "0x%lx: (%05lu) realloc %ld bytes the hard way\n",
                              (unsigned long)cp,(unsigned long)(PL_an++),