X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=malloc.c;h=e52c09f3e2250bac8ad060ae98ecc0f015e4a0f7;hb=8ec5e241bff6550c56f30587b70b41dc3236277c;hp=828f2f7d5c06a11db86ccca057b5294fcdf4e53b;hpb=72aaf6313309039c851862ad50ee168cb9cdf42b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/malloc.c b/malloc.c
index 828f2f7..e52c09f 100644
--- a/malloc.c
+++ b/malloc.c
@@ -2,6 +2,10 @@
  *
  */
 
+#if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS)
+#  define DEBUGGING_MSTATS
+#endif 
+
 #ifndef lint
 #  if defined(DEBUGGING) && !defined(NO_RCHECK)
 #    define RCHECK
@@ -185,6 +189,7 @@ emergency_sbrk(size)
     }
 
     if (!emergency_buffer) {		
+	dTHR;
 	/* First offense, give a possibility to recover by dieing. */
 	/* No malloc involved here: */
 	GV **gvp = (GV**)hv_fetch(defstash, "^M", 2, 0);
@@ -233,8 +238,14 @@ static	union overhead *nextf[NBUCKETS];
 #ifdef USE_PERL_SBRK
 #define sbrk(a) Perl_sbrk(a)
 char *  Perl_sbrk _((int size));
+#else 
+#ifdef DONT_DECLARE_STD
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
 #else
-extern	char *sbrk();
+extern	char *sbrk(int);
+#endif
 #endif
 
 #ifdef DEBUGGING_MSTATS
@@ -251,8 +262,7 @@ static  u_int start_slack;
 #ifdef DEBUGGING
 #define	ASSERT(p)   if (!(p)) botch(STRINGIFY(p));  else
 static void
-botch(s)
-	char *s;
+botch(char *s)
 {
 	PerlIO_printf(PerlIO_stderr(), "assertion botched: %s\n", s);
 	abort();
@@ -262,8 +272,7 @@ botch(s)
 #endif
 
 Malloc_t
-malloc(nbytes)
-	register MEM_SIZE nbytes;
+malloc(register size_t nbytes)
 {
   	register union overhead *p;
   	register int bucket = 0;
@@ -364,8 +373,7 @@ malloc(nbytes)
  * Allocate more memory to the indicated bucket.
  */
 static void
-morecore(bucket)
-	register int bucket;
+morecore(register int bucket)
 {
   	register union overhead *ovp;
   	register int rnu;       /* 2^rnu bytes will be requested */
@@ -477,8 +485,7 @@ morecore(bucket)
 }
 
 Free_t
-free(mp)
-	Malloc_t mp;
+free(void *mp)
 {   
   	register MEM_SIZE size;
 	register union overhead *ovp;
@@ -542,9 +549,7 @@ free(mp)
 int reall_srchlen = 4;	/* 4 should be plenty, -1 =>'s whole list */
 
 Malloc_t
-realloc(mp, nbytes)
-	Malloc_t mp; 
-	MEM_SIZE nbytes;
+realloc(void *mp, size_t nbytes)
 {   
   	register MEM_SIZE onb;
 	union overhead *ovp;
@@ -653,8 +658,8 @@ realloc(mp, nbytes)
 #ifdef PERL_CORE
 #ifdef DEBUGGING
     if (debug & 128) {
-	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",
+	PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) rfree\n",(unsigned long)res,(unsigned long)(an++));
+	PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) realloc %ld bytes\n",
 	    (unsigned long)res,(unsigned long)(an++),(long)size);
     }
 #endif
@@ -668,9 +673,7 @@ realloc(mp, nbytes)
  * Return bucket number, or -1 if not found.
  */
 static int
-findbucket(freep, srchlen)
-	union overhead *freep;
-	int srchlen;
+findbucket(union overhead *freep, int srchlen)
 {
 	register union overhead *p;
 	register int i, j;
@@ -687,9 +690,7 @@ findbucket(freep, srchlen)
 }
 
 Malloc_t
-calloc(elements, size)
-	register MEM_SIZE elements;
-	register MEM_SIZE size;
+calloc(register size_t elements, register size_t size)
 {
     long sz = elements * size;
     Malloc_t p = malloc(sz);
@@ -709,8 +710,7 @@ calloc(elements, size)
  * frees for each size category.
  */
 void
-dump_mstats(s)
-	char *s;
+dump_mstats(char *s)
 {
   	register int i, j;
   	register union overhead *p;
@@ -742,8 +742,7 @@ dump_mstats(s)
 }
 #else
 void
-dump_mstats(s)
-    char *s;
+dump_mstats(char *s)
 {
 }
 #endif
@@ -789,6 +788,9 @@ int size;
 #ifdef PERL_CORE
     reqsize = size; /* just for the DEBUG_m statement */
 #endif
+#ifdef PACK_MALLOC
+    size = (size + 0x7ff) & ~0x7ff;
+#endif
     if (size <= Perl_sbrk_oldsize) {
 	got = Perl_sbrk_oldchunk;
 	Perl_sbrk_oldchunk += size;
@@ -804,6 +806,9 @@ int size;
 	small = 1;
       }
       got = (IV)SYSTEM_ALLOC(size);
+#ifdef PACK_MALLOC
+      got = (got + 0x7ff) & ~0x7ff;
+#endif
       if (small) {
 	/* Chunk is small, register the rest for future allocs. */
 	Perl_sbrk_oldchunk = got + reqsize;
@@ -812,7 +817,7 @@ int size;
     }
 
 #ifdef PERL_CORE
-    DEBUG_m(PerlIO_printf(PerlIO_stderr(), "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n",
+    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));
 #endif