Front page | perl.perl5.porters |
Postings from February 2000
[PATCH 5.5.64] malloc UV patches
Thread Next
From:
Ilya Zakharevich
Date:
February 24, 2000 14:29
Subject:
[PATCH 5.5.64] malloc UV patches
Message ID:
20000224172938.A19816@monk.mps.ohio-state.edu
Here are additional patches which
a) should improve mstats() output with memory footprint above 2^31;
b) should make malloc.c compilable standalone again;
(There is some issue with realloc() above 2^32 which is not addressed yet.)
Enjoy,
Ilya
--- ./perl.h~ Sun Feb 13 01:16:47 2000
+++ ./perl.h Tue Feb 22 22:59:05 2000
@@ -530,14 +530,14 @@ Malloc_t Perl_realloc (Malloc_t where, M
Free_t Perl_mfree (Malloc_t where);
struct Perl_mstats {
- unsigned long *nfree;
- unsigned long *ntotal;
- long topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
- long total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
- long minbucket;
+ MEM_SIZE *nfree;
+ MEM_SIZE *ntotal;
+ MEM_SIZE topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
+ MEM_SIZE total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
+ MEM_SIZE minbucket;
/* Level 1 info */
- unsigned long *bucket_mem_size;
- unsigned long *bucket_available_size;
+ MEM_SIZE *bucket_mem_size;
+ MEM_SIZE *bucket_available_size;
};
# define safemalloc Perl_malloc
--- ./malloc.c~-bad Wed Feb 23 15:28:03 2000
+++ ./malloc.c Thu Feb 24 17:26:32 2000
@@ -134,6 +134,15 @@
# Unsigned integer type big enough to keep a pointer
UV unsigned long
+ # Printf string to use with UV:
+ UVxf "lu"
+
+ # How to convert pointer to UV:
+ PTR2UV(p) ((UV)(p))
+
+ # How to convert int to ptr:
+ INT2PTR(type,p) ((type)(p))
+
# Type of pointer with 1-byte granularity
caddr_t char *
@@ -149,6 +158,9 @@
# Error reporting function
warn(format, arg) fprintf(stderr, idem)
+ # Maximal required alignment
+ MEM_ALIGNBYTES 4
+
# Locking/unlocking for MT operation
MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex)
MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex)
@@ -260,6 +272,18 @@
# ifndef UV
# define UV unsigned long
# endif
+# ifndef UVxf
+# define UVxf "lu"
+# endif
+# ifndef PTR2UV
+# define PTR2UV(p) ((UV)(p))
+# endif
+# ifndef INT2PTR
+# define INT2PTR(t,p) ((t)(p))
+# endif
+# ifndef MEM_ALIGNBYTES
+# define MEM_ALIGNBYTES 4
+# endif
# ifndef caddr_t
# define caddr_t char *
# endif
@@ -288,6 +312,7 @@
# define pTHX void
# define pTHX_
# define dTHX extern int Perl___notused
+# define dTHXo extern int Perl___notused
# define WITH_THX(s) s
# endif
# ifndef PERL_GET_INTERP
@@ -308,6 +333,21 @@
# ifndef Perl_strdup
# define Perl_strdup strdup
# endif
+# ifndef Nullch
+# define Nullch NULL
+# endif
+
+struct Perl_mstats {
+ MEM_SIZE *nfree;
+ MEM_SIZE *ntotal;
+ MEM_SIZE topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
+ MEM_SIZE total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
+ MEM_SIZE minbucket;
+ /* Level 1 info */
+ MEM_SIZE *bucket_mem_size;
+ MEM_SIZE *bucket_available_size;
+};
+
#endif
#ifndef MUTEX_LOCK
@@ -326,6 +366,14 @@
# define MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex)
#endif
+#ifndef MUTEX_UNLOCK_NOCONTEXT
+# define MUTEX_UNLOCK_NOCONTEXT(p)
+#endif
+
+#ifndef MUTEX_LOCK_NOCONTEXT
+# define MUTEX_LOCK_NOCONTEXT(p)
+#endif
+
# ifndef fatalcroak /* make depend */
# define fatalcroak(mess) (write(2, (mess), strlen(mess)), exit(2))
# endif
@@ -1592,8 +1640,10 @@ Perl_realloc(void *mp, size_t nbytes)
#if defined(DEBUGGING) || !defined(PERL_CORE)
MEM_SIZE size = nbytes;
+# if PTRSIZE == 4
if ((long)nbytes < 0)
croak("%s", "panic: realloc");
+# endif
#endif
BARK_64K_LIMIT("Reallocation",nbytes,size);
@@ -1885,8 +1935,8 @@ Perl_dump_mstats(pTHX_ char *s)
register int i, j;
register union overhead *p;
struct Perl_mstats buffer;
- unsigned long nf[NBUCKETS];
- unsigned long nt[NBUCKETS];
+ MEM_SIZE nf[NBUCKETS];
+ MEM_SIZE nt[NBUCKETS];
struct chunk_chain_s* nextchain;
buffer.nfree = nf;
@@ -1895,52 +1945,52 @@ Perl_dump_mstats(pTHX_ char *s)
if (s)
PerlIO_printf(Perl_error_log,
- "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n",
+ "Memory allocation statistics %s (buckets %"UVxf"(%"UVxf")..%"UVxf"(%"UVxf")\n",
s,
- (long)BUCKET_SIZE_REAL(MIN_BUCKET),
- (long)BUCKET_SIZE(MIN_BUCKET),
- (long)BUCKET_SIZE_REAL(buffer.topbucket),
- (long)BUCKET_SIZE(buffer.topbucket));
- PerlIO_printf(Perl_error_log, "%8d free:", buffer.totfree);
+ (UV)BUCKET_SIZE_REAL(MIN_BUCKET),
+ (UV)BUCKET_SIZE(MIN_BUCKET),
+ (UV)BUCKET_SIZE_REAL(buffer.topbucket),
+ (UV)BUCKET_SIZE(buffer.topbucket));
+ PerlIO_printf(Perl_error_log, "%8"UVxf" free:", (UV)buffer.totfree);
for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- buffer.nfree[i]);
+ ? " %5"UVxf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVxf : " %"UVxf)),
+ (UV)buffer.nfree[i]);
}
#ifdef BUCKETS_ROOT2
PerlIO_printf(Perl_error_log, "\n\t ");
for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- buffer.nfree[i]);
+ ? " %5"UVxf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVxf : " %"UVxf)),
+ (UV)buffer.nfree[i]);
}
#endif
- PerlIO_printf(Perl_error_log, "\n%8d used:", buffer.total - buffer.totfree);
+ PerlIO_printf(Perl_error_log, "\n%8"UVxf" used:", (UV)(buffer.total - buffer.totfree));
for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- buffer.ntotal[i] - buffer.nfree[i]);
+ ? " %5"UVxf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVxf : " %"UVxf)),
+ (UV)(buffer.ntotal[i] - buffer.nfree[i]));
}
#ifdef BUCKETS_ROOT2
PerlIO_printf(Perl_error_log, "\n\t ");
for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) {
PerlIO_printf(Perl_error_log,
((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
- ? " %5d"
- : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")),
- buffer.ntotal[i] - buffer.nfree[i]);
+ ? " %5"UVxf
+ : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVxf : " %"UVxf)),
+ (UV)(buffer.ntotal[i] - buffer.nfree[i]));
}
#endif
- PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n",
- buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good,
- buffer.sbrk_slack, buffer.start_slack,
- buffer.total_chain, buffer.sbrked_remains);
+ PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %"UVxf"/%"UVxf":%"UVxf". Odd ends: pad+heads+chain+tail: %"UVxf"+%"UVxf"+%"UVxf"+%"UVxf".\n",
+ (UV)buffer.total_sbrk, (UV)buffer.sbrks, (UV)buffer.sbrk_good,
+ (UV)buffer.sbrk_slack, (UV)buffer.start_slack,
+ (UV)buffer.total_chain, (UV)buffer.sbrked_remains);
#endif /* DEBUGGING_MSTATS */
}
#endif /* lint */
@@ -2022,8 +2072,8 @@ Perl_sbrk(int size)
}
}
- DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"UVxf"\n",
- size, reqsize, Perl_sbrk_oldsize, PTR2UV(got)));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %"UVxf" (reqsize %"UVxf"), left size %"UVxf", give addr 0x%"UVxf"\n",
+ (UV)size, (UV)reqsize, (UV)Perl_sbrk_oldsize, PTR2UV(got)));
return (void *)got;
}
Thread Next
-
[PATCH 5.5.64] malloc UV patches
by Ilya Zakharevich