PERFORCE change 12187 for review

Change 12187 by pudge@pudge-mobile on 2001/09/25 02:11:13

	Make malloc smarter, fix bugs.  (Bug #404030)

Affected files ...

... //depot/maint-5.6/macperl/macos/icemalloc.c#2 edit
... //depot/maint-5.6/macperl/macos/icemalloc.h#2 edit

Differences ...

==== //depot/maint-5.6/macperl/macos/icemalloc.c#2 (text) ====
Index: perl/macos/icemalloc.c
--- perl/macos/icemalloc.c.~1~	Mon Sep 24 20:15:05 2001
+++ perl/macos/icemalloc.c	Mon Sep 24 20:15:05 2001
@@ -3,6 +3,15 @@
 File	:	icemalloc.c			-	Memory allocator
 
 $Log: icemalloc.c,v $
+Revision 1.4  2001/09/24 06:03:35  neeri
+Backwards pointers in linked bucket list were not maintained properly (MacPerl Bug#404030)
+
+Revision 1.3  2001/09/18 09:03:46  neeri
+Off by one error in bucket search routine (MacPerl Bug#404030)
+
+Revision 1.2  2001/09/14 08:10:36  neeri
+Make realloc smarter (MacPerl bug $404030)
+
 Revision 1.1  2000/08/14 01:48:17  neeri
 Checked into Sourceforge
 
@@ -180,7 +189,6 @@
 /* DISPATCH_START */
 void free(void * ptr)
 {
-	
 	pool_free((char *) ptr);
 }
 /* DISPATCH_END */
@@ -195,31 +203,48 @@
 /* DISPATCH_START */
 void * realloc(void * old, u_long size)
 {
-	void *			nu;
+	_mem_pool_ptr	pool;
+	char *			mem;
+
+	pool = _default_mem_pool;
+	if (pool == (_mem_pool_ptr)0)
+		return (char *)0;
 	
-	nu = malloc(size);
-	
-	if (!old || !nu)
-		return nu;
-	
-	memcpy(nu, old, size);
-	
-	free(old);
-	
-	return nu;
+	mem = pool_realloc(pool, old, size);
+
+	return mem;
 }
 /* DISPATCH_END */
 
 void * pool_realloc(_mem_pool_ptr pool, void * old, u_long size)
 {
 	void *			nu;
+	u_long			old_size = pool_size(old);
+	
+	/* 
+	 * To prevent excessive reallocations, we impose growth and
+	 * shrinkage minima.
+	 */
+
+	const int growth_fraction	= 5;
+	const int shrink_fraction   = 3;
 	
+	if (size > old_size) { /* Growing */
+		if (((size - old_size) << growth_fraction) < old_size) /* Proposed growth too small, increase it */
+			size = old_size + (old_size >> growth_fraction);
+	} else { /* Shrinking */
+		if (old_size < 65 && (size << 1) > old_size)		   /* Bucket allocation is by power of two, so don't shrink earlier */
+			return old;
+		if (((old_size - size) << shrink_fraction) < old_size) /* Proposed shrinkage too insignificant, omit it */
+			return old;
+	}
+
 	nu = pool_malloc(pool, size);
 	
 	if (!old || !nu)
 		return nu;
 	
-	memcpy(nu, old, size);
+	memcpy(nu, old, old_size < size ? old_size : size);
 	
 	pool_free(old);
 	
@@ -521,7 +546,8 @@
 #endif
 				
 			bucket->prev		= (_mem_bucket_ptr) buckets;
-			bucket->next 		= *buckets;
+			if (bucket->next = *buckets)
+				bucket->next->prev = bucket;
 			*buckets 			= bucket;
 			bucket->pool 		= pool;
 			bucket->max_count	= max;
@@ -635,13 +661,86 @@
 
 #ifdef DOCUMENTATION
 
+	pool_size() determines the size of an allocated block.
+	
+#endif
+
+static u_long _pool_find_ptr_bucket_size(char * ptr);
+static u_long _pool_find_ptr_blk_size(char * ptr);
+
+u_long pool_size(void * ptr)
+{
+	u_long	ptr_size;
+
+	if (!ptr)
+		return 0;
+
+	ptr_size = _pool_find_ptr_bucket_size(ptr);
+	if (!ptr_size) 
+		ptr_size = _pool_find_ptr_blk_size(ptr);
+
+#ifdef MALLOC_LOG
+	MallocLog("sz %d %d\n", (int) ptr, (int) ptr_size);
+#endif
+	
+	return ptr_size;
+}
+
+#ifdef DOCUMENTATION
+
+	_pool_find_ptr_bucket_size() finds size of a pointer allocated in a bucket.
+	
+#endif
+
+u_long _pool_find_ptr_bucket_size(char * ptr)
+{
+	_mem_pool_ptr		pool;
+	_mem_bucket_ptr	bucket;
+
+	/*
+	** Since the default list is stored at the front of the forest list,
+	** we inherently search the default forest first. Nice.
+	*/
+	pool = _mem_pool_forest;
+	
+	while (pool != (_mem_pool_ptr)0) {
+		if (bucket = pool->free_16)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size) {
+				return 16;
+			}
+		if (bucket = pool->free_32)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)	{
+				return 32;
+			}
+		if (bucket = pool->free_64)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size) {
+				return 64;
+			}
+		
+		for (bucket = pool->blk_16; bucket; bucket = bucket->next)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
+				return 16;
+		for (bucket = pool->blk_32; bucket; bucket = bucket->next)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
+				return 32;
+		for (bucket = pool->blk_64; bucket; bucket = bucket->next)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
+				return 64;
+		
+		pool = pool->next;
+	}
+	
+	return 0;
+}
+
+#ifdef DOCUMENTATION
+
 	pool_free() does the low level work of a free().
 	
 #endif
 
 static _mem_bucket_ptr _pool_find_ptr_bucket(char * ptr);
-static int _block_is_freed(_mem_blk_ptr blk);
-static _mem_blk_ptr _pool_find_ptr_blk(char	* ptr);
+static _mem_blk_ptr _pool_find_ptr_blk(char * ptr);
 
 int pool_free(void * ptr)
 {
@@ -1044,7 +1143,7 @@
 
 #ifdef DOCUMENTATION
 
-	_pool_find_ptr_blk() finds the block containing this pointer in "ptr".
+	_pool_find_ptr_bucket() finds the bucket containing this pointer in "ptr".
 	
 #endif
 
@@ -1061,32 +1160,32 @@
 	
 	while (pool != (_mem_pool_ptr)0) {
 		if (bucket = pool->free_16)
-			if (ptr > bucket->memory && ptr < bucket->memory + pool->pref_blk_size) {
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size) {
 				if (bucket->free_count+1 == bucket->max_count)
 					pool->free_16 = nil;
 				return bucket;
 			}
 		if (bucket = pool->free_32)
-			if (ptr > bucket->memory && ptr < bucket->memory + pool->pref_blk_size)	{
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)	{
 				if (bucket->free_count+1 == bucket->max_count)
 					pool->free_32 = nil;
 				return bucket;
 			}
 		if (bucket = pool->free_64)
-			if (ptr > bucket->memory && ptr < bucket->memory + pool->pref_blk_size) {
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size) {
 				if (bucket->free_count+1 == bucket->max_count)
 					pool->free_64 = nil;
 				return bucket;
 			}
 		
 		for (bucket = pool->blk_16; bucket; bucket = bucket->next)
-			if (ptr > bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
 				return bucket;
 		for (bucket = pool->blk_32; bucket; bucket = bucket->next)
-			if (ptr > bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
 				return bucket;
 		for (bucket = pool->blk_64; bucket; bucket = bucket->next)
-			if (ptr > bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
+			if (ptr >= bucket->memory && ptr < bucket->memory + pool->pref_blk_size)
 				return bucket;
 		
 		pool = pool->next;
@@ -1123,6 +1222,18 @@
 	return (_mem_blk_ptr)0;
 }
 
+u_long _pool_find_ptr_blk_size(char * ptr)
+{
+	_mem_blk_ptr	blk = _pool_find_ptr_blk(ptr);
+	
+	if (!blk) {
+		return 0;
+	} else {
+		_mem_ptr_hdr_ptr hdr = (_mem_ptr_hdr_ptr) ( (u_long)ptr - sizeof(_mem_ptr_hdr) );
+		
+		return GET_PTR_SIZE(hdr);
+	}
+}
 
 #ifdef DOCUMENTATION
 

==== //depot/maint-5.6/macperl/macos/icemalloc.h#2 (text) ====
Index: perl/macos/icemalloc.h
--- perl/macos/icemalloc.h.~1~	Mon Sep 24 20:15:05 2001
+++ perl/macos/icemalloc.h	Mon Sep 24 20:15:05 2001
@@ -3,6 +3,9 @@
 File	:	icemalloc.h			-	Memory allocator
 
 $Log: icemalloc.h,v $
+Revision 1.2  2001/09/14 08:10:36  neeri
+Make realloc smarter (MacPerl bug $404030)
+
 Revision 1.1  2000/08/14 01:48:17  neeri
 Checked into Sourceforge
 
@@ -195,6 +198,7 @@
 void	* 				pool_malloc(_mem_pool_ptr pool, u_long size);
 void	* 				pool_realloc(_mem_pool_ptr pool, void * ptr, u_long size);
 int 					pool_free(void * ptr);
+u_long 					pool_size(void * ptr);
 int 					free_pool(int id);
 int 					free_pool_memory(int id);
 _mem_pool_ptr		find_pool(int id);
End of Patch.