Commit | Line | Data |
2c631ee0 |
1 | #!/bin/env perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
fc6614ee |
6 | use Getopt::Long; |
7 | |
8 | GetOptions( |
9 | 'json!' => \my $opt_json, |
10 | ) or exit 1; |
94fab3d1 |
11 | |
2c631ee0 |
12 | my @stack; |
13 | my %seqn2node; |
14 | |
94fab3d1 |
15 | sub enter_node { |
16 | my $x = shift; |
17 | if ($opt_json) { |
18 | print " " x $x->{depth}; |
19 | print qq({ "id": "$x->{seqn}", "name": "$x->{name}", "depth":$x->{depth}, "children":[ \n); |
20 | } |
21 | return; |
22 | } |
23 | |
24 | sub leave_node { |
25 | my $x = shift; |
2c631ee0 |
26 | delete $seqn2node{$x->{seqn}}; |
94fab3d1 |
27 | my $self_size = 0; $self_size += $_ for values %{$x->{leaves}}; |
28 | $x->{self_size} = $self_size; |
2c631ee0 |
29 | if (my $parent = $stack[-1]) { |
30 | # link to parent |
31 | $x->{parent_seqn} = $parent->{seqn}; |
32 | # accumulate into parent |
33 | $parent->{kids_node_count} += 1 + ($x->{kids_node_count}||0); |
94fab3d1 |
34 | $parent->{kids_size} += $self_size + $x->{kids_size}; |
2c631ee0 |
35 | push @{$parent->{child_seqn}}, $x->{seqn}; |
36 | } |
37 | # output |
38 | # ... |
94fab3d1 |
39 | if ($opt_json) { |
40 | print " " x $x->{depth}; |
41 | my $size = $self_size + $x->{kids_size}; |
42 | print qq(], "data":{ "\$area": $size } },\n); |
43 | } |
44 | return; |
2c631ee0 |
45 | } |
46 | |
94fab3d1 |
47 | print "memnodes = [" if $opt_json; |
48 | |
2c631ee0 |
49 | while (<>) { |
50 | chomp; |
51 | my ($type, $seqn, $val, $name, $extra) = split / /, $_, 5; |
52 | if ($type eq "N") { # Node ($val is depth) |
53 | while ($val < @stack) { |
94fab3d1 |
54 | leave_node(my $x = pop @stack); |
2c631ee0 |
55 | warn "N $seqn d$val ends $x->{seqn} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n"; |
56 | } |
57 | die 1 if $stack[$val]; |
58 | my $node = $stack[$val] = { seqn => $seqn, name => $name, extra => $extra, attr => [], leaves => {}, depth => $val, self_size=>0, kids_size=>0 }; |
94fab3d1 |
59 | enter_node($node); |
2c631ee0 |
60 | $seqn2node{$seqn} = $node; |
61 | } |
62 | elsif ($type eq "L") { # Leaf name and memory size |
63 | my $node = $seqn2node{$seqn} || die; |
64 | $node->{leaves}{$name} += $val; |
65 | } |
66 | elsif ($type eq "A") { # Attribute name and value |
67 | my $node = $seqn2node{$seqn} || die; |
68 | push @{ $node->{attr} }, $name, $val; # pairs |
69 | } |
70 | else { |
71 | warn "Invalid type '$type' on line $. ($_)"; |
72 | } |
73 | } |
74 | |
75 | my $x; |
76 | while (@stack > 1) { |
94fab3d1 |
77 | leave_node($x = pop @stack) while @stack; |
2c631ee0 |
78 | warn "EOF ends $x->{seqn} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n"; |
79 | } |
94fab3d1 |
80 | print " ];\n" if $opt_json; |
81 | |
2c631ee0 |
82 | use Data::Dumper; |
83 | warn Dumper(\$x); |
84 | warn Dumper(\%seqn2node); |
85 | |
86 | =for |
87 | SV(PVAV) fill=1/1 [#1 @0] |
88 | : +64 sv =64 |
89 | : +16 av_max =80 |
90 | : AVelem-> [#2 @1] |
91 | : : SV(RV) [#3 @2] |
92 | : : : +24 sv =104 |
93 | : : : RV-> [#4 @3] |
94 | : : : : SV(PVAV) fill=-1/-1 [#5 @4] |
95 | : : : : : +64 sv =168 |
96 | : AVelem-> [#6 @1] |
97 | : : SV(IV) [#7 @2] |
98 | : : : +24 sv =192 |
99 | 192 at -e line 1. |
100 | =cut |
101 | __DATA__ |
102 | N 1 0 SV(PVAV) fill=1/1 |
103 | L 1 64 sv |
104 | L 1 16 av_max |
105 | N 2 1 AVelem-> |
106 | N 3 2 SV(RV) |
107 | L 3 24 sv |
108 | N 4 3 RV-> |
109 | N 5 4 SV(PVAV) fill=-1/-1 |
110 | L 5 64 sv |
111 | N 6 1 AVelem-> |
112 | N 7 2 SV(IV) |
113 | L 7 24 sv |