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

Zakharevich)

p4raw-id: //depot/perl@5212

diff --git a/malloc.c b/malloc.c
index 0dc732c..e031b45 100644 (file)
--- 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)
 {