+*.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
-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 <mhx-perl@gmx.net>)
-
-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.
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
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)
#
# 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
+++ /dev/null
-{
- "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"
-}
+++ /dev/null
----
-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
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') : ()),
);
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));
}
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);
#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;
}
}
-MODULE = Devel::Size PACKAGE = Devel::Size
+MODULE = Devel::Memory PACKAGE = Devel::Memory
PROTOTYPES: DISABLE
=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
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.
#!/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;
use DBD::SQLite;
use JSON::XS;
use Devel::Dwarn;
+use HTML::Entities qw(encode_entities);;
use Getopt::Long;
my @stack;
my %seqn2node;
-use HTML::Entities qw(encode_entities);;
my $dotnode = sub {
my $name = encode_entities(shift);
$name =~ s/"/\\"/g;
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
}
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];
);
# 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 (<>) {
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;
}
$stack[$val] = $node;
$seqn2node{$id} = $node;
}
+
# --- Leaf name and memory size
elsif ($type eq "L") {
my $node = $seqn2node{$id} || die;
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;
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";
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
--- /dev/null
+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<Devel::Size>.
+
+=cut
+++ /dev/null
-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<size> 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<not> the contents.
-
-=head2 total_size($ref)
-
-The C<total_size> 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<size> and C<total_size>.
-
-=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<malloc()> call. C<malloc> has one
-parameter, the size of the memory allocation you want, and returns a
-pointer to that memory. C<malloc> 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<free()> call. C<free> has
-one parameter, the pointer that C<malloc> 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<malloc> 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<free> 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<malloc> used 8. If your
-integers were 8 bytes rather than 4, C<malloc> 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 <http://bloodgate.com>
-
-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<Devel::Size::Report>.
-
-=cut
+++ /dev/null
-
-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
-
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,
$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');
return $jit_node;
});
- if(1){
+ if(1){ # debug
use Devel::Dwarn;
use Data::Dump qw(pp);
local $jit_tree->{children};
$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});
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
$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
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;
return $node;
}
+
sub _transform_node_tree { # recurse depth first
my ($node, $transform) = @_;
if (my $children = $node->{children}) {
app->start;
+
__DATA__
@@ index.html.ep
% layout 'default';
<script language="javascript" type="text/javascript" src="jit.js"></script>
<script language="javascript" type="text/javascript" src="jquery-1.8.1-min.js"></script>
-<!-- Example File -->
<script language="javascript" type="text/javascript" src="sprintf.js"></script>
-<script language="javascript" type="text/javascript" src="tm.js"></script>
+<script language="javascript" type="text/javascript" src="dmemtreemap.js"></script>
</head>
<body onload="init();">
+// based closely on http://thejit.org/static/v20/Jit/Examples/Treemap/example2.html
var labelType, useGradients, nativeTextSupport, animate;
(function() {
//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,
//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 = "<div class=\"tip-title\">"
+ (data.title ? "\""+data.title+"\"" : "")
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:
use strict;
use Test::More tests => 12;
-use Devel::Size ':all';
+use Devel::Memory ':all';
sub zwapp;
sub swoosh($$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$);
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 @_;
};
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');
use strict;
use Test::More tests => 18;
-use Devel::Size ':all';
+use Devel::Memory ':all';
require Tie::Scalar;
{
eval "use Test::Pod;";
$@ ? 0 : 1;
};
- pod_file_ok( '../lib/Devel/Size.pm' );
+ pod_file_ok( '../lib/Devel/Memory.pm' );
}
$@ ? 0 : 1;
};
for my $m (qw/
- Devel::Size
+ Devel::Memory
/)
{
pod_coverage_ok( $m, "$m is covered" );
use strict;
use Test::More tests => 2;
-use Devel::Size ':all';
+use Devel::Memory ':all';
use Config;
use constant PVBM => 'galumphing';
use Test::More;
use strict;
-use Devel::Size ':all';
+use Devel::Memory ':all';
my %types = (
NULL => undef,
projects / p5sagit/Devel-Size.git / commitdiff