This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Irix6.4 (with 7.1 compilers)
[perl5.git] / malloc.c
diff --git a/malloc.c b/malloc.c
index 6f22da6..b4be031 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -78,9 +78,14 @@ static int findbucket _((union overhead *freep, int srchlen));
 #define        MAGIC           0xff            /* magic # on accounting info */
 #define RMAGIC         0x55555555      /* magic # on range info */
 #ifdef RCHECK
-#define        RSLOP           sizeof (u_int)
+#  define      RSLOP           sizeof (u_int)
+#  ifdef TWO_POT_OPTIMIZE
+#    define MAX_SHORT_BUCKET 12
+#  else
+#    define MAX_SHORT_BUCKET 13
+#  endif 
 #else
-#define        RSLOP           0
+#  define      RSLOP           0
 #endif
 
 #ifdef PACK_MALLOC
@@ -130,11 +135,6 @@ static u_short blk_shift[11 - 3] = {256, 128, 64, 32,
 #  define MAX_NONSHIFT 2       /* Shift 64 greater than chunk 32. */
 };
 
-#  ifdef DEBUGGING_MSTATS
-static u_int sbrk_slack;
-static u_int start_slack;
-#  endif
-
 #else  /* !PACK_MALLOC */
 
 #  define OV_MAGIC(block,bucket) (block)->ov_magic
@@ -151,8 +151,12 @@ static u_int start_slack;
 
 #ifdef TWO_POT_OPTIMIZE
 
-#  define PERL_PAGESIZE 4096
-#  define FIRST_BIG_TWO_POT 14         /* 16K */
+#  ifndef PERL_PAGESIZE
+#    define PERL_PAGESIZE 4096
+#  endif 
+#  ifndef FIRST_BIG_TWO_POT
+#    define FIRST_BIG_TWO_POT 14       /* 16K */
+#  endif
 #  define FIRST_BIG_BLOCK (1<<FIRST_BIG_TWO_POT) /* 16K */
 /* If this value or more, check against bigger blocks. */
 #  define FIRST_BIG_BOUND (FIRST_BIG_BLOCK - M_OVERHEAD)
@@ -239,6 +243,9 @@ extern      char *sbrk();
  * for a given block size.
  */
 static u_int nmalloc[NBUCKETS];
+static u_int goodsbrk;
+static  u_int sbrk_slack;
+static  u_int start_slack;
 #endif
 
 #ifdef DEBUGGING
@@ -262,20 +269,21 @@ malloc(nbytes)
        register int bucket = 0;
        register MEM_SIZE shiftr;
 
-#ifdef PERL_CORE
-#ifdef DEBUGGING
+#if defined(DEBUGGING) || defined(RCHECK)
        MEM_SIZE size = nbytes;
 #endif
 
+#ifdef PERL_CORE
 #ifdef HAS_64K_LIMIT
        if (nbytes > 0xffff) {
-               PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", (long)nbytes);
+               PerlIO_printf(PerlIO_stderr(),
+                             "Allocation too large: %lx\n", (long)nbytes);
                my_exit(1);
        }
 #endif /* HAS_64K_LIMIT */
 #ifdef DEBUGGING
        if ((long)nbytes < 0)
-           croak("panic: malloc");
+               croak("panic: malloc");
 #endif
 #endif /* PERL_CORE */
 
@@ -286,20 +294,18 @@ malloc(nbytes)
         * space used per block for accounting.
         */
 #ifdef PACK_MALLOC
-       if (nbytes > MAX_2_POT_ALGO) {
+       if (nbytes == 0)
+           nbytes = 1;
+       else if (nbytes > MAX_2_POT_ALGO)
 #endif
+       {
 #ifdef TWO_POT_OPTIMIZE
-           if (nbytes >= FIRST_BIG_BOUND) {
-               nbytes -= PERL_PAGESIZE;
-           }
+               if (nbytes >= FIRST_BIG_BOUND)
+                       nbytes -= PERL_PAGESIZE;
 #endif 
-           nbytes += M_OVERHEAD;
-           nbytes = (nbytes + 3) &~ 3; 
-#ifdef PACK_MALLOC
-       } else if (nbytes == 0) {
-           nbytes = 1;
+               nbytes += M_OVERHEAD;
+               nbytes = (nbytes + 3) &~ 3; 
        }
-#endif
        shiftr = (nbytes - 1) >> 2;
        /* apart from this loop, this is O(1) */
        while (shiftr >>= 1)
@@ -337,14 +343,12 @@ malloc(nbytes)
 #ifndef PACK_MALLOC
        OV_INDEX(p) = bucket;
 #endif
-#ifdef DEBUGGING_MSTATS
-       nmalloc[bucket]++;
-#endif
 #ifdef RCHECK
        /*
         * Record allocated size of block and
         * bound space with magic numbers.
         */
+       nbytes = (size + M_OVERHEAD + 3) &~ 3; 
        if (nbytes <= 0x10000)
                p->ov_size = nbytes - 1;
        p->ov_rmagic = RMAGIC;
@@ -386,7 +390,7 @@ morecore(bucket)
        if ((u_int)op & 0x3ff)
                (void)sbrk(slack = 1024 - ((u_int)op & 0x3ff));
 #    endif
-#    if defined(DEBUGGING_MSTATS) && defined(PACK_MALLOC)
+#    if defined(DEBUGGING_MSTATS)
        sbrk_slack += slack;
 #    endif
 #  else
@@ -414,6 +418,9 @@ morecore(bucket)
            if (op == (union overhead *)-1)
                return;
        }
+#ifdef DEBUGGING_MSTATS
+       goodsbrk += needed;
+#endif 
        /*
         * Round up to minimum allocation size boundary
         * and deduct from block count to reflect.
@@ -450,6 +457,9 @@ morecore(bucket)
        } else op++;            /* One chunk per block. */
 #endif /* !PACK_MALLOC */
        nextf[bucket] = op;
+#ifdef DEBUGGING_MSTATS
+       nmalloc[bucket] += nblks;
+#endif 
        while (--nblks > 0) {
                op->ov_next = (union overhead *)((caddr_t)op + siz);
                op = (union overhead *)((caddr_t)op + siz);
@@ -488,9 +498,6 @@ free(mp)
 #ifdef PACK_MALLOC
        bucket = OV_INDEX(op);
 #endif 
-#ifdef DEBUGGING
-       ASSERT(OV_MAGIC(op, bucket) == MAGIC); /* make sure it was in use */
-#else
        if (OV_MAGIC(op, bucket) != MAGIC) {
                static bad_free_warn = -1;
                if (bad_free_warn == -1) {
@@ -507,10 +514,9 @@ free(mp)
 #endif
                return;                         /* sanity */
        }
-#endif
 #ifdef RCHECK
        ASSERT(op->ov_rmagic == RMAGIC);
-       if (OV_INDEX(op) <= 13)
+       if (OV_INDEX(op) <= MAX_SHORT_BUCKET)
                ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC);
        op->ov_rmagic = RMAGIC - 1;
 #endif
@@ -518,9 +524,6 @@ free(mp)
        size = OV_INDEX(op);
        op->ov_next = nextf[size];
        nextf[size] = op;
-#ifdef DEBUGGING_MSTATS
-       nmalloc[size]--;
-#endif
 }
 
 /*
@@ -548,14 +551,15 @@ realloc(mp, nbytes)
        int was_alloced = 0;
        char *cp = (char*)mp;
 
-#ifdef PERL_CORE
 #ifdef DEBUGGING
        MEM_SIZE size = nbytes;
 #endif
 
+#ifdef PERL_CORE
 #ifdef HAS_64K_LIMIT
        if (nbytes > 0xffff) {
-               PerlIO_printf(PerlIO_stderr(), "Reallocation too large: %lx\n", size);
+               PerlIO_printf(PerlIO_stderr(),
+                             "Reallocation too large: %lx\n", size);
                my_exit(1);
        }
 #endif /* HAS_64K_LIMIT */
@@ -617,7 +621,7 @@ realloc(mp, nbytes)
                 * Record new allocated size of block and
                 * bound space with magic numbers.
                 */
-               if (OV_INDEX(op) <= 13) {
+               if (OV_INDEX(op) <= MAX_SHORT_BUCKET) {
                        /*
                         * Convert amount of memory requested into
                         * closest block size stored in hash buckets
@@ -705,7 +709,7 @@ dump_mstats(s)
 {
        register int i, j;
        register union overhead *p;
-       int topbucket=0, totfree=0, totused=0;
+       int topbucket=0, totfree=0, total=0;
        u_int nfree[NBUCKETS];
 
        for (i=0; i < NBUCKETS; i++) {
@@ -713,28 +717,23 @@ dump_mstats(s)
                        ;
                nfree[i] = j;
                totfree += nfree[i]   * (1 << (i + 3));
-               totused += nmalloc[i] * (1 << (i + 3));
-               if (nfree[i] || nmalloc[i])
+               total += nmalloc[i] * (1 << (i + 3));
+               if (nmalloc[i])
                        topbucket = i;
        }
        if (s)
                PerlIO_printf(PerlIO_stderr(), "Memory allocation statistics %s (buckets 8..%d)\n",
                        s, (1 << (topbucket + 3)) );
-       PerlIO_printf(PerlIO_stderr(), " %7d free: ", totfree);
+       PerlIO_printf(PerlIO_stderr(), "%8d free:", totfree);
        for (i=0; i <= topbucket; i++) {
-               PerlIO_printf(PerlIO_stderr(), (i<5)?" %5d":" %3d", nfree[i]);
+               PerlIO_printf(PerlIO_stderr(), (i<5 || i==7)?" %5d": (i<9)?" %3d":" %d", nfree[i]);
        }
-       PerlIO_printf(PerlIO_stderr(), "\n %7d used: ", totused);
+       PerlIO_printf(PerlIO_stderr(), "\n%8d used:", total - totfree);
        for (i=0; i <= topbucket; i++) {
-               PerlIO_printf(PerlIO_stderr(), (i<5)?" %5d":" %3d", nmalloc[i]);
+               PerlIO_printf(PerlIO_stderr(), (i<5 || i==7)?" %5d": (i<9)?" %3d":" %d", nmalloc[i] - nfree[i]);
        }
-       PerlIO_printf(PerlIO_stderr(), "\n");
-#ifdef PACK_MALLOC
-       if (sbrk_slack || start_slack) {
-           PerlIO_printf(PerlIO_stderr(), "Odd ends: %7d bytes from sbrk(), %7d from malloc.\n",
-                   sbrk_slack, start_slack);
-       }
-#endif
+       PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %8d. Odd ends: sbrk(): %7d, malloc(): %7d bytes.\n",
+                     goodsbrk + sbrk_slack, sbrk_slack, start_slack);
 }
 #else
 void
Unnamed repository; edit this file 'description' to name the repository.