From: Tim Bunce Date: Sun, 30 Sep 2012 07:55:37 +0000 (+0900) Subject: Add S & E tokens, plus timing. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5e2e22f3cde966eaa51870d2a836c045bcacb530;p=p5sagit%2FDevel-Size.git Add S & E tokens, plus timing. --- diff --git a/Memory.xs b/Memory.xs index dd1ea7f..b0bbc8a 100644 --- a/Memory.xs +++ b/Memory.xs @@ -108,6 +108,7 @@ struct state { start with 0 bits, hence the start of this array will be hot, and the end unused. So put the flags next to the hot end. */ void *tracking[256]; + NV start_time_nv; int min_recurse_threshold; /* callback hooks and data */ int (*add_attr_cb)(struct state *st, npath_node_t *npath_node, UV attr_type, const char *name, UV value); @@ -216,6 +217,24 @@ static const char *svtypenames[SVt_LAST] = { #endif }; +static NV +gettimeofday_nv(void) +{ +#ifdef HAS_GETTIMEOFDAY + struct timeval when; + gettimeofday(&when, (struct timezone *) 0); + return when.tv_sec + (when.tv_usec / 1000000.0); +#else + if (u2time) { + UV time_of_day[2]; + (*u2time)(aTHX_ &time_of_day); + return time_of_day[0] + (time_of_day[1] / 1000000.0); + } + return (NV)time(); +#endif +} + + int np_print_node_name(FILE *fp, npath_node_t *npath_node) { @@ -1289,6 +1308,8 @@ static void free_memnode_state(pTHX_ struct state *st) { if (st->node_stream_fh && st->node_stream_name && *st->node_stream_name) { + fprintf(st->node_stream_fh, "E %lu %f %s\n", + getpid(), gettimeofday_nv()-st->start_time_nv, "unnamed"); if (*st->node_stream_name == '|') { if (pclose(st->node_stream_fh)) warn("%s exited with an error status\n", st->node_stream_name); @@ -1315,6 +1336,7 @@ new_state(pTHX) if (NULL != (warn_flag = perl_get_sv("Devel::Size::dangle", FALSE))) { st->dangle_whine = SvIV(warn_flag) ? TRUE : FALSE; } + st->start_time_nv = gettimeofday_nv(); check_new(st, &PL_sv_undef); check_new(st, &PL_sv_no); check_new(st, &PL_sv_yes); @@ -1333,8 +1355,10 @@ new_state(pTHX) 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 */ + if(0)setlinebuf(st->node_stream_fh); /* XXX temporary for debugging */ st->add_attr_cb = np_stream_node_path_info; + fprintf(st->node_stream_fh, "S %lu %f %s\n", + getpid(), st->start_time_nv, "unnamed"); } else st->add_attr_cb = np_dump_node_path_info; diff --git a/README b/README index 1535f09..5da7c9c 100644 --- a/README +++ b/README @@ -11,11 +11,11 @@ TODO sizeme_store sizeme_graph tests - Add R(un) and E(nd) tokens - Support multiple runs + Support multiple runs to same sizeme_store process, generating separate files Name runs to allow total_size (for example) of multiple data structures Optimizations: + Smarter array index output - only if node not seen before, so split check_new Remove depth from stream? Future Add addr to leaf to visualize memory layout diff --git a/bin/sizeme_store.pl b/bin/sizeme_store.pl index 13c8b00..4acd962 100755 --- a/bin/sizeme_store.pl +++ b/bin/sizeme_store.pl @@ -23,8 +23,9 @@ use DBD::SQLite; use JSON::XS; use Devel::Dwarn; use HTML::Entities qw(encode_entities);; - +use Data::Dumper; use Getopt::Long; +use Carp qw(carp croak confess); # XXX import these from the XS code use constant NPtype_NAME => 0x01; @@ -51,6 +52,7 @@ GetOptions( 'showid!' => \my $opt_showid, ) or exit 1; +$| = 1 if $opt_debug; my $run_size = 0; my $total_size = 0; @@ -62,27 +64,6 @@ if ($opt_db) { RaiseError => 1, PrintError => 0, AutoCommit => 0 }); $dbh->do("PRAGMA synchronous = OFF"); - $dbh->do("DROP TABLE IF EXISTS node"); - $dbh->do(q{ - CREATE TABLE node ( - id integer primary key, - name text, - title text, - type integer, - depth integer, - parent_id integer, - - self_size integer, - kids_size integer, - kids_node_count integer, - child_ids text, - attr_json text, - leaves_json text - ) - }); - $node_ins_sth = $dbh->prepare(q{ - INSERT INTO node VALUES (?,?,?,?,?,?, ?,?,?,?,?,?) - }); } my @stack; @@ -96,11 +77,6 @@ my $dotnode = sub { my $dot_fh; -if ($opt_dot) { - open $dot_fh, ">$opt_dot"; - print $dot_fh "digraph {\n"; # } - print $dot_fh "graph [overlap=false]\n"; # target="???", URL="???" -} sub fmt_size { my $size = shift; @@ -113,6 +89,7 @@ sub fmt_size { sub enter_node { my $x = shift; + warn "enter_node $x->{id}\n" if $opt_debug; my $parent = $stack[-1]; if ($parent) { @@ -142,6 +119,8 @@ sub enter_node { sub leave_node { my $x = shift; + confess unless defined $x->{id}; + warn "leave_node $x->{id}\n" if $opt_debug; delete $seqn2node{$x->{id}}; my $self_size = 0; $self_size += $_ for values %{$x->{leaves}}; @@ -216,6 +195,7 @@ my @attr_type_name = (qw(size NAME PADFAKE my PADTMP NOTE)); # XXX get from XS i my $pending_pre_attr = {}; while (<>) { + warn $_ if $opt_debug; chomp; my ($type, $id, $val, $name, $extra) = split / /, $_, 5; @@ -235,6 +215,7 @@ while (<>) { } die "panic: stack already has item at depth $val" if $stack[$val]; + die "Depth out of sync\n" if $val != @stack; my $node = enter_node({ id => $id, type => $type, name => $name, extra => $extra, attr => { %$pending_pre_attr }, @@ -286,6 +267,66 @@ while (<>) { warn "Invalid attribute type '$type' on line $. ($_)"; } } + elsif ($type eq 'S') { # start of a run + die "Unexpected start token" if @stack; + if ($opt_dot) { + open $dot_fh, ">$opt_dot"; + print $dot_fh "digraph {\n"; # } + print $dot_fh "graph [overlap=false]\n"; # target="???", URL="???" + } + if ($dbh) { + # XXX add a size_run table records each run + # XXX pick a table name to store the run nodes in + #$run_ins_sth->execute( + my $table = "node"; + $dbh->do("DROP TABLE IF EXISTS $table"); + $dbh->do(qq{ + CREATE TABLE $table ( + id integer primary key, + name text, + title text, + type integer, + depth integer, + parent_id integer, + + self_size integer, + kids_size integer, + kids_node_count integer, + child_ids text, + attr_json text, + leaves_json text + ) + }); + $node_ins_sth = $dbh->prepare(qq{ + INSERT INTO $table VALUES (?,?,?,?,?,?, ?,?,?,?,?,?) + }); + } + } + elsif ($type eq 'E') { # end of a run + + my $top = $stack[0]; # grab top node before we pop all the nodes + leave_node(pop @stack) while @stack; + my $top_size = $top->{self_size}+$top->{kids_size}; + + printf "Stored %d nodes sizing %s (%d)\n", + $top->{kids_node_count}, fmt_size($top_size), $top_size; + + if ($opt_verbose or $run_size != $top_size) { + warn "EOF ends $top->{id} d$top->{depth}: size $top->{self_size}+$top->{kids_size}\n"; + warn Dumper($top); + } + die "panic: seqn2node should be empty ". Dumper(\%seqn2node) + if %seqn2node; + %$pending_pre_attr = (); + + if ($dot_fh) { + print $dot_fh "}\n"; + close $dot_fh; + system("open -a Graphviz $opt_dot") if $^O eq 'darwin'; # OSX + } + + $dbh->commit if $dbh; + } else { warn "Invalid type '$type' on line $. ($_)"; next; @@ -293,28 +334,8 @@ while (<>) { $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; -my $top_size = $top->{self_size}+$top->{kids_size}; - -printf "Stored %d nodes recording %s (%d)\n", - $top->{kids_node_count}, fmt_size($top_size), $top_size; - -if ($opt_verbose or $run_size != $top_size) { - 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"; - close $dot_fh; - system("open -a Graphviz $opt_dot") if $^O eq 'darwin'; # OSX -} - -$dbh->commit if $dbh; +die "EOF without end token" if @stack; -use Data::Dumper; -warn Dumper(\%seqn2node) if %seqn2node; # should be empty =for This is out of date but gives you an idea of the data and stream diff --git a/lib/Devel/SizeMe.pm b/lib/Devel/SizeMe.pm index 7397395..2acbf44 100644 --- a/lib/Devel/SizeMe.pm +++ b/lib/Devel/SizeMe.pm @@ -2,7 +2,7 @@ package Devel::SizeMe; require Devel::Memory; -$ENV{SIZEME} = "|sizeme_store.pl --db sizeme.db"; +$ENV{SIZEME} = "|sizeme_store.pl -d --text --db sizeme.db"; # It's handy to say "perl -d:SizeMe" but has side effects # currently we simple disable the debugger (as best we can)