MM_Unix patch for use under CVS

[p5sagit/p5-mst-13.2.git] / malloc.c

diff --git a/malloc.c b/malloc.c
index f702c57..e9b200b 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -3,9 +3,9 @@
  */
 
 #ifndef lint
-#ifdef DEBUGGING
-#define RCHECK
-#endif
+#  if defined(DEBUGGING) && !defined(NO_RCHECK)
+#    define RCHECK
+#  endif
 /*
  * malloc.c (Caltech) 2/21/82
  * Chris Kingsley, kingsley@cit-20.
@@ -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
@@ -264,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 */
 
@@ -288,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)
@@ -324,8 +328,8 @@ malloc(nbytes)
        }
 
 #ifdef PERL_CORE
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",
-       (unsigned long)(p+1),an++,(long)size));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) malloc %ld bytes\n",
+       (unsigned long)(p+1),(unsigned long)(an++),(long)size));
 #endif /* PERL_CORE */
 
        /* remove from linked list */
@@ -344,6 +348,7 @@ malloc(nbytes)
         * 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;
@@ -378,16 +383,13 @@ morecore(bucket)
 #ifndef atarist /* on the atari we dont have to worry about this */
        op = (union overhead *)sbrk(0);
 #  ifndef I286
-#    ifdef PACK_MALLOC
-       if ((u_int)op & 0x7ff)
-               (void)sbrk(slack = 2048 - ((u_int)op & 0x7ff));
-#    else
-       if ((u_int)op & 0x3ff)
-               (void)sbrk(slack = 1024 - ((u_int)op & 0x3ff));
-#    endif
+       if ((UV)op & (0x7FF >> CHUNK_SHIFT)) {
+           slack = (0x800 >> CHUNK_SHIFT) - ((UV)op & (0x7FF >> CHUNK_SHIFT));
+           (void)sbrk(slack);
 #    if defined(DEBUGGING_MSTATS)
-       sbrk_slack += slack;
+           sbrk_slack += slack;
 #    endif
+       }
 #  else
        /* The sbrk(0) call on the I286 always returns the next segment */
 #  endif
@@ -422,11 +424,11 @@ morecore(bucket)
         */
 #ifndef I286
 #  ifdef PACK_MALLOC
-       if ((u_int)op & 0x7ff)
+       if ((UV)op & 0x7FF)
                croak("panic: Off-page sbrk");
 #  endif
-       if ((u_int)op & 7) {
-               op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
+       if ((UV)op & 7) {
+               op = (union overhead *)(((UV)op + 8) & ~7);
                nblks--;
        }
 #else
@@ -483,7 +485,7 @@ free(mp)
 #endif 
 
 #ifdef PERL_CORE
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(unsigned long)cp,an++));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) free\n",(unsigned long)cp,(unsigned long)(an++)));
 #endif /* PERL_CORE */
 
        if (cp == NULL)
@@ -493,11 +495,8 @@ 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;
+               static int bad_free_warn = -1;
                if (bad_free_warn == -1) {
                    char *pbf = getenv("PERL_BADFREE");
                    bad_free_warn = (pbf) ? atoi(pbf) : 1;
@@ -512,10 +511,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
@@ -550,14 +548,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 */
@@ -619,7 +618,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
@@ -646,9 +645,9 @@ realloc(mp, nbytes)
 #ifdef PERL_CORE
 #ifdef DEBUGGING
     if (debug & 128) {
-       PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) rfree\n",(unsigned long)res,an++);
-       PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) realloc %ld bytes\n",
-           (unsigned long)res,an++,(long)size);
+       PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) rfree\n",(unsigned long)res,(unsigned long)(an++));
+       PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) realloc %ld bytes\n",
+           (unsigned long)res,(unsigned long)(an++),(long)size);
     }
 #endif
 #endif /* PERL_CORE */