This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
another HINT_BYTE victim
[perl5.git] / malloc.c
index 4e3e0b8..734ea06 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -900,6 +900,8 @@ emergency_sbrk(MEM_SIZE size)
   do_croak:
     MALLOC_UNLOCK;
     croak("Out of memory during request for %i bytes", size);
+    /* NOTREACHED */
+    return Nullch;
 }
 
 #else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
@@ -945,6 +947,7 @@ static      u_int goodsbrk;
 static void
 botch(char *diag, char *s)
 {
+       dTHXo;
        PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s);
        PerlProc_abort();
 }
@@ -1022,15 +1025,18 @@ Perl_malloc(register size_t nbytes)
        }
 
        DEBUG_m(PerlIO_printf(Perl_debug_log,
-                             "0x%lx: (%05lu) malloc %ld bytes\n",
-                             (unsigned long)(p+1), (unsigned long)(PL_an++),
+                             "0x%"UVxf": (%05lu) malloc %ld bytes\n",
+                             PTR2UV(p+1), (unsigned long)(PL_an++),
                              (long)size));
 
        /* remove from linked list */
 #if defined(RCHECK)
-       if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1))
-           PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n",
-               (unsigned long)*((int*)p),(unsigned long)p);
+       if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) {
+           dTHXo;
+           PerlIO_printf(PerlIO_stderr(),
+                         "Corrupt malloc ptr 0x%lx at 0x%"UVxf"\n",
+                         (unsigned long)*((int*)p),PTR2UV(p));
+       }
 #endif
        nextf[bucket] = p->ov_next;
 
@@ -1470,8 +1476,8 @@ Perl_mfree(void *mp)
 #endif 
 
        DEBUG_m(PerlIO_printf(Perl_debug_log, 
-                             "0x%lx: (%05lu) free\n",
-                             (unsigned long)cp, (unsigned long)(PL_an++)));
+                             "0x%"UVxf": (%05lu) free\n",
+                             PTR2UV(cp), (unsigned long)(PL_an++)));
 
        if (cp == NULL)
                return;
@@ -1489,6 +1495,7 @@ Perl_mfree(void *mp)
            {
                static int bad_free_warn = -1;
                if (bad_free_warn == -1) {
+                   dTHXo;
                    char *pbf = PerlEnv_getenv("PERL_BADFREE");
                    bad_free_warn = (pbf) ? atoi(pbf) : 1;
                }
@@ -1570,11 +1577,12 @@ Perl_realloc(void *mp, size_t nbytes)
            {
                static int bad_free_warn = -1;
                if (bad_free_warn == -1) {
+                   dTHXo;
                    char *pbf = PerlEnv_getenv("PERL_BADFREE");
                    bad_free_warn = (pbf) ? atoi(pbf) : 1;
                }
                if (!bad_free_warn)
-                   return;
+                   return Nullch;
 #ifdef RCHECK
                warn("%srealloc() %signored",
                    (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
@@ -1582,7 +1590,7 @@ Perl_realloc(void *mp, size_t nbytes)
 #else
                warn("%s", "Bad realloc() ignored");
 #endif
-               return;                         /* sanity */
+               return Nullch;                  /* sanity */
            }
 
        onb = BUCKET_SIZE_REAL(bucket);
@@ -1654,8 +1662,8 @@ Perl_realloc(void *mp, size_t nbytes)
 #endif
                res = cp;
                DEBUG_m(PerlIO_printf(Perl_debug_log, 
-                             "0x%lx: (%05lu) realloc %ld bytes inplace\n",
-                             (unsigned long)res,(unsigned long)(PL_an++),
+                             "0x%"UVxf": (%05lu) realloc %ld bytes inplace\n",
+                             PTR2UV(res),(unsigned long)(PL_an++),
                              (long)size));
        } else if (incr == 1 && (cp - M_OVERHEAD == last_op) 
                   && (onb > (1 << LOG_OF_MIN_ARENA))) {
@@ -1690,8 +1698,8 @@ Perl_realloc(void *mp, size_t nbytes)
        } else {
          hard_way:
            DEBUG_m(PerlIO_printf(Perl_debug_log, 
-                             "0x%lx: (%05lu) realloc %ld bytes the hard way\n",
-                             (unsigned long)cp,(unsigned long)(PL_an++),
+                             "0x%"UVxf": (%05lu) realloc %ld bytes the hard way\n",
+                             PTR2UV(cp),(unsigned long)(PL_an++),
                              (long)size));
            if ((res = (char*)Perl_malloc(nbytes)) == NULL)
                return (NULL);
@@ -1962,8 +1970,8 @@ Perl_sbrk(int size)
       }
     }
 
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n",
-                   size, reqsize, Perl_sbrk_oldsize, got));
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"UVxf"\n",
+                   size, reqsize, Perl_sbrk_oldsize, PTR2UV(got)));
 
     return (void *)got;
 }