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.
