diff options
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | makedef.pl | 1 | ||||
| -rw-r--r-- | malloc.c | 100 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | perl.h | 13 | ||||
| -rw-r--r-- | perlapi.c | 7 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | vos/vos_dummies.c | 5 |
10 files changed, 106 insertions, 31 deletions
@@ -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 @@ -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 2f750fa170..1451d85db8 100644 --- 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 d0ac96d444..db99945780 100644 --- 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 @@ -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 */ @@ -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 @@ -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 @@ -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 @@ -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 3c0852db60..ec4964574e 100644 --- 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) { |