File Coverage

blib/lib/Devel/MAT/Tool/Sizes.pm
Criterion Covered Total %
statement 66 146 45.2
branch 2 30 6.6
condition 2 9 22.2
subroutine 20 32 62.5
pod 1 6 16.6
total 91 223 40.8


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2013-2017 -- leonerd@leonerd.org.uk
5              
6             package Devel::MAT::Tool::Sizes 0.50;
7              
8 5     5   3833 use v5.14;
  5         32  
9 5     5   32 use warnings;
  5         11  
  5         154  
10 5     5   25 use base qw( Devel::MAT::Tool );
  5         13  
  5         578  
11              
12 5     5   37 use constant FOR_UI => 1;
  5         10  
  5         334  
13              
14 5     5   41 use List::Util qw( sum0 );
  5         12  
  5         325  
15 5     5   55 use List::UtilsBy qw( rev_nsort_by );
  5         11  
  5         4105  
16              
17             =head1 NAME
18              
19             C - calculate sizes of SV structures
20              
21             =head1 DESCRIPTION
22              
23             This C tool calculates the sizes of the structures around SVs.
24             The individual size of each individual SV is given by the C method,
25             though in several cases SVs can be considered to be part of larger structures
26             of a combined aggregate size. This tool calculates those sizes and adds them
27             to the UI.
28              
29             The structural size is calculated from the basic size of the SV, added to
30             which for various types is:
31              
32             =over 2
33              
34             =item ARRAY
35              
36             Arrays add the basic size of every non-mortal element SV.
37              
38             =item HASH
39              
40             Hashes add the basic size of every non-mortal value SV.
41              
42             =item CODE
43              
44             Codes add the basic size of their padlist and constant value, and all their
45             padnames, pads, constants and globrefs.
46              
47             =back
48              
49             The owned size is calculated by starting at the given SV and accumulating the
50             set of every strong outref whose refcount is 1. This is the set of all SVs the
51             original directly owns.
52              
53             =cut
54              
55             sub init_ui
56             {
57 0     0 1 0 my $self = shift;
58 0         0 my ( $ui ) = @_;
59              
60 0         0 my %size_tooltip = (
61             SV => "Display the size of each SV individually",
62             Structure => "Display the size of SVs including its internal structure",
63             Owned => "Display the size of SVs including all owned referrents",
64             );
65              
66             $ui->provides_radiobutton_set(
67             map {
68 0 0       0 my $size = $_ eq "SV" ? "size" : "\L${_}_size";
  0         0  
69              
70 0         0 $ui->register_icon(
71             name => "size-$_",
72             svg => "icons/size-$_.svg",
73             );
74              
75             {
76             text => $_,
77             icon => "size-$_",
78             tooltip => $size_tooltip{$_},
79             code => sub {
80             $ui->set_svlist_column_values(
81             column => Devel::MAT::UI->COLUMN_SIZE,
82 0         0 from => sub { shift->$size },
83 0     0   0 );
84             },
85             }
86 0         0 } qw( SV Structure Owned )
87             );
88             }
89              
90             =head1 SV METHODS
91              
92             This tool adds the following SV methods.
93              
94             =head2 structure_set
95              
96             @svs = $sv->structure_set
97              
98             Returns the total set of the SV's structure.
99              
100             =head2 structure_size
101              
102             $size = $sv->structure_size
103              
104             Returns the size, in bytes, of the structure that the SV contains.
105              
106             =cut
107              
108             # Most SVs' structual set is just themself
109 0     0 0 0 sub Devel::MAT::SV::structure_set { shift }
110              
111             # ARRAY structure includes the element SVs
112             sub Devel::MAT::SV::ARRAY::structure_set
113             {
114 2     2   10 my $av = shift;
115 2 50       7 my @svs = ( $av, grep { $_ && !$_->immortal } $av->elems );
  6         50  
116 2         10 return @svs;
117             }
118              
119             # HASH structure includes the value SVs
120             sub Devel::MAT::SV::HASH::structure_set
121             {
122 0     0   0 my $hv = shift;
123 0 0       0 my @svs = ( $hv, grep { $_ && !$_->immortal } $hv->values );
  0         0  
124 0         0 return @svs;
125             }
126              
127             # CODE structure includes PADLIST, PADNAMES, PADs, and all pad name and pad SVs
128             sub Devel::MAT::SV::CODE::structure_set
129             {
130 0     0   0 my $cv = shift;
131 0 0       0 my @svs = ( $cv, grep { $_ && !$_->immortal }
  0         0  
132             $cv->padlist, $cv->padnames_av, $cv->pads,
133             $cv->constval, $cv->constants, $cv->globrefs );
134 0         0 return @svs;
135             }
136              
137             sub Devel::MAT::SV::structure_size
138             {
139 1     1 0 4 return sum0 map { $_->size } shift->structure_set
  4         34  
140             }
141              
142             =head2 owned_set
143              
144             @svs = $sv->owned_set
145              
146             Returns the set of every SV owned by the given one.
147              
148             =head2 owned_size
149              
150             $size = $sv->owned_size
151              
152             Returns the total size, in bytes, of the SVs owned by the given one.
153              
154             =cut
155              
156             sub Devel::MAT::SV::owned_set
157             {
158 2     2 0 693 my @more = ( shift );
159              
160 2         9 my %seen;
161             my @owned;
162              
163 2         9 while( @more ) {
164 14         22 my $next = pop @more;
165 14         23 push @owned, $next;
166              
167 14         46 $seen{$next->addr}++;
168 12 50 33     174 push @more, grep { !$seen{$_->addr} and
169             !$_->immortal and
170 14         41 $_->refcnt == 1 } map { $_->sv } $next->outrefs_strong;
  12         55  
171             }
172 2         20 return @owned;
173             }
174              
175             sub Devel::MAT::SV::owned_size
176             {
177 1     1 0 4 my $sv = shift;
178 1   33     7 return $sv->{tool_sizes_owned} //= sum0 map { $_->size } $sv->owned_set;
  7         59  
179             }
180              
181             =head1 COMMANDS
182              
183             =cut
184              
185             =head2 size
186              
187             Prints the sizes of a given SV
188              
189             pmat> size defstash
190             STASH(61) at 0x556e47243e10=defstash consumes:
191             2.1 KiB directly
192             11.2 KiB structurally
193             54.2 KiB including owned referrants
194              
195             =cut
196              
197 5     5   52 use constant CMD => "size";
  5         14  
  5         408  
198 5     5   35 use constant CMD_DESC => "Show the size of a given SV";
  5         17  
  5         272  
199              
200 5     5   33 use constant CMD_ARGS_SV => 1;
  5         11  
  5         1016  
201              
202             sub run
203             {
204 0     0 0   my $self = shift;
205 0           my ( $sv ) = @_;
206              
207 0           Devel::MAT::Cmd->printf( "%s consumes:\n",
208             Devel::MAT::Cmd->format_sv( $sv )
209             );
210              
211 0           Devel::MAT::Cmd->printf( " %s directly\n",
212             Devel::MAT::Cmd->format_bytes( $sv->size )
213             );
214 0           Devel::MAT::Cmd->printf( " %s structurally\n",
215             Devel::MAT::Cmd->format_bytes( $sv->structure_size )
216             );
217 0           Devel::MAT::Cmd->printf( " %s including owned referrants\n",
218             Devel::MAT::Cmd->format_bytes( $sv->owned_size )
219             );
220             }
221              
222             package # hide
223             Devel::MAT::Tool::Sizes::_largest;
224 5     5   48 use base qw( Devel::MAT::Tool );
  5         11  
  5         561  
225              
226             =head2 largest
227              
228             pmat> largest -owned
229             STASH(61) at 0x55e4317dfe10: 54.2 KiB: of which
230             | GLOB(%*) at 0x55e43180be60: 16.9 KiB: of which
231             | | STASH(40) at 0x55e43180bdd0: 16.7 KiB
232             | | GLOB(&*) at 0x55e4318ad330: 2.8 KiB
233             | | others: 15.0 KiB
234             | GLOB(%*) at 0x55e4317fdf28: 4.1 KiB: of which
235             | | STASH(34) at 0x55e4317fdf40: 4.0 KiB bytes
236             ...
237              
238             Finds and prints the largest SVs by size. The 5 largest SVs are shown.
239              
240             If counting sizes in a way that includes referred SVs, a tree is printed
241             showing the 3 largest SVs within these, and of those the 2 largest referred
242             SVs again. This should help identify large memory occupiers.
243              
244             Takes the following named options:
245              
246             =over 4
247              
248             =item --struct
249              
250             Count SVs using the structural size.
251              
252             =item --owned
253              
254             Count SVs using the owned size.
255              
256             =back
257              
258             By default, only the individual SV size is counted.
259              
260             =cut
261              
262 5     5   34 use constant CMD => "largest";
  5         11  
  5         267  
263 5     5   28 use constant CMD_DESC => "Find the largest SVs by size";
  5         10  
  5         279  
264              
265 5     5   2569 use Heap;
  5         14183  
  5         164  
266 5     5   36 use List::UtilsBy qw( max_by );
  5         10  
  5         2768  
267              
268             my %seen;
269              
270             sub list_largest_svs
271             {
272 0     0     my ( $svlist, $metric, $indent, @counts ) = @_;
273              
274 0 0         my $method = $metric ? "${metric}_size" : "size";
275              
276 0           my $heap = Heap::Fibonacci->new;
277 0           $heap->add( Devel::MAT::Tool::Sizes::_Elem->new( $_->$method, $_ ) ) for @$svlist;
278              
279 0           my $count = shift @counts;
280 0           while( $count-- ) {
281 0 0         my $topelem = $heap->extract_top or last;
282 0           my $largest = $topelem->sv;
283              
284 0           $seen{$largest->addr}++;
285              
286 0           Devel::MAT::Cmd->printf( "$indent%s: %s",
287             Devel::MAT::Cmd->format_sv( $largest ),
288             Devel::MAT::Cmd->format_bytes( $largest->$method ),
289             );
290              
291 0 0 0       if( !defined $metric or !@counts ) {
292 0           Devel::MAT::Cmd->printf( "\n" );
293 0           next;
294             }
295              
296 0           my $set_method = "${metric}_set";
297 0           my @set = $largest->$set_method;
298 0           shift @set; # SV itself is always first
299              
300 0 0         if( !@set ) {
301 0           Devel::MAT::Cmd->printf( "\n" );
302 0           next;
303             }
304              
305 0           Devel::MAT::Cmd->printf( ": of which\n" );
306 0           list_largest_svs( \@set, $metric, "${indent} | ", @counts );
307              
308 0           $seen{$_->addr}++ for @set;
309             }
310              
311 0           my $others = 0;
312 0           $others += $_->size for grep { !$seen{$_->addr} } @$svlist;
  0            
313              
314 0 0         if( $others ) {
315 0           Devel::MAT::Cmd->printf( "$indent%s: %s\n",
316             Devel::MAT::Cmd->format_note( "others" ),
317             Devel::MAT::Cmd->format_bytes( $others ),
318             );
319             }
320             }
321              
322             package Devel::MAT::Tool::Sizes::_Elem {
323 0     0     sub new { my ( $class, $val, $sv ) = @_; bless [ $val, $sv ], $class }
  0            
324              
325 0     0     sub sv { my $self = shift; return $self->[1]; }
  0            
326 0 0   0     sub heap { my $self = shift; $self->[2] = shift if @_; return $self->[2] }
  0            
  0            
327              
328 0     0     sub cmp { my ( $self, $other ) = @_; return $other->[0] <=> $self->[0] }
  0            
329             }
330              
331 5         497 use constant CMD_OPTS => (
332             struct => { help => "count SVs by structural size" },
333             owned => { help => "count SVs by owned size" },
334 5     5   39 );
  5         20  
335              
336 5         1545 use constant CMD_ARGS => (
337             { name => "count", help => "how many items to display",
338             repeated => 1 },
339 5     5   39 );
  5         12  
340              
341             sub run
342             {
343 0     0     my $self = shift;
344 0           my %opts = %{ +shift };
  0            
345              
346 0           my @counts = ( 5, 3, 2 );
347 0           $counts[$_] = $_[$_] for 0 .. $#_;
348              
349 0           my $df = $self->df;
350              
351 0           my $METRIC;
352 0 0         $METRIC = "structure" if $opts{struct};
353 0 0         $METRIC = "owned" if $opts{owned};
354              
355 0           my @svs = $df->heap;
356              
357 0 0         my $method = $METRIC ? "${METRIC}_size" : "size";
358              
359 0           my $heap_total = scalar @svs;
360 0           my $count = 0;
361 0           foreach my $sv ( @svs ) {
362 0           $count++;
363 0 0         $self->report_progress( sprintf "Calculating sizes in %d of %d (%.2f%%)",
364             $count, $heap_total, 100*$count / $heap_total ) if $count % 20000 == 0;
365 0           $sv->$method;
366             }
367 0           $self->report_progress();
368              
369 0           undef %seen;
370 0           list_largest_svs( \@svs, $METRIC, "", @counts );
371             }
372              
373             =head1 AUTHOR
374              
375             Paul Evans
376              
377             =cut
378              
379             0x55AA;