provide malloc stats via get_mstats() (from Ilya Zakharevich)

p4raw-id: //depot/perl@5103

diff --git a/embed.h b/embed.h
index 91cd7c2..b16eb3d 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -730,6 +730,7 @@
 #define yywarn                 Perl_yywarn
 #if defined(MYMALLOC)
 #define dump_mstats            Perl_dump_mstats
+#define get_mstats             Perl_get_mstats
 #endif
 #define safesysmalloc          Perl_safesysmalloc
 #define safesyscalloc          Perl_safesyscalloc
@@ -2141,6 +2142,7 @@
 #define yywarn(a)              Perl_yywarn(aTHX_ a)
 #if defined(MYMALLOC)
 #define dump_mstats(a)         Perl_dump_mstats(aTHX_ a)
+#define get_mstats(a,b,c)      Perl_get_mstats(aTHX_ a,b,c)
 #endif
 #define safesysmalloc          Perl_safesysmalloc
 #define safesyscalloc          Perl_safesyscalloc
@@ -4196,6 +4198,8 @@
 #if defined(MYMALLOC)
 #define Perl_dump_mstats       CPerlObj::Perl_dump_mstats
 #define dump_mstats            Perl_dump_mstats
+#define Perl_get_mstats                CPerlObj::Perl_get_mstats
+#define get_mstats             Perl_get_mstats
 #endif
 #define Perl_safesysmalloc     CPerlObj::Perl_safesysmalloc
 #define safesysmalloc          Perl_safesysmalloc

diff --git a/embed.pl b/embed.pl
index ce4312b..952e673 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -2049,6 +2049,7 @@ p |int    |yyparse
 p      |int    |yywarn         |char* s
 #if defined(MYMALLOC)
 Ap     |void   |dump_mstats    |char* s
+Ap     |int    |get_mstats     |perl_mstats_t *buf|int buflen|int level
 #endif
 Anp    |Malloc_t|safesysmalloc |MEM_SIZE nbytes
 Anp    |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size

diff --git a/global.sym b/global.sym
index 2f750fa..1451d85 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -452,6 +452,7 @@ Perl_vwarn
 Perl_warner
 Perl_vwarner
 Perl_dump_mstats
+Perl_get_mstats
 Perl_safesysmalloc
 Perl_safesyscalloc
 Perl_safesysrealloc

diff --git a/makedef.pl b/makedef.pl
index d0ac96d..db99945 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -344,6 +344,7 @@ else {
 if ($define{'MYMALLOC'}) {
     emit_symbols [qw(
                    Perl_dump_mstats
+                   Perl_get_mstats
                    Perl_malloc
                    Perl_mfree
                    Perl_realloc

diff --git a/malloc.c b/malloc.c
index 6f15090..0e5e26f 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1818,88 +1818,126 @@ Perl_malloced_size(void *p)
 #  else
 #    define MIN_EVEN_REPORT MIN_BUCKET
 #  endif 
-/*
- * mstats - print out statistics about malloc
- * 
- * Prints two lines of numbers, one showing the length of the free list
- * for each size category, the second showing the number of mallocs -
- * frees for each size category.
- */
-void
-Perl_dump_mstats(pTHX_ char *s)
+
+int
+Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level)
 {
 #ifdef DEBUGGING_MSTATS
        register int i, j;
        register union overhead *p;
-       int topbucket=0, topbucket_ev=0, topbucket_odd=0, totfree=0, total=0;
-       u_int nfree[NBUCKETS];
-       int total_chain = 0;
        struct chunk_chain_s* nextchain;
 
+       buf->topbucket = buf->topbucket_ev = buf->topbucket_odd 
+           = buf->totfree = buf->total = buf->total_chain = 0;
+
+       buf->minbucket = MIN_BUCKET;
        MALLOC_LOCK;
        for (i = MIN_BUCKET ; i < NBUCKETS; i++) {
                for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
                        ;
-               nfree[i] = j;
-               totfree += nfree[i] * BUCKET_SIZE_REAL(i);
-               total += nmalloc[i] * BUCKET_SIZE_REAL(i);
+               if (i < buflen) {
+                   buf->nfree[i] = j;
+                   buf->ntotal[i] = nmalloc[i];
+               }               
+               buf->totfree += j * BUCKET_SIZE_REAL(i);
+               buf->total += nmalloc[i] * BUCKET_SIZE_REAL(i);
                if (nmalloc[i]) {
-                   i % 2 ? (topbucket_odd = i) : (topbucket_ev = i);
-                   topbucket = i;
+                   i % 2 ? (buf->topbucket_odd = i) : (buf->topbucket_ev = i);
+                   buf->topbucket = i;
                }
        }
        nextchain = chunk_chain;
        while (nextchain) {
-           total_chain += nextchain->size;
+           buf->total_chain += nextchain->size;
            nextchain = nextchain->next;
        }
+       buf->total_sbrk = goodsbrk + sbrk_slack;
+       buf->sbrks = sbrks;
+       buf->sbrk_good = sbrk_good;
+       buf->sbrk_slack = sbrk_slack;
+       buf->start_slack = start_slack;
+       buf->sbrked_remains = sbrked_remains;
        MALLOC_UNLOCK;
+       if (level) {
+           for (i = MIN_BUCKET ; i < NBUCKETS; i++) {
+               if (i >= buflen)
+                   break;
+               buf->bucket_mem_size[i] = BUCKET_SIZE(i);
+               buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i);
+           }
+       }
+#endif /* defined DEBUGGING_MSTATS */
+}
+/*
+ * mstats - print out statistics about malloc
+ * 
+ * Prints two lines of numbers, one showing the length of the free list
+ * for each size category, the second showing the number of mallocs -
+ * frees for each size category.
+ */
+void
+Perl_dump_mstats(pTHX_ char *s)
+{
+#ifdef DEBUGGING_MSTATS
+       register int i, j;
+       register union overhead *p;
+       perl_mstats_t buffer;
+       unsigned long nf[NBUCKETS];
+       unsigned long nt[NBUCKETS];
+       struct chunk_chain_s* nextchain;
+
+       buffer.nfree  = nf;
+       buffer.ntotal = nt;
+       get_mstats(&buffer, NBUCKETS, 0);
+
        if (s)
            PerlIO_printf(Perl_error_log,
                          "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n",
                          s, 
                          (long)BUCKET_SIZE_REAL(MIN_BUCKET), 
                          (long)BUCKET_SIZE(MIN_BUCKET),
-                         (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket));
-       PerlIO_printf(Perl_error_log, "%8d free:", totfree);
-       for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
+                         (long)BUCKET_SIZE_REAL(buffer.topbucket), 
+                         (long)BUCKET_SIZE(buffer.topbucket));
+       PerlIO_printf(Perl_error_log, "%8d free:", 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")),
-                             nfree[i]);
+                             buffer.nfree[i]);
        }
 #ifdef BUCKETS_ROOT2
        PerlIO_printf(Perl_error_log, "\n\t   ");
-       for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
+       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")),
-                             nfree[i]);
+                             buffer.nfree[i]);
        }
 #endif 
-       PerlIO_printf(Perl_error_log, "\n%8d used:", total - totfree);
-       for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) {
+       PerlIO_printf(Perl_error_log, "\n%8d used:", 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")), 
-                             nmalloc[i] - nfree[i]);
+                             buffer.ntotal[i] - buffer.nfree[i]);
        }
 #ifdef BUCKETS_ROOT2
        PerlIO_printf(Perl_error_log, "\n\t   ");
-       for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) {
+       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")),
-                             nmalloc[i] - nfree[i]);
+                             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",
-                     goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack,
-                     start_slack, total_chain, sbrked_remains);
+                     buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good,
+                     buffer.sbrk_slack, buffer.start_slack,
+                     buffer.total_chain, buffer.sbrked_remains);
 #endif /* DEBUGGING_MSTATS */
 }
 #endif /* lint */

diff --git a/objXSUB.h b/objXSUB.h
index e37978f..1243e9e 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1830,6 +1830,10 @@
 #define Perl_dump_mstats       pPerl->Perl_dump_mstats
 #undef  dump_mstats
 #define dump_mstats            Perl_dump_mstats
+#undef  Perl_get_mstats
+#define Perl_get_mstats                pPerl->Perl_get_mstats
+#undef  get_mstats
+#define get_mstats             Perl_get_mstats
 #endif
 #undef  Perl_safesysmalloc
 #define Perl_safesysmalloc     pPerl->Perl_safesysmalloc

diff --git a/perl.h b/perl.h
index e25580c..0d3f0b8 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -529,6 +529,19 @@ Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
  * that causes clashes with case-insensitive linkers */
 Free_t   Perl_mfree (Malloc_t where);
 
+typedef struct perl_mstats perl_mstats_t;
+
+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;
+    /* Level 1 info */
+    unsigned long *bucket_mem_size;
+    unsigned long *bucket_available_size;
+};
+
 #  define safemalloc  Perl_malloc
 #  define safecalloc  Perl_calloc
 #  define saferealloc Perl_realloc

diff --git a/perlapi.c b/perlapi.c
index d57a500..f897146 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -3301,6 +3301,13 @@ Perl_dump_mstats(pTHXo_ char* s)
 {
     ((CPerlObj*)pPerl)->Perl_dump_mstats(s);
 }
+
+#undef  Perl_get_mstats
+int
+Perl_get_mstats(pTHXo_ perl_mstats_t *buf, int buflen, int level)
+{
+    return ((CPerlObj*)pPerl)->Perl_get_mstats(buf, buflen, level);
+}
 #endif
 
 #undef  Perl_safesysmalloc

diff --git a/proto.h b/proto.h
index 958f36e..df2ddb4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -820,6 +820,7 @@ PERL_CALLCONV int   Perl_yyparse(pTHX);
 PERL_CALLCONV int      Perl_yywarn(pTHX_ char* s);
 #if defined(MYMALLOC)
 PERL_CALLCONV void     Perl_dump_mstats(pTHX_ char* s);
+PERL_CALLCONV int      Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level);
 #endif
 PERL_CALLCONV Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes);
 PERL_CALLCONV Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size);

diff --git a/vos/vos_dummies.c b/vos/vos_dummies.c
index 3c0852d..ec49645 100644 (file)
--- a/vos/vos_dummies.c
+++ b/vos/vos_dummies.c
@@ -86,6 +86,11 @@ extern void Perl_dump_mstats (char *s)
      bomb ("Perl_dump_mstats");
 }
 
+extern int Perl_get_mstats (struct perl_mstats *buf, int buflen, int level)
+{
+     bomb ("Perl_get_mstats");
+}
+
 extern pid_t waitpid (pid_t pid, int *stat_loc, int options)
 {