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