From: Tim Bunce Date: Fri, 28 Sep 2012 18:31:11 +0000 (+0900) Subject: Mega rename to Devel::Memory commit X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d3b8a135506187fe0f30f9599acae611556d777c;p=p5sagit%2FDevel-Size.git Mega rename to Devel::Memory commit --- diff --git a/.gitignore b/.gitignore index 9453686..24599dc 100644 --- a/.gitignore +++ b/.gitignore @@ -1,9 +1,10 @@ +*.o +*.swp +*.db +*.dot +blib/ +pm_to_blib/ MYMETA.json MYMETA.yml Makefile Makefile.old -Size.bs -Size.c -Size.o -blib/ -pm_to_blib diff --git a/CHANGES b/CHANGES index a7debaa..687688c 100644 --- a/CHANGES +++ b/CHANGES @@ -1,218 +1,18 @@ -Revision history for Perl extension Devel::Size. +Revision history for Perl extension Devel::Memory. - * Spelling fix to docs from gregor herrmann [CPAN #78766] - * Fix measurement of struct svop [Tim] +0.01 2012-09-29 Tim Bunce -0.78 2011-07-26 nicholas - [no changes] + * Created new Devel::Memory extension using a modified version of + Devel::Size's perl memory data crawler, extended to support + callbacks, a 'data path name' concept, data streaming, + data processing and visualization. -0.77_51 2012-07-17 nicholas - * Fix for MSVC builds from bulk 88 [CPAN #77589] - -0.77_50 2012-02-10 nicholas - * t/globs.t was failing on 5.15.6 and later due to side effects of a change - to strict.pm [CPAN #73998] - * skip tests in t/magic.t that use formline on 5.8.1 and 5.8.2, as those - versions have a buggy formline that can trigger an assertion failure. - -0.77 2011-05-16 nicholas - [no changes] - -0.76_50 2011-05-12 nicholas - * Split out HEK size calculation into hek_size(). Add the shared HE overhead. - * Handle shared hash key scalars correctly. - * GvNAME() is shared from 5.10 onwards. - * Count HvNAME(), the HV "aux" struct, the mro_meta struct, and ENAMEs. - -0.76 2011-05-11 nicholas - * Just fix the version number in the line below. - -0.75_52 2011-05-09 nicholas - * Use a table for SV body sizes. These incorporate the space saving post 5.8.x - * Correctly handle SvOOK scalars. 5.12 and later don't use SvIVX(). - * Magic vtables aren't freed when magic is freed, so don't count them. - (They are static structures. Anything that assumes otherwise is buggy.) - * Reinstate 5.6.x "support". (i.e. it compiles and passes tests.) - * Reinstate 5.005_xx "support". (i.e. it compiles and passes tests.) - -0.75_51 2011-05-05 nicholas - * Only use a static array of vtables on gcc. - -0.75_50 2011-05-04 nicholas - * The core's magic vtables are global constants, so aren't part of the size. - * Follow mg_obj and mg_ptr. - -0.75 2011-05-04 nicholas - [no changes] - -0.74_53 2011-05-01 nicholas - * Fix typo error in bit-vector tracking mechanism. On 64 bit platforms which - allocate on 8 byte alignment (rather than 16), a low pointer bit could get - lost, resulting in new pointers being considered already "seen". - "Found" by BinGOs' smoker, fixed on spectre.mongueurs.net. Thanks. - -0.74_52 2011-04-23 nicholas - * Fix potential SEGVs for OP_AELEMFAST on a lexical (eg $foo[3]) - * Fix likely SEGVs for PVOPs (missing break) - * Fix potential SEGVs for PVBMs on 5.10 and later - * Move hash and array traversal from total_size() to sv_size() - - this allows total_size() and size() to be XS ALIASes. - -0.74_51 2011-04-22 nicholas - * Don't count PL_sv_{undef,no,yes} in the size returned - * total_size() was double-counting entries in typeglobs - * sv_size() was double-counting the PVGV size if GvEGV() looped back - * fix classic off-by-one error - the answer is strlen() + 1, not just strlen() - -0.74_50 2011-04-19 nicholas - * Ensure that size() doesn't add the referent's size for non SVt_RV references - -0.74 2011-04-19 nicholas - * Correct the Makefile.PL - LICENSE was added to ExtUtils::MakeMaker in 6.31 - -0.73_51 2011-04-17 nicholas - * Refactor the C code to accumulate the size inside the tracking structure - - this means that the C *_size() functions now return void - - The XS functions size() and total_size() now return UV, not IV - -0.73_50 2011-04-17 nicholas - * Avoid using assert() on ithreaded 5.8.8 and earlier, as it needs my_perl - * Fix the test added in 0.73, as it tripped over a combination of bugs - -0.73 2011-04-16 nicholas - * Revert a bad assertion introduced in 0.72_50, which was logically wrong. - - and a test to demonstrate one case that would trigger it - -0.72_52 2011-04-15 nicholas - * Add a test for the non-exceptional warnings. - -0.72_51 2011-04-15 nicholas - * Add PERL_NO_GET_CONTEXT to improve performance under multiplicity - -0.72_50 2011-04-14 nicholas - * Exception handling is totally MSVC specific, so only use it there - - this means that we don't need to use a C++ compiler anywhere - * Rework bit-vector tracking mechanism to use a 256-way tree. This avoids - making assumptions about 64-bit platforms' memory layouts, and eliminates - the fatal error introduced in 0.72 when the assumption was violated. - * Convert to XSLoader - * Resolve CPAN #49437 (Devel::Size adds magic in Perl 5.10) - * Resolve CPAN #58484 and #58485 (related to CVs that are XSUBs) - -0.72 2008-10-14 BrowserUk 70 tests - * Added bit-vector pointer tracking mechanism. - - new fatal error (64-bit platforms only) - * Added exception handling - - 4 new warnings (disabled by default) - * Updated POD to reflect above - * Added basic.t test 13 - * replaced Module::Install with hand crafted EU::MM Makefile.pl - (With many thanks to Sisyphus) - because we couldn't work out how to add C++ options to allow - exception handling. - -0.71 2008-08-24 Tels 69 tests - * adapt patch from Reini Urban to fix failing RV under 5.10 and 5.11. AV - and HV were pushed directly onto the pending_array, and not the RV, - which caused #33530. So he rewrote the logic to deref the RV inside - the array traversal. Applied this with one small omission, which - caused test faiures. - * Fixed 5.11 RV/IV logic. (Thanx Reini Urban!) - * Removed one duplicate total_size arrayref test. (Thanx Reini Urban!) - * changed //printf to dbg_printf() (Thanx Reini again!) - -0.70 2008-08-23 Tels 69 tests - * fix SEGFAULTS under v5.10 (Thanx Reini Urban!) - * fix compilation under blead (Thanx Reini Urban!) - * require Perl 5.006 (to stop CPANTESTERS sending bogus reports - about failed compiling on ancient Perls) - * update the bundles Module::Install to v0.77 - -0.69 2007-08-11 Tels 69 tests - * fix compilation under Perl v5.9.5 and v5.10 (Thanx Steve Peters!) - * clarify the license by specifying Perl v5.8.8's license - * small doc fixes, add a README file - -0.68 2007-06-12 Tels 69 tests - * remove a bit of duplicate code in op_size, the second instance - was a no-op anyway - * fix the failing tests by rewriting the test logic to be sane - * the count of array slots was off by one - -0.67 2007-03-15 Tels 20 tests - * rip out Build.PL since it doesn't actually work - * fix bug #1653: All SVPV subtype may contain an RV instead of a PV - (Thanx a lot Jan, and sorry for the truly horrible long delay!) - * fix bug #24846: Does not correctly recurse into references in PVNV - (Thanx STEVIEO) - * add t/recurse.t that tests the two bugfixes in combination - -0.66 2007-03-02 Tels 15 tests - * fix the failing test (the code was right, but the test wrong) - -0.65 2007-02-24 Tels 15 tests - * fix the test failings under 64 bit (bugs #21037, #18596, #21404) - * fix wrong size for strings (bug #17586) - * reverse Changelog (bug #16636) - * Size.xs: remove unused variable "count" - * Size.xs: fix warnings about missing () - * Size.xs: fix size of array refs when AvALLOC == 0 - * Modernize package: - + maintained by me, signed with my key - + bundle Module::Install and use it - + add POD tests - + rewrite tests to use Test::More; add more tests - -0.64 Mon Dec 19 18:46:00 2005 - - Patch to make Devel::Size compile on bleadperl (Courtesy of - Nick Clark) - - Fix up the PVIV string size calcs (Courtesy of Andrew Shirrayev) - -0.63 Thu Jun 30 14:29:43 2005 - - Turns out that OP_TRANS is a basic op, not a loop op. This - is a bug in versions of perl 5.8.x before 5.8.7. Work around - it. - -0.62 Tue Jun 28 11:59:00 2005 - - Took out // comments - - Added in copyright notice - - Some small amount of regex parsing - - Suppress multiple copies of each warning on each call - -0.61 Mon Jun 27 16:19:00 2005 - - Added more checks for formats - - Got CVs sizing right - -0.59 Sat Nov 27 16:42:42 2004 - - Applied documentation and sane warning patch from Nigel Sandever - - Taught Devel::Size how to size up IO and globs properly - -0.58 Fri Jul 18 11:42:32 2003 - - Fix for problems triggered by perl 5.8.0 and up, more tests, and - removal of an "our" for better backwards compatibility. (Courtesy - of Marcus Holland-Moritz ) - -0.57 Thu Mar 20 13:21:14 2003 - - setting $Devel::Size::warn to 0 disables not complete warnings - -0.56 Mon Feb 24 12:10:13 2003 - - Chopped out some C++ comments. D'oh! Version incremented for CPAN - -0.55 Sat Feb 22 17:21:00 2003 - - Fixed a bad size calculation (we were overestimating by one byte) - - Updated the docs to show some of the places that there might be 'dark' - memory that Devel::Size can't see. - - Added in tests from Ken Williams - -0.54 Sat Oct 12 14:11:00 2002 - - Applied a patch to get it working on 5.8.0 under Tru64 - -0.53 Thu Oct 10 12:30:00 2002 - - Finally started updating Changes file - - Applied doc patch from Ann Barcomb - - Got globs sizing right - -0.01 Mon Oct 7 01:05:32 2002 - - original version; created by h2xs 1.2 with options - -A -n Devel::Size + * The Devel::Memory core was based on 0.77. The generic changes + will be fed back to Devel::Size so it will remain the + canonical source of knowledge of how to crawl perl internals. + Once Devel::Size has the changes then Devel::Memory will use + it as the core, but compiled with options to enable the extra + features. That way Devel::Size won't have any performance penalty. + * This is very much experimental 'alpha' software. You're milage will + vary and anything may change between releases. diff --git a/MANIFEST b/MANIFEST index 54acc82..c07983a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,11 +1,11 @@ CHANGES -lib/Devel/Size.pm +lib/Devel/Memory.pm Makefile.PL MANIFEST MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) README -Size.xs +Memory.xs ppport.h t/basic.t t/code.t @@ -17,4 +17,3 @@ t/pvbm.t t/recurse.t t/warnings.t A rather exhaustive test for the non-exceptional warnings typemap The typemap for UV, missing from 5.005_xx -META.json Module JSON meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index f8fe836..3c0fc26 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -5,12 +5,12 @@ # # command. # -^Devel-Size.*\.tar\.gz +^Devel-Memory.*\.tar\.gz ^Makefile.old ^Makefile\z ^pm_to_blib ^MANIFEST.(bak|old) -^Size.(c|o|bs) +^Memory.(c|o|bs) ^blib.* tmon.out \.txt\z diff --git a/META.json b/META.json deleted file mode 100644 index b23b416..0000000 --- a/META.json +++ /dev/null @@ -1,43 +0,0 @@ -{ - "abstract" : "unknown", - "author" : [ - "unknown" - ], - "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630", - "license" : [ - "perl_5" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : "2" - }, - "name" : "Devel-Size", - "no_index" : { - "directory" : [ - "t", - "inc" - ] - }, - "prereqs" : { - "build" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "configure" : { - "requires" : { - "ExtUtils::MakeMaker" : "0" - } - }, - "runtime" : { - "requires" : { - "Test::More" : "0", - "XSLoader" : "0", - "perl" : "5.005" - } - } - }, - "release_status" : "stable", - "version" : "0.78" -} diff --git a/META.yml b/META.yml deleted file mode 100644 index 69656ea..0000000 --- a/META.yml +++ /dev/null @@ -1,24 +0,0 @@ ---- -abstract: unknown -author: - - unknown -build_requires: - ExtUtils::MakeMaker: 0 -configure_requires: - ExtUtils::MakeMaker: 0 -dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630' -license: perl -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 -name: Devel-Size -no_index: - directory: - - t - - inc -requires: - Test::More: 0 - XSLoader: 0 - perl: 5.005 -version: 0.78 diff --git a/Makefile.PL b/Makefile.PL index 7067f9c..2fe9deb 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -10,10 +10,11 @@ my $ptr_bits = length $1; WriteMakefile( OPTIMIZE => "-g", - NAME => 'Devel::Size', - VERSION_FROM => 'lib/Devel/Size.pm', - DEFINE => "-DALIGN_BITS=$ptr_bits", - PREREQ_PM => { 'Test::More' => 0, XSLoader => 0, }, - (eval $ExtUtils::MakeMaker::VERSION >= 6.47 ? (MIN_PERL_VERSION => '5.005') : ()), - (eval $ExtUtils::MakeMaker::VERSION >= 6.31 ? (LICENSE => 'perl') : ()), + NAME => 'Devel::Memory', + VERSION_FROM => 'lib/Devel/Memory.pm', + DEFINE => "-DALIGN_BITS=$ptr_bits", + PREREQ_PM => { 'Test::More' => 0, XSLoader => 0, }, + EXE_FILES => [ 'bin/dmemtree.pl' ], + (eval $ExtUtils::MakeMaker::VERSION >= 6.47 ? (MIN_PERL_VERSION => '5.005') : ()), + (eval $ExtUtils::MakeMaker::VERSION >= 6.31 ? (LICENSE => 'perl') : ()), ); diff --git a/Size.xs b/Memory.xs similarity index 98% rename from Size.xs rename to Memory.xs index b8a364b..ddf4c0e 100644 --- a/Size.xs +++ b/Memory.xs @@ -1107,7 +1107,7 @@ sv_size(pTHX_ struct state *const st, pPATH, const SV * const orig_thing, ADD_SIZE(st, "he", sizeof(HE)); hek_size(aTHX_ st, cur_entry->hent_hek, HvSHAREKEYS(thing), NPathLink("hent_hek")); if (recurse >= st->min_recurse_threshold) { - if (orig_thing == PL_strtab) { + if (orig_thing == (SV*)PL_strtab) { /* For PL_strtab the HeVAL is used as a refcnt */ ADD_SIZE(st, "shared_hek", HeKLEN(cur_entry)); } @@ -1288,7 +1288,7 @@ else warn("skipped suspect HeVAL %p", HeVAL(cur_entry)); static void free_memnode_state(pTHX_ struct state *st) { - if (st->node_stream_fh && st->node_stream_name) { + if (st->node_stream_fh && st->node_stream_name && *st->node_stream_name) { if (*st->node_stream_name == '|') { if (pclose(st->node_stream_fh)) warn("%s exited with an error status\n", st->node_stream_name); @@ -1321,22 +1321,27 @@ new_state(pTHX) #if PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 0) check_new(st, &PL_sv_placeholder); #endif + #ifdef PATH_TRACKING - if (getenv("MEMVIEW") && *getenv("MEMVIEW")) { /* XXX quick hack */ - st->node_stream_name = getenv("MEMVIEW"); - if (*st->node_stream_name == '|') - st->node_stream_fh = popen(st->node_stream_name+1, "w"); - else - st->node_stream_fh = fopen(st->node_stream_name, "wb"); - if (!st->node_stream_fh) - croak("Can't open '%s' for writing: %s", st->node_stream_name, strerror(errno)); - setlinebuf(st->node_stream_fh); /* XXX temporary for debugging */ - st->add_attr_cb = np_stream_node_path_info; + /* XXX quick hack */ + st->node_stream_name = getenv("PERL_DMEM"); + if (st->node_stream_name) { + if (*st->node_stream_name) { + if (*st->node_stream_name == '|') + st->node_stream_fh = popen(st->node_stream_name+1, "w"); + else + st->node_stream_fh = fopen(st->node_stream_name, "wb"); + if (!st->node_stream_fh) + croak("Can't open '%s' for writing: %s", st->node_stream_name, strerror(errno)); + setlinebuf(st->node_stream_fh); /* XXX temporary for debugging */ + st->add_attr_cb = np_stream_node_path_info; + } + else + st->add_attr_cb = np_dump_node_path_info; } - else - st->add_attr_cb = np_dump_node_path_info; st->free_state_cb = free_memnode_state; #endif + return st; } @@ -1448,7 +1453,7 @@ perl_size(pTHX_ struct state *const st, pPATH) } -MODULE = Devel::Size PACKAGE = Devel::Size +MODULE = Devel::Memory PACKAGE = Devel::Memory PROTOTYPES: DISABLE diff --git a/README b/README index e6963c5..0bebcc8 100644 --- a/README +++ b/README @@ -1,25 +1,57 @@ =pod -Devel::Size - Perl extension for finding the memory usage of Perl variables +Devel::Memory - Perl extension for finding the memory usage of Perl variables =head1 SYNOPSIS - use Devel::Size qw(size total_size); + use Devel::Memory qw(size total_size); my $size = size("A string"); - my @foo = (1, 2, 3, 4, 5); my $other_size = size(\@foo); - - my $foo = {a => [1, 2, 3], - b => {a => [1, 3, 4]} - }; - my $total_size = total_size($foo); + my $total_size = total_size( $ref_to_data ); =head1 DESCRIPTION -This module figures out the real size of Perl variables in bytes, as -accurately as possible. +Acts like Devel::Size 0.77 is the PERL_DMEM env var is not set. + +Except that it also provides perl_size() and heap_size() functions. + +If PERL_DMEM env var is set to an empty string then all the *_size functions +dump a textual representation of the memory data to stderr. + +If PERL_DMEM env var is set to a string that starts with "|" then the +remainder of the string is taken to be a command name and popen() is used to +start the command and the raw memory data is piped to it. + +If PERL_DMEM env var is set to anything else it is treated as the name of a +file the raw memory data should be written to. + +The dmemtree.pl script can be used to process the raw memory data. +Typically run via the PERL_DMEM env var. For example: + + export PERL_DMEM='|./dmemtree.pl --text' + export PERL_DMEM='|./dmemtree.pl --dot=dmemtree.dot' + export PERL_DMEM='|./dmemtree.pl --db=dmemtree.db' + +The --text output is similar to the textual representation output by the module +when the PERL_DMEM env var is set to an empty string. + +The --dot output is suitable for feeding to Graphviz. + +The --db output is a SQLite database. (Very subject to change.) + +Example usage: + + PERL_DMEM='|./dmemtree.pl --db=dmemtree.db' perl -MDevel::Size=:all -e 'total_size(sub { })' + +The dmemview.pl script is a Mojolicious::Lite application that serves data to +an interactive treemap visualization of the memory use. It can be run as: + + dmemview.pl daemon + +and then open http://127.0.0.1:3000 + =head1 Build and Install @@ -49,11 +81,12 @@ On Windows: Please report bugs to: - http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-Size + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-Memory =head1 COPYRIGHT -Copyright (C) 2005 Dan Sugalski, Copyright (C) 2007-2008 Tels +Copyright (C) 2005 Dan Sugalski, Copyright (C) 2007-2008 Tels, +Copyright (C) 2011-2012 Nicholas Clark, Copyright 2012 (C) Tim Bunce. This module is free software; you can redistribute it and/or modify it under the same terms as Perl v5.8.8. diff --git a/memnodes.pl b/bin/dmemtree.pl similarity index 87% rename from memnodes.pl rename to bin/dmemtree.pl index 16f7e48..4796770 100755 --- a/memnodes.pl +++ b/bin/dmemtree.pl @@ -1,5 +1,19 @@ #!/usr/bin/env perl +# Read the raw memory data from Devel::Memory and process the tree +# (as a stack, propagating data such as totals, up the tree). +# Output completed nodes in the request formats. +# Needs to be generalized to support pluggable output formats. +# Making nodes into (lightweight fast) objects would be smart. +# Tests would be even smarter! +# +# When working on this code it's important to have a sense of the flow. +# Specifically the way that depth drives the completion of nodes. +# It's a depth-first stream processing machine, which only ever holds +# a single stack of the currently incomplete nodes, which is always the same as +# the current depth. I.e., when a node of depth N arrives, all nodes >N are +# popped off the stack and 'completed', each rippling data up to its parent. + use strict; use warnings; use autodie; @@ -8,6 +22,7 @@ use DBI qw(looks_like_number); use DBD::SQLite; use JSON::XS; use Devel::Dwarn; +use HTML::Entities qw(encode_entities);; use Getopt::Long; @@ -70,7 +85,6 @@ if ($opt_db) { my @stack; my %seqn2node; -use HTML::Entities qw(encode_entities);; my $dotnode = sub { my $name = encode_entities(shift); $name =~ s/"/\\"/g; @@ -104,14 +118,12 @@ sub enter_node { my $index = $x->{attr}{index}; # If node is an AVelem of a CvPADLIST propagate pad name to AVelem if (@stack >= 4 and (my $cvpl = $stack[-4])->{name} eq 'CvPADLIST') { - # cache the pad names so we can eat them in order my $padnames = $cvpl->{_cached}{padnames} ||= do { my @names = @{ $cvpl->{attr}{+NPattr_PADNAME} || []}; $_ = "my(".($_||'').")" for @names; $names[0] = '@_'; \@names; }; - #die Dwarn $x; $x->{name} = $padnames->[$index] || "?"; $x->{name} =~ s/my\(SVs_PADTMP\)/PADTMP/; # XXX hack for neatness } @@ -129,7 +141,7 @@ sub leave_node { my $x = shift; delete $seqn2node{$x->{id}}; - my $self_size = 0; $self_size += $_ for values %{$x->{leaves}}; + my $self_size = 0; $self_size += $_ for values %{$x->{leaves}}; $x->{self_size} = $self_size; my $parent = $stack[-1]; @@ -192,11 +204,12 @@ sub leave_node { ); # XXX attribs } - return; + + return $x; } my $indent = ": "; -my @attr_type_name = (qw(size NAME PADFAKE my PADTMP NOTE)); +my @attr_type_name = (qw(size NAME PADFAKE my PADTMP NOTE)); # XXX get from XS in some way my $pending_pre_attr = {}; while (<>) { @@ -205,12 +218,15 @@ while (<>) { my ($type, $id, $val, $name, $extra) = split / /, $_, 5; if ($type =~ s/^-//) { # Node type ($val is depth) + printf "%s%s%s %s [#%d @%d]\n", $indent x $val, $name, ($type == NPtype_LINK) ? "->" : "", $extra||'', $id, $val if $opt_text; + + # this is the core driving logic while ($val < @stack) { - leave_node(my $x = pop @stack); + my $x = leave_node(pop @stack); warn "N $id d$val ends $x->{id} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n" if $opt_verbose; } @@ -225,6 +241,7 @@ while (<>) { $stack[$val] = $node; $seqn2node{$id} = $node; } + # --- Leaf name and memory size elsif ($type eq "L") { my $node = $seqn2node{$id} || die; @@ -232,7 +249,8 @@ while (<>) { printf "%s+%d %s\n", $indent x ($node->{depth}+1), $val, $name if $opt_text; } - # --- Attribute type, name and value + + # --- Attribute type, name and value (all rather hackish) elsif (looks_like_number($type)) { my $node = $seqn2node{$id} || die; my $attr = $node->{attr} || die; @@ -268,14 +286,16 @@ while (<>) { warn "Invalid type '$type' on line $. ($_)"; next; } + $dbh->commit if $dbh and $id % 10_000 == 0; } - my $top = $stack[0]; # grab top node before we pop all the nodes leave_node(pop @stack) while @stack; -warn "EOF ends $top->{id} d$top->{depth}: size $top->{self_size}+$top->{kids_size}\n" - if $opt_verbose; -warn Dumper($top) if $opt_verbose; + +if ($opt_verbose) { + warn "EOF ends $top->{id} d$top->{depth}: size $top->{self_size}+$top->{kids_size}\n"; + warn Dumper($top); +} if ($dot_fh) { print $dot_fh "}\n"; @@ -288,7 +308,8 @@ $dbh->commit if $dbh; use Data::Dumper; warn Dumper(\%seqn2node) if %seqn2node; # should be empty -=for +=for This is out of date but gives you an idea of the data and stream + SV(PVAV) fill=1/1 [#1 @0] : +64 sv =64 : +16 av_max =80 diff --git a/lib/Devel/Memory.pm b/lib/Devel/Memory.pm new file mode 100644 index 0000000..6572deb --- /dev/null +++ b/lib/Devel/Memory.pm @@ -0,0 +1,100 @@ +package Devel::Memory; + +use strict; +use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $warn $dangle); + +require 5.005; +require Exporter; +require XSLoader; + +@ISA = qw(Exporter); + +@EXPORT_OK = qw(size total_size perl_size); + +# This allows declaration use Devel::Memory ':all'; +%EXPORT_TAGS = ( 'all' => \@EXPORT_OK ); + +$VERSION = '0.01'; + +XSLoader::load( __PACKAGE__); + +$warn = 1; +$dangle = 0; ## Set true to enable warnings about dangling pointers + +1; +__END__ + +=pod + +Devel::Memory - Perl extension for finding the memory usage of Perl variables + +=head1 SYNOPSIS + + use Devel::Memory qw(size total_size); + + my $size = size("A string"); + my @foo = (1, 2, 3, 4, 5); + my $other_size = size(\@foo); + my $total_size = total_size( $ref_to_data ); + +=head1 DESCRIPTION + +Acts like Devel::Size 0.77 if the PERL_DMEM env var is not set. + +Except that it also provides perl_size() and heap_size() functions. + +If PERL_DMEM env var is set to an empty string then all the *_size functions +dump a textual representation of the memory data to stderr. + +If PERL_DMEM env var is set to a string that starts with "|" then the +remainder of the string is taken to be a command name and popen() is used to +start the command and the raw memory data is piped to it. + +If PERL_DMEM env var is set to anything else it is treated as the name of a +file the raw memory data should be written to. + +The dmemtree.pl script can be used to process the raw memory data. +Typically run via the PERL_DMEM env var. For example: + + export PERL_DMEM='|./dmemtree.pl --text' + export PERL_DMEM='|./dmemtree.pl --dot=dmemtree.dot' + export PERL_DMEM='|./dmemtree.pl --db=dmemtree.db' + +The --text output is similar to the textual representation output by the module +when the PERL_DMEM env var is set to an empty string. + +The --dot output is suitable for feeding to Graphviz. + +The --db output is a SQLite database. (Very subject to change.) + +Example usage: + + PERL_DMEM='|dmemtree.pl --db=dmemtree.db' perl -MDevel::Memory=:all -e 'total_size(sub { })' + +The dmemview.pl script is a Mojolicious::Lite application that serves data to +an interactive treemap visualization of the memory use. It can be run as: + + dmemview.pl daemon + +and then open http://127.0.0.1:3000 + +Please report bugs to: + + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-Memory + +=head1 COPYRIGHT + +Copyright (C) 2005 Dan Sugalski, +Copyright (C) 2007-2008 Tels, +Copyright (C) BrowserUK 2008, +Copyright (C) 2011-2012 Nicholas Clark, +Copyright (C) 2012 Tim Bunce. + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl v5.8.8. + +=head1 SEE ALSO + +perl(1), L. + +=cut diff --git a/lib/Devel/Size.pm b/lib/Devel/Size.pm deleted file mode 100644 index c078fe7..0000000 --- a/lib/Devel/Size.pm +++ /dev/null @@ -1,293 +0,0 @@ -package Devel::Size; - -use strict; -use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS $warn $dangle); - -require 5.005; -require Exporter; -require XSLoader; - -@ISA = qw(Exporter); - -@EXPORT_OK = qw(size total_size perl_size); - -# This allows declaration use Devel::Size ':all'; -%EXPORT_TAGS = ( 'all' => \@EXPORT_OK ); - -$VERSION = '0.78_50'; - -XSLoader::load( __PACKAGE__); - -$warn = 1; -$dangle = 0; ## Set true to enable warnings about dangling pointers - -1; -__END__ - -=pod - -=head1 NAME - -Devel::Size - Perl extension for finding the memory usage of Perl variables - -=head1 SYNOPSIS - - use Devel::Size qw(size total_size); - - my $size = size("A string"); - - my @foo = (1, 2, 3, 4, 5); - my $other_size = size(\@foo); - - my $foo = {a => [1, 2, 3], - b => {a => [1, 3, 4]} - }; - my $total_size = total_size($foo); - -=head1 DESCRIPTION - -This module figures out the real size of Perl variables in bytes, as -accurately as possible. - -Call functions with a reference to the variable you want the size -of. If the variable is a plain scalar it returns the size of -this scalar. If the variable is a hash or an array, use a reference -when calling. - -=head1 FUNCTIONS - -=head2 size($ref) - -The C function returns the amount of memory the variable -returns. If the variable is a hash or an array, it only reports -the amount used by the structure, I the contents. - -=head2 total_size($ref) - -The C function will traverse the variable and look -at the sizes of contents. Any references contained in the variable -will also be followed, so this function can be used to get the -total size of a multidimensional data structure. At the moment -there is no way to get the size of an array or a hash and its -elements without using this function. - -=head1 EXPORT - -None but default, but optionally C and C. - -=head1 UNDERSTANDING MEMORY ALLOCATION - -Please note that the following discussion of memory allocation in perl -is based on the perl 5.8.0 sources. While this is generally -applicable to all versions of perl, some of the gory details are -omitted. It also makes some presumptions on how your system memory -allocator works so, while it will be generally correct, it may not -exactly reflect your system. (Generally the only issue is the size of -the constant values we'll talk about, not their existence) - -=head2 The C library - -It's important first to understand how your OS and libraries handle -memory. When the perl interpreter needs some memory, it asks the C -runtime library for it, using the C call. C has one -parameter, the size of the memory allocation you want, and returns a -pointer to that memory. C also makes sure that the pointer it -returns to you is properly aligned. When you're done with the memory -you hand it back to the library with the C call. C has -one parameter, the pointer that C returned. -There are a couple of interesting ramifications to this. - -Because malloc has to return an aligned pointer, it will round up the -memory allocation to make sure that the memory it returns is aligned -right. What that alignment is depends on your CPU, OS, and compiler -settings, but things are generally aligned to either a 4 or 8 byte -boundary. That means that if you ask for 1 byte, C will -silently round up to either 4 or 8 bytes, though it doesn't tell the -program making the request, so the extra memory can't be used. - -Since C isn't given the size of the memory chunk you're -freeing, it has to track it another way. Most libraries do this by -tacking on a length field just before the memory it hands to your -program. (It's put before the beginning rather than after the end -because it's less likely to get mangled by program bugs) This size -field is the size of your platform integer, Generally either 4 or 8 -bytes. - -So, if you asked for 1 byte, malloc would build something like this: - - +------------------+ - | 4 byte length | - +------------------+ <----- the pointer malloc returns - | your 1 byte | - +------------------+ - | 3 bytes padding | - +------------------+ - -As you can see, you asked for 1 byte but C used 8. If your -integers were 8 bytes rather than 4, C would have used 16 bytes -to satisfy your 1 byte request. - -The C memory allocation system also keeps a list of free memory -chunks, so it can recycle freed memory. For performance reasons, some -C memory allocation systems put a limit to the number of free -segments that are on the free list, or only search through a small -number of memory chunks waiting to be recycled before just -allocating more memory from the system. - -The memory allocation system tries to keep as few chunks on the free -list as possible. It does this by trying to notice if there are two -adjacent chunks of memory on the free list and, if there are, -coalescing them into a single larger chunk. This works pretty well, -but there are ways to have a lot of memory on the free list yet still -not have anything that can be allocated. If a program allocates one -million eight-byte chunks, for example, then frees every other chunk, -there will be four million bytes of memory on the free list, but none -of that memory can be handed out to satisfy a request for 10 -bytes. This is what's referred to as a fragmented free list, and can -be one reason why your program could have a lot of free memory yet -still not be able to allocate more, or have a huge process size and -still have almost no memory actually allocated to the program running. - -=head2 Perl - -Perl's memory allocation scheme is a bit convoluted, and more complex -than can really be addressed here, but there is one common spot where Perl's -memory allocation is unintuitive, and that's for hash keys. - -When you have a hash, each entry has a structure that points to the -key and the value for that entry. The value is just a pointer to the -scalar in the entry, and doesn't take up any special amount of -memory. The key structure holds the hash value for the key, the key -length, and the key string. (The entry and key structures are -separate so perl can potentially share keys across multiple hashes) - -The entry structure has three pointers in it, and takes up either 12 -or 24 bytes, depending on whether you're on a 32 bit or 64 bit -system. Since these structures are of fixed size, perl can keep a big -pool of them internally (generally called an arena) so it doesn't -have to allocate memory for each one. - -The key structure, though, is of variable length because the key -string is of variable length, so perl has to ask the system for a -memory allocation for each key. The base size of this structure is -8 or 16 bytes (once again, depending on whether you're on a 32 bit or -64 bit system) plus the string length plus two bytes. - -Since this memory has to be allocated from the system there's the -malloc size-field overhead (4 or 8 bytes) plus the alignment bytes (0 -to 7, depending on your system and the key length) -that get added on to the chunk perl requests. If the key is only 1 -character, and you're on a 32 bit system, the allocation will be 16 -bytes. If the key is 7 characters then the allocation is 24 bytes on -a 32 bit system. If you're on a 64 bit system the numbers get even -larger. - -=head1 DANGERS - -Since version 0.72, Devel::Size uses a new pointer tracking mechanism -that consumes far less memory than was previously the case. It does this -by using a bit vector where 1 bit represents each 4- or 8-byte aligned pointer -(32- or 64-bit platform dependent) that could exist. Further, it segments -that bit vector and only allocates each chunk when an address is seen within -that chunk. Since version 0.73, chunks are allocated in blocks of 2**16 bits -(ie 8K), accessed via a 256-way tree. The tree is 2 levels deep on a 32 bit -system, 6 levels deep on a 64 bit system. This avoids having make any -assumptions about address layout on 64 bit systems or trade offs about sizes -to allocate. It assumes that the addresses of allocated pointers are reasonably -contiguous, so that relevant parts of the tree stay in the CPU cache. - -Besides saving a lot of memory, this change means that Devel::Size -runs significantly faster than previous versions. - -=head1 Messages: texts originating from this module. - -=head2 Errors - -=over 4 - -=item "Devel::Size: Unknown variable type" - -The thing (or something contained within it) that you gave to -total_size() was unrecognisable as a Perl entity. - -=back - -=head2 warnings - -These messages warn you that for some types, the sizes calculated may not include -everything that could be associated with those types. The differences are usually -insignificant for most uses of this module. - -These may be disabled by setting - - $Devel::Size::warn = 0 - -=over 4 - -=item "Devel::Size: Calculated sizes for CVs are incomplete" - -=item "Devel::Size: Calculated sizes for FMs are incomplete" - -=item "Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be" - -=back - -=head2 New warnings since 0.72 - -Devel::Size has always been vulnerable to trapping when traversing Perl's -internal data structures, if it encounters uninitialised (dangling) pointers. - -MSVC provides exception handling able to deal with this possibility, and when -built with MSVC Devel::Size will now attempt to ignore (or log) them and -continue. These messages are mainly of interest to Devel::Size and core -developers, and so are disabled by default. - -They may be enabled by setting - - $Devel::Size::dangle = 0 - -=over 4 - -=item "Devel::Size: Can't determine class of operator OPx_XXXX, assuming BASEOP\n" - -=item "Devel::Size: Encountered bad magic at: 0xXXXXXXXX" - -=item "Devel::Size: Encountered dangling pointer in opcode at: 0xXXXXXXXX" - -=item "Devel::Size: Encountered invalid pointer: 0xXXXXXXXX" - -=back - -=head1 BUGS - -Doesn't currently walk all the bits for code refs, formats, and -IO. Those throw a warning, but a minimum size for them is returned. - -Devel::Size only counts the memory that perl actually allocates. It -doesn't count 'dark' memory--memory that is lost due to fragmented free lists, -allocation alignments, or C library overhead. - -=head1 AUTHOR - -Dan Sugalski dan@sidhe.org - -Small portion taken from the B module as shipped with perl 5.6.2. - -Previously maintained by Tels - -New pointer tracking & exception handling for 0.72 by BrowserUK - -Currently maintained by Nicholas Clark - -=head1 COPYRIGHT - -Copyright (C) 2005 Dan Sugalski, Copyright (C) 2007-2008 Tels - -This module is free software; you can redistribute it and/or modify it -under the same terms as Perl v5.8.8. - -=head1 SEE ALSO - -perl(1), L. - -=cut diff --git a/notes.txt b/notes.txt deleted file mode 100644 index 8188b88..0000000 --- a/notes.txt +++ /dev/null @@ -1,7 +0,0 @@ - -MEMNODES='|./memnodes.pl --text --dot=memnodes.dot --db=memnodes.db' perl -Mblib -Mstrict -MDevel::Size=:all -e 'total_size(\%main::)' - -morbo -w MemView.pl -w public -w ../memnodes.db MemView.pl - -open http://127.0.0.1:3000 - diff --git a/static/MemView.pl b/static/dmemview.pl similarity index 80% rename from static/MemView.pl rename to static/dmemview.pl index 8e6cb63..8cc4720 100755 --- a/static/MemView.pl +++ b/static/dmemview.pl @@ -3,28 +3,46 @@ use strict; use warnings; -use JSON::XS; use Mojolicious::Lite; +use JSON::XS; use Getopt::Long; use Storable qw(dclone); use Devel::Dwarn; +=pod NOTE + + Needs to be run from the static/. directory. + For example: + + ./dmemview.pl daemon + =pod TODO + Move all the static files into the DATA section of ths script so the script + is entirely self-contained and doesn't need any static files installed. + Or, work out how to install the static files and reference them from the script. + + Remove ORLite (for now) + + Make the treemap resize to fit the browser window (as NYTProf does). + Protect against nodes with thousands of children - perhaps replace all with single merged child that has no children itself. + perhaps replace all with single merged child that has no children itself + but just a warning as a title. =cut GetOptions( - 'db=s' => \(my $opt_db = '../memnodes.db'), + 'db=s' => \(my $opt_db = '../dmemtree.db'), 'debug!' => \my $opt_debug, ) or exit 1; #warn "Reading from $opt_db\n"; +# XXX currently uses ORLite but doesn't actually make use of it in any useful way +# should be removed and replaced with plain DBI till we have an obvious need for it use ORLite { - file => '../memnodes.db', + file => '../dmemtree.db', package => "MemView", #user_version => 1, readonly => 1, @@ -41,12 +59,15 @@ get '/' => sub { $self->render('index'); }; + +# /jit_tree are AJAX requests from the treemap visualization get '/jit_tree/:id/:depth' => sub { my $self = shift; my $id = $self->stash('id'); my $depth = $self->stash('depth'); + # hack, would be best done on the client side my $logarea = (defined $self->param('logarea')) ? $self->param('logarea') : Mojo::URL->new($self->req->headers->referrer)->query->param('logarea'); @@ -66,7 +87,7 @@ get '/jit_tree/:id/:depth' => sub { return $jit_node; }); - if(1){ + if(1){ # debug use Devel::Dwarn; use Data::Dump qw(pp); local $jit_tree->{children}; @@ -76,10 +97,12 @@ get '/jit_tree/:id/:depth' => sub { $self->render_json($jit_tree); }; + sub _fetch_node_tree { my ($id, $depth) = @_; + my $node = MemView->selectrow_hashref("select * from node where id = ?", undef, $id) - or die "Node '$id' not found"; + or die "Node '$id' not found"; # shouldn't die $node->{$_} += 0 for (qw(child_count kids_node_count kids_size self_size)); $node->{leaves} = $j->decode(delete $node->{leaves_json}); $node->{attr} = $j->decode(delete $node->{attr_json}); @@ -88,8 +111,11 @@ sub _fetch_node_tree { if ($node->{child_ids}) { my @child_ids = split /,/, $node->{child_ids}; my $children; + + # if this node has only one child then we merge that child into this node + # this makes the treemap more usable if (@child_ids == 1 - && $node->{type} == 2 # only collapse links + && $node->{type} == 2 # currently we only collapse links XXX ) { my $child = _fetch_node_tree($child_ids[0], $depth); # same depth # merge node into child @@ -103,6 +129,7 @@ sub _fetch_node_tree { $child->{title} = join " ", grep { defined && length } $child->{title}, $node->{title}; #warn "Titled $child->{title}" if $child->{title}; + # somewhat hackish attribute merging for my $attr_type (keys %{ $node->{attr} }) { my $src = $node->{attr}{$attr_type}; if (ref $src eq 'HASH') { # eg NPattr_NAME: {attr}{1}{$name} = $value @@ -136,9 +163,11 @@ sub _fetch_node_tree { my @child_ids = split /,/, $node->{child_ids}; $child->{child_count} = @child_ids; - $node = $child; + $node = $child; # use the merged child as this node } - elsif ($depth) { + # XXX this elsif() should possibly be a plain if(), maybe with tweaks to the above + # because we want to allow the recursion + elsif ($depth) { # recurse to required depth $children = [ map { _fetch_node_tree($_, $depth-1) } @child_ids ]; $node->{children} = $children; $node->{child_count} = @$children; @@ -147,6 +176,7 @@ sub _fetch_node_tree { return $node; } + sub _transform_node_tree { # recurse depth first my ($node, $transform) = @_; if (my $children = $node->{children}) { @@ -157,6 +187,7 @@ sub _transform_node_tree { # recurse depth first app->start; + __DATA__ @@ index.html.ep % layout 'default'; @@ -179,9 +210,8 @@ Welcome to the Mojolicious real-time web framework! - - + diff --git a/static/public/tm.js b/static/public/dmemtreemap.js similarity index 97% rename from static/public/tm.js rename to static/public/dmemtreemap.js index 1f5856f..2c707a1 100644 --- a/static/public/tm.js +++ b/static/public/dmemtreemap.js @@ -1,3 +1,4 @@ +// based closely on http://thejit.org/static/v20/Jit/Examples/Treemap/example2.html var labelType, useGradients, nativeTextSupport, animate; (function() { @@ -87,6 +88,7 @@ function init(){ //box offsets offset: 1, //use canvas text + // XXX disabled to allow the onMouseEnter/onMouseLeave Events to fire to set the blue border XXX_Label: { type: labelType, size: 10, @@ -141,6 +143,8 @@ function init(){ //add content to the tooltip when a node //is hovered onShow: function(tip, node, isLeaf, domElement) { + + // XXX all this needs html escaping var data = node.data; var html = "
" + (data.title ? "\""+data.title+"\"" : "") diff --git a/t/basic.t b/t/basic.t index 3aa5b54..7a67620 100644 --- a/t/basic.t +++ b/t/basic.t @@ -2,15 +2,15 @@ use Test::More tests => 30; use strict; -use Devel::Size qw(size total_size); +use Devel::Memory qw(size total_size); -can_ok ('Devel::Size', qw/ +can_ok ('Devel::Memory', qw/ size total_size /); -die ("Uhoh, test uses an outdated version of Devel::Size") - unless is ($Devel::Size::VERSION, '0.78_50', 'VERSION MATCHES'); +die ("Uhoh, test uses an outdated version of Devel::Memory") + unless is ($Devel::Memory::VERSION, '0.01', 'VERSION MATCHES'); ############################################################################# # some basic checks: diff --git a/t/code.t b/t/code.t index f2e1e26..598d2c9 100644 --- a/t/code.t +++ b/t/code.t @@ -2,7 +2,7 @@ use strict; use Test::More tests => 12; -use Devel::Size ':all'; +use Devel::Memory ':all'; sub zwapp; sub swoosh($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$); diff --git a/t/globs.t b/t/globs.t index 11c0441..fe22369 100644 --- a/t/globs.t +++ b/t/globs.t @@ -2,13 +2,13 @@ use strict; use Test::More tests => 44; -use Devel::Size ':all'; +use Devel::Memory ':all'; use Config; my $warn_count; $SIG{__WARN__} = sub { - return if $_[0] eq "Devel::Size: Can't size up perlio layers yet\n"; + return if $_[0] =~ "Can't size up perlio layers yet\n"; ++$warn_count; warn @_; }; @@ -169,12 +169,12 @@ gv_grew('bang', 'boff', 'no strict "vars"; @boff = (); 1', 'ARRAY'); gv_grew('clange', 'sock', 'no strict "vars"; %sock = (); 1', 'HASH'); SKIP: { skip("Can't create FORMAT references prior to 5.8.0", 7) if $] < 5.008; - local $Devel::Size::warn = 0; + local $Devel::Memory::warn = 0; gv_grew('biff', 'zapeth', "format zapeth =\n.\n1", 'FORMAT'); } gv_grew('crunch_eth', 'awkkkkkk', 'sub awkkkkkk {}; 1', 'CODE'); -# Devel::Size isn't even tracking PVIOs from GVs (yet) +# Devel::Memory isn't even tracking PVIOs from GVs (yet) # gv_grew('kapow', 'thwape', 'opendir *thwape, "."', 'IO'); is($warn_count, undef, 'No warnings emitted'); diff --git a/t/magic.t b/t/magic.t index 97770ab..6793a13 100644 --- a/t/magic.t +++ b/t/magic.t @@ -2,7 +2,7 @@ use strict; use Test::More tests => 18; -use Devel::Size ':all'; +use Devel::Memory ':all'; require Tie::Scalar; { diff --git a/t/pod.t b/t/pod.t index d539d30..85b26db 100644 --- a/t/pod.t +++ b/t/pod.t @@ -21,6 +21,6 @@ SKIP: eval "use Test::Pod;"; $@ ? 0 : 1; }; - pod_file_ok( '../lib/Devel/Size.pm' ); + pod_file_ok( '../lib/Devel/Memory.pm' ); } diff --git a/t/pod_cov.t b/t/pod_cov.t index db07ad2..6da50a9 100644 --- a/t/pod_cov.t +++ b/t/pod_cov.t @@ -21,7 +21,7 @@ SKIP: $@ ? 0 : 1; }; for my $m (qw/ - Devel::Size + Devel::Memory /) { pod_coverage_ok( $m, "$m is covered" ); diff --git a/t/pvbm.t b/t/pvbm.t index d074057..d15817d 100644 --- a/t/pvbm.t +++ b/t/pvbm.t @@ -2,7 +2,7 @@ use strict; use Test::More tests => 2; -use Devel::Size ':all'; +use Devel::Memory ':all'; use Config; use constant PVBM => 'galumphing'; diff --git a/t/recurse.t b/t/recurse.t index 3f5d1b7..fdfa14d 100644 --- a/t/recurse.t +++ b/t/recurse.t @@ -8,7 +8,7 @@ use Test::More; use strict; -use Devel::Size ':all'; +use Devel::Memory ':all'; my %types = ( NULL => undef,