#!/usr/bin/perl -w # See copyright, etc in below POD section. ###################################################################### require 5.006_001; use Getopt::Long; use IO::File; use Pod::Usage; use Data::Dumper; $Data::Dumper::Indent=1; use strict; use vars qw($Debug); #====================================================================== our @Header; our %Vertexes; our %Edges; our %User; our %User2; #====================================================================== # main $Debug = 0; my $opt_filename; my $opt_circle; autoflush STDOUT 1; autoflush STDERR 1; if (! GetOptions( "help" => \&usage, "debug" => \&debug, "<>" => \¶meter, "circle=s" => \$opt_circle, )) { usage(); } dotread($opt_filename); circle($opt_circle) if $opt_circle; simplify(); dotwrite(); #---------------------------------------------------------------------- sub usage { pod2usage(-verbose=>2, -exitval=>2, -output=>\*STDOUT); exit(1); } sub debug { $Debug = 1; } sub parameter { my $param = shift; if (!$opt_filename) { $opt_filename = $param; } else { die "%Error: Unknown parameter: $param\n"; } } ####################################################################### sub dotread { my $filename = shift; my $fh = IO::File->new($filename) or die "%Error: $! $filename,"; my $header = 1; while (defined (my $line = $fh->getline)) { if ($line =~ /^\t([a-zA-Z0-9_]+)\t(.*)$/) { $header = 0; $Vertexes{$1} = $2; } elsif ($line =~ /^\t([a-zA-Z0-9_]+)\s+->\s+([a-zA-Z0-9_]+)\s+(.*)$/) { $Edges{$1}{$2} = $3; } elsif ($header) { push @Header, $line; } } } ###################################################################### sub simplify { foreach my $ver (sort (keys %Vertexes)) { $Vertexes{$ver} = _simplify($Vertexes{$ver}); } foreach my $v1 (sort (keys %Edges)) { foreach my $v2 (sort (keys %{$Edges{$v1}})) { $Edges{$v1}{$v2} = _simplify($Edges{$v1}{$v2}); } } } sub _simplify { my $text = shift; $text =~ s/__DOT__/./g; return $text; } sub dotwrite { foreach my $line (@Header) { print "$line"; } foreach my $ver (sort (keys %Vertexes)) { print "\t$ver\t$Vertexes{$ver}\n"; } foreach my $v1 (sort (keys %Edges)) { foreach my $v2 (sort (keys %{$Edges{$v1}})) { print "\t$v1 -> $v2\t$Edges{$v1}{$v2}\n"; } } print "}\n"; } ###################################################################### sub circle { my $node = shift; %User = (); %User2 = (); _circle_recurse($node, 1); foreach my $ver (keys %Vertexes) { if (!$User{$ver}) { delete $Vertexes{$ver}; delete $Edges{$ver}; } } foreach my $v1 (sort (keys %Edges)) { foreach my $v2 (sort (keys %{$Edges{$v1}})) { if (!$Vertexes{$v2}) { delete $Edges{$v1}{$v2}; } } } } sub _circle_recurse { my $node = $_[0]; my $level = $_[1]; $Vertexes{$node} or warn "%Warning: Can't find ref node $node\n"; $User{$node} = 1 if (($User2{$node}||0)==1); return $User{$node} if $User2{$node}; $User2{$node} = 1; my $r = 0; foreach my $v2 (keys %{$Edges{$node}}) { $r |= _circle_recurse($v2,$level++)||0; } $User{$node} = 1 if $r; $User2{$node} = 2; return $r; } ####################################################################### __END__ =pod =head1 NAME dot_pruner - =head1 SYNOPSIS dot_pruner *.log =head1 DESCRIPTION dd =head1 ARGUMENTS =over 4 =item --help Displays this message and program version and exits. =back =head1 DISTRIBUTION Copyright 2005-2019 by Wilson Snyder. Verilator is free software; you can redistribute it and/or modify it under the terms of either the GNU Lesser General Public License Version 3 or the Perl Artistic License Version 2.0. =head1 AUTHORS Wilson Snyder =head1 SEE ALSO =cut ###################################################################### ### Local Variables: ### compile-command: "./dot_pruner | tee ~/d/a.dot" ### End: