X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=734ea066e8853e747e1d0f44253593bb06861453;hb=140554665c10264faba3f60819106d3921665365;hp=f35a4f23e4d0d045ed976c467f47b82fb02b9c00;hpb=ce70748ce2d3d9defeea8ef8502d3c62a671c707;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/malloc.c b/malloc.c
index f35a4f2..734ea06 100644
--- a/malloc.c
+++ b/malloc.c
@@ -947,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();
 }
@@ -1024,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;
 
@@ -1472,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;
@@ -1491,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;
 		}
@@ -1572,6 +1577,7 @@ 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;
 		}
@@ -1656,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))) {
@@ -1692,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);
@@ -1964,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;
 }