#!/usr/bin/perl -w # vdbe_graph.pl use strict; use YAML; use Graph::Easy; use Getopt::Std; binmode STDOUT, ':utf8'; my %opt; getopts('o:f:', \%opt); my $g = Graph::Easy->new(); $g->set_attribute('flow', 'south'); my $prev; my @ops; while (<>) { chomp; my @fields = split /\t/, $_; next unless $fields[0] =~ /^\d+$/; my %curr; @curr{qw(n op p1 p2 p3)} = @fields; my $params = join(", ", @fields[2..$#fields]); my $n = $g->add_node($curr{n}); $n->set_attribute(label => "$curr{n} $curr{op} ($params)"); $n->set_attribute(align => 'left'); if ($prev) { $g->add_edge($prev->{n} => $curr{n}); } $prev = \%curr; push @ops, \%curr; } # If P2 is not zero and one or more of the entries are NULL, then jump to the address given by P2 # MakeRecord MoveGe MoveGt MoveLt MoveLe Rewind my %jumps = map { $_ => 1 } qw( Next Prev Gosub ForceInt MustBeInt Eq Ne Lt Le Gt Ge If IfNot IsNull NotNull MakeRecord MoveGe MoveGt MoveLt MoveLe Distinct Found NotFound IsUnique NotExists Last Rewind IdxGT IdxGE IdxLT FifoRead IfMemPos IfMemNeg IfMemZero VFilter VNext); for my $n (grep { exists $jumps{$_->{op}} } @ops) { $g->add_edge($n->{n} => $n->{p2}); } for my $n (grep { $_->{op} eq 'Goto' } @ops) { $g->add_edge($n->{n} => $n->{p2}); if ($n->{n} != $n->{n}+1) { $g->del_edge($g->edge($n->{n} => $n->{n}+1)); } } for my $n (grep { $_->{op} eq 'Halt' } @ops) { next unless $g->node($n->{n}+1); $g->del_edge($g->edge($n->{n} => $n->{n}+1)); } my $ext = ($opt{o} && $opt{o} =~ /\.(...)$/) ? $1 : ''; my %ext_formats = ( asc => 'ascii', html=> 'html', txt => 'txt', box => 'boxart', viz => 'graphviz', png => 'graphviz', ); my $format = $ext_formats{ $opt{f} || ''} || $opt{f} || $ext_formats{ext} || 'ascii'; # Where does the output go if (defined $opt{o}) { if ($ext eq 'png') { open OUT, "| dot -Tpng -o $opt{o}"; } else { open OUT, "> $opt{o}"; } select OUT; } if ($format eq 'ascii') { print $g->as_ascii; } elsif ($format eq 'boxart') { print $g->as_boxart; } elsif ($format eq 'graphviz') { print $g->as_graphviz; } elsif ($format eq 'txt') { print $g->as_txt; } elsif ($format eq 'html') { print $g->as_html; } else { die; }