FAQ
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;
}

Search Discussions

  • Gurusamy Sarathy at Feb 25, 2000 at 1:25 am

    On Thu, 24 Feb 2000 17:29:38 EST, Ilya Zakharevich wrote:
    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 {
    I doubt this will apply against v5.5.660. Why aren't you patching against
    the latest version?


    Sarathy
    gsar@ActiveState.com

Related Discussions

Discussion Navigation
viewthread | post
Discussion Overview
groupperl5-porters @
categoriesperl
postedFeb 24, '00 at 10:29p
activeFeb 25, '00 at 1:25a
posts2
users2
websiteperl.org

People

Translate

site design / logo © 2019 Grokbase