make Perl's malloc work for allocations over 2GB (from Ilya

Zakharevich)

p4raw-id: //depot/perl@5212

1 files changed, 16 insertions, 29 deletions

diff --git a/malloc.c b/malloc.c
index 0dc732cc7d..e031b45d92 100644
--- a/malloc.c
+++ b/malloc.c
@@ -125,6 +125,9 @@
      # Type of size argument for allocation functions
      MEM_SIZE				unsigned long
 
+     # size of void*
+     PTRSIZE				4
+
      # Maximal value in LONG
      LONG_MAX				0x7FFFFFFF
 
@@ -245,6 +248,9 @@
 #    ifndef Malloc_t
 #      define Malloc_t void *
 #    endif
+#    ifndef PTRSIZE
+#      define PTRSIZE 4
+#    endif
 #    ifndef MEM_SIZE
 #      define MEM_SIZE unsigned long
 #    endif
@@ -838,7 +844,6 @@ static char bucket_of[] =
 static char *emergency_buffer;
 static MEM_SIZE emergency_buffer_size;
 
-static int	findbucket	(union overhead *freep, int srchlen);
 static void	morecore	(register int bucket);
 #  if defined(DEBUGGING)
 static void	botch		(char *diag, char *s);
@@ -847,8 +852,8 @@ static void	add_to_chain	(void *p, MEM_SIZE size, MEM_SIZE chip);
 static Malloc_t	emergency_sbrk	(MEM_SIZE size);
 static void*	get_from_chain	(MEM_SIZE size);
 static void*	get_from_bigger_buckets(int bucket, MEM_SIZE size);
-static union overhead *getpages	(int needed, int *nblksp, int bucket);
-static int	getpages_adjacent(int require);
+static union overhead *getpages	(MEM_SIZE needed, int *nblksp, int bucket);
+static int	getpages_adjacent(MEM_SIZE require);
 
 static Malloc_t
 emergency_sbrk(MEM_SIZE size)
@@ -915,12 +920,16 @@ emergency_sbrk(MEM_SIZE size)
 #  define emergency_sbrk(size)	-1
 #endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
 
+#ifndef BITS_IN_PTR
+#  define BITS_IN_PTR (8*PTRSIZE)
+#endif
+
 /*
  * nextf[i] is the pointer to the next free block of size 2^i.  The
  * smallest allocatable block is 8 bytes.  The overhead information
  * precedes the data area returned to the user.
  */
-#define	NBUCKETS (32*BUCKETS_PER_POW2 + 1)
+#define	NBUCKETS (BITS_IN_PTR*BUCKETS_PER_POW2 + 1)
 static	union overhead *nextf[NBUCKETS];
 
 #if defined(PURIFY) && !defined(USE_PERL_SBRK)
@@ -1190,14 +1199,14 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size)
 }
 
 static union overhead *
-getpages(int needed, int *nblksp, int bucket)
+getpages(MEM_SIZE needed, int *nblksp, int bucket)
 {
     /* Need to do (possibly expensive) system call. Try to
        optimize it for rare calling. */
     MEM_SIZE require = needed - sbrked_remains;
     char *cp;
     union overhead *ovp;
-    int slack = 0;
+    MEM_SIZE slack = 0;
 
     if (sbrk_good > 0) {
 	if (!last_sbrk_top && require < FIRST_SBRK) 
@@ -1343,7 +1352,7 @@ getpages(int needed, int *nblksp, int bucket)
 }
 
 static int
-getpages_adjacent(int require)
+getpages_adjacent(MEM_SIZE require)
 {	    
     if (require <= sbrked_remains) {
 	sbrked_remains -= require;
@@ -1766,28 +1775,6 @@ Perl_realloc(void *mp, size_t nbytes)
   	return ((Malloc_t)res);
 }
 
-/*
- * Search ``srchlen'' elements of each free list for a block whose
- * header starts at ``freep''.  If srchlen is -1 search the whole list.
- * Return bucket number, or -1 if not found.
- */
-static int
-findbucket(union overhead *freep, int srchlen)
-{
-	register union overhead *p;
-	register int i, j;
-
-	for (i = 0; i < NBUCKETS; i++) {
-		j = 0;
-		for (p = nextf[i]; p && j != srchlen; p = p->ov_next) {
-			if (p == freep)
-				return (i);
-			j++;
-		}
-	}
-	return (-1);
-}
-
 Malloc_t
 Perl_calloc(register size_t elements, register size_t size)
 {