#!/usr/bin/perl

use strict;
use Getopt::Long;

my %opts;
GetOptions (
	"d=s" => \$opts{'d'},
	"a=s" => \$opts{'a'},
	"o=s" => \$opts{'o'},
	"h" => \&help,
	"help" => \&help
);

if (!$opts{'a'}){
	help();
}

my ($name, $name1);
if ($opts{'a'}=~/([\w\.\\\/_]+?)(\.\w+)?$/) {
	$name = $1;
}
if ($opts{'o'}){
	$name1 = $opts{'o'};
} else {
	$name1 = $name.".svg";
}
main($opts{'a'}, $name.".dot", $name1, $opts{'d'});

sub main($$$$){
	my ($fasm, $fdot, $fsvg, $dopt) = @_;
	writeDOT($fdot, generate( readASM($fasm) ));
	doSVG($fdot, $fsvg, $dopt);
}

sub help(){
	die "
	Usage: $0 -a *.asm [-o *.svg] [-d '*']
	-a *.asm - Input file.
	-o *.svg - Output file.
	-d '*' - DOT run with arguments.
		example, for generate PNG
		$0 -a *.asm -d 'dot -Tpng *.dot -o *.png'
	-h - Help.
	Open SVG: browsers, image viewers.
	If you have a problem with DOT: 
		install graphviz for your OS:
		http://www.graphviz.org/Download.php
		and try $0 -a *.asm -d 'dot -Tsvg *.dot -o *.svg'
		or	$0 -a *.asm -d 'dot *.dot  -Tsvg > *.svg'
	\n";
}

sub readASM($){
	my $fasm = $_[0];
	open fin, $fasm or die "Can't open file: ".$fasm.": $!\n";
	
	my (@source, @index);
	
	while(<fin>){
		T: if($_=~/^\.text/){
			while(<fin>){
				s#;[^\n]*$##;
				s#\/\/[^\n]*$##;
				s#^(\s)*##;
				if($_=~/[^\s\/]/){

					if($_=~/^[^\.].*/){
						push @source, $_;
						push @index, $.;
					} else {
						if($_=~/^\.text/){
							goto T;
						}
					}
				}
			}
		}
	}
	
	close fin;
	
	[ \@source, \@index ];
}

sub writeDOT($$){
	my $fdot = $_[0];
	my @graph = @{ $_[1] };
	
	open fout, ">$fdot" or die "Can't open file ".$fdot.": $!\n";
	print fout @graph;
	close fout;
	
	print "\nDOT file: Complete. $fdot\n";
}

sub doSVG($$$){
	if ($_[2]){
		`$_[2]`;
	} else {
		`dot -Tsvg $_[0] -o $_[1]`;
	}
	print "\nComplete.\n\n";
}

sub generate($){
	my @ref = @{ $_[0] };
	my @source = @{ $ref[0] };
	my @index = @{ $ref[1] };
	
	my @g;
	
	my $n = 0;

	my %names;
	my $lastlabel;

	while($n <= $#source){

		if($source[$n]=~/([^:]*):[^=]/){ #
			my ($name, @par, $c);
			$name = $1; $c = $n;
			
			if (!$names{$name}){
				$lastlabel++;
				$names{$name}="P".$lastlabel;
			}
			
			++$n;
			my %id;
			my $ind = $c;
			while($n <= $#source){
				if($source[$n]=~/complete/i){
					last;
				} else {

					my $command;
					if($source[$n]=~/([\w_]+)\s*:=\s*(.+)/){
						$command = $2;
						$id{$1} = $ind;
					}else{
						$command = $source[$n];
					}

					$command =~ /(\S+)\s*([^\n,]+)?\s*,?\s*([^\n,]+)?\s*,?\s*([^\n,]+)?/;
					my @temp;
					push @temp, $1;
					if($2 || $2 eq '0'){ push @temp, $2;}
					if($3 || $3 eq '0'){ push @temp, $3;}
					if($4 || $4 eq '0'){ push @temp, $4;}

					for (@temp){
						$_ =~ s#\s##g;
						if ($_=~/@(\D[\w\._]*)/){
							$_ = "@".($ind - $id{$1})
						}
					}

					if($#temp >= 0){ push @par, [@temp];}
					$ind++;
				}
				++$n;
			}
			push @g, @{ generateParagraph( $name, \@par, $c, \@index, \%names, \$lastlabel ) };
		}
		++$n;
	}
	unshift @g, "\tcompound=true;\n\tgraph [splines=line];\n";
	unshift @g, "digraph G {\n";
	push @g, "}\n";
	
	\@g;
}

sub generateParagraph($$$$$$){
	my $name = $_[0];

	my @a = @{ $_[1] };
	my $i = $_[2] + 1;
	my @index = @{ $_[3] };
	
	my (@g1, @g, @main, @tail, @xlabel);
	
	my %h = ( 
		'rd' => [], 'wr' => [],
		'se' => [], 'ge' => []
	);
	
	my %f = (
		'jae' => \&cond_jmp, 'ja' => \&cond_jmp, 'jbe' => \&cond_jmp, 'jb' => \&cond_jmp, 
		'jge' => \&cond_jmp, 'jg' => \&cond_jmp, 'je' => \&cond_jmp, 'jne' => \&cond_jmp,
		'jno' => \&cond_jmp, 'jns' => \&cond_jmp, 'jle' => \&cond_jmp, 'jl' => \&cond_jmp,
		'jo' => \&cond_jmp, 'js' => \&cond_jmp,
		'jmp' => \&jmp, 'exa' => \&exa,
		'smth' => \&smth, 'rd' =>  \&rd, 'wr' => \&wr, 'get'=> \&get
	);

	my @list;
	my $k = $i;
	
	for(@a){
		my @p = @{$_};
		
		if( $f{ $p[0] } ) {
			( $f{ $p[0] } ) -> ( \@p, $name, $i, \@index, \@g, \@tail, $_[4], $_[5] );
		} else {
			if ($p[0]=~/(wr|set|get)(?:b|l|q|sb|sl|f|p|c)/i){
				if($1=~/get/){
					( $f{ 'get' } ) -> ( \@p, $i, \@index, \@main, \%h, \@xlabel );
				} else {
					( $f{ 'wr' } ) -> ( \@p, $i, \@index, \@main, \%h, \@xlabel );
				}
			} else {
				if ($p[0]=~/rd(?:b|l|q|sb|sl|f|p|c)/i){
					( $f{ 'rd' } ) -> ( \@p, $i, \@index, \@main, \@xlabel);
				} else {
					( $f{ 'smth' } ) -> ( \@p, $i, \@index, \@main, \@xlabel);
				}
				push @list, $i;
			}
		}
		++$i;
	}
	
	my @ranks = @{ structImprove( \@a, $k, \@list, ${ $_[4] }{$name} ) };
	
	my $key = '';
	my %rank = (
		'wr' => 'sink', 
		'se' => 'sink'
	);
	foreach $key (keys %h){
		my @v = @{ $h{$key} };
		my $s;
		for(@v){
			$s.="Ind".$_." ";
		}
		if($s){
			push @main, "\t\t\t{rank=".$rank{$key}."; $s};\n";
		}
	}
	
	my $name1 = ${ $_[4] }{$name};

	push @g1, "\tsubgraph cluster$name1 {\n\t\t"
			."style=bold;\n\t\tcolor=slategray;\n\t\t"
			.'label="'.$name.'";'."\n\t\tfontsize=30;\n"
			."\t\tone$name1->two$name1->three$name1->four$name1 [style=invis]\n"
			."\t\tone$name1 [shape=point style=invis];\n";
			
	push @g1, "\t\tsubgraph cluster$name1"."Main {\n\t\t\tlabel=".'"";'."\n"
			."\t\t\tstyle=invis;\n\t\t\ttwo$name1 [shape=point style=invis];\n"
			."\t\t\tthree$name1 [shape=point style=invis];\n\t\t\t{rank=source; two$name1};\n"
			."\t\t\t{rank=sink; three$name1};\n";
	
	push @g1, @main;
	
	push @g1, @ranks;
	
	push @g1, "\t\t}\n\t\tsubgraph cluster$name1"."Tail {\n\t\t\tlabel=".'""'."\n"
			."\t\t\tstyle=invis;\n\t\t\tfour$name1 [shape=point style=invis];\n";
			
	push @g1, @tail;
	
	push @g1, "\t\t}\n\t}\n";
	
	push @g1, @g;
		
	\@g1;
}

sub cond_jmp($$$$$$$$){
	my ($p_r, $name, $i, $index_r, $g_r, $tail_r) = @_;
	my $name1 = ${ $_[6] }{$name};	

	push @{ $tail_r }, "\t\t\tInd$i",' [label="'.${ $p_r }[0].'" shape=diamond color=slategray '
			." style=bold];\n";
	shift @{ $p_r }, "\n";

	${ $p_r }[0]=~/@(\d+)/;
	my $j = $i - $1;
	push @{ $g_r }, "\tInd$j -> Ind$i;\n";
	
	
	if(${ $p_r }[1]=~/@(\d+)/){
		my $j = $i - $1;
		push @{ $g_r }, "\tInd$j -> Ind$i;\n"; # 
	} else {

		${ $p_r }[1]=~s#\s##g;

		if(${ $p_r }[1]=~/#(\S+)/){
			my $label = ${ $p_r }[1];
			if($#{ $p_r }>1){ $label .= " + ".${ $p_r }[2]; }
			push @{ $tail_r }, "\tInd$i"."_Arg1 [label=".'"'.$label.'"'." shape=box]\n"; # 
			push @{ $tail_r }, "\tInd$i"."_Arg1 -> Ind$i\n"; # 
		} else {

			if(${ $p_r }[1] ne $name) {	
				if (! ${ $_[6] }{${ $p_r }[1]} ){
					${ $_[7] }++;
					${ $_[6] }{${ $p_r }[1]}="P".${ $_[7] };
				}
				my $labelname = ${ $_[6] }{ ${ $p_r }[1] };
				push @{ $g_r }, "\tInd$i -> one".$labelname." [lhead=cluster$labelname style=bold color=slategray]\n";
			} else { # ????
				my $labelname = ${ $_[6] }{ ${ $p_r }[1] };
				push @{ $g_r },"\t$name1 [shape=point style=invis]\n"
					."\tInd$i -> $name1 [style=bold color=slategray arrowhead=".'"none"'." ]\n"
					."\t$name1 -> three".$labelname." [lhead=cluster".$labelname
					." style=bold color=slategray]\n";
			}
		}
	}
}

sub jmp($$$$$$$$){
	my ($p_r, $name, $i, $index_r, $g_r, $tail_r) = @_;
	my $name1 = ${ $_[6] }{$name};

	push @{ $tail_r }, "\t\t\tInd$i",' [label="'.${ $p_r }[0].'" shape=diamond color=slategray '
		." style=bold];\n";
	
	if(${ $p_r }[1]=~/@(\d+)/){
		my $j = $i - $1;
		push @{ $g_r }, "\tInd$j -> Ind$i;\n"; # 
	} else {
		${ $p_r }[1]=~s#\s##g;

		if(${ $p_r }[1]=~/#(\S+)/){
			my $label = ${ $p_r }[1];
			if($#{ $p_r }>1){ $label .= " + ".${ $p_r }[2]; }
			push @{ $tail_r }, "\tInd$i"."_Arg1 [label=".'"'.$label.'"'." shape=box ]\n"; # 
			push @{ $tail_r }, "\tInd$i"."_Arg1 -> Ind$i\n"; # 
		} else {
			if(${ $p_r }[1] ne $name) {
				if (! ${ $_[6] }{${ $p_r }[1]} ){
					${ $_[7] }++;
					${ $_[6] }{${ $p_r }[1]}="P".${ $_[7] };
				}
				my $labelname = ${ $_[6] }{ ${ $p_r }[1] };
				push @{ $g_r }, "\tInd$i -> one".$labelname." [lhead=cluster".$labelname
					." style=bold color=slategray]\n";
			} else {
				my $labelname = ${ $_[6] }{ ${ $p_r }[1] };
				push @{ $g_r },"\t$name1 [shape=point style=invis]\n"
					."\tInd$i -> $name1 [style=bold color=slategray arrowhead=".'"none"'." ]\n"
					."\t$name1 -> three".$labelname." [lhead=cluster".$labelname
					." style=bold color=slategray]\n";
			}
		}
	}
}

sub exa($$$$$$){
	my ($p_r, $name, $i, $index_r, $g_r, $tail_r) = @_;
	my $label = ${ $p_r }[0].'\n';
	shift @{ $p_r };
	$label.=(join ' + \n', @{ $p_r });
	if(!$#{ $p_r }){ $label.='\n '; }
	push @{ $tail_r }, "\t\t\tInd$i",' [label="'.$label.'" shape=box];'."\n";
}

sub wr($$$$$$){
	my ($p_r, $i, $index_r, $main_r, $h_r, $xlabel_r) = @_;
	my $label = ${ $p_r }[0];
	my $group = substr ${ $p_r }[0], 0, 2;
	my @temp;
	my $n = 1;
	shift @{ $p_r };
	${ $xlabel_r }[$i] = 1;
	if(${ $p_r }[0]=~/@(\d+)/){
		for(@{ $p_r }){
			if($_=~/@(\d+)/){
				my $j = $i - $1;
				push @{ $main_r }, "\t\t\tInd$j -> Ind$i [xlabel=".$n." color=teal];\n";
			} else {
				push @temp, $_;
			}
			$n++;
		}
		$label.='\n';
		$label.=(join ' + \n', @temp);
		if(!$#temp){ $label.='\n '; }
	} else {
		$label.='\n'.${ $p_r }[0].'\n ';
		shift @{ $p_r };
		my @temp; my $n1=2; my $l;
		for(@{ $p_r }){
			if($_=~/@(\d+)/){
				my $j = $i - $1;
				push @{ $main_r }, "\t\t\tInd$j -> Ind$i [xlabel=".$n1." color=teal];\n";
			} else {
				push @temp, $_;
			}
			++$n1;
		}
		$l.=(join ' + \n', @temp);
		if($l || $l eq '0'){ 
			push @{ $main_r }, "\t\t\tInd$i"."_Arg2 [label=".'"'.$l.'"'." shape=box " 
			." group=main tooltip=".'"'."Ind$i".',Arg2'." (Line ".${ $index_r }[$i].')"'."];\n";
			push @{ $main_r }, "\t\t\tInd$i"."_Arg2"." -> Ind$i [xlabel=2 color=teal];\n";	#######
		}
	}
	push @{ ${ $h_r }{$group} }, $i;
	push @{ $main_r }, "\t\t\tInd$i [label=".'"'.$label.'"'." shape=box group=$group "
						.'tooltip="'."Ind$i "."(Line ".${ $index_r }[$i].')"'."];\n";
}

sub get($$$$$$){
	my ($p_r, $i, $index_r, $main_r, $h_r, $xlabel_r) = @_;
	my $label = ${ $p_r }[0];
	my $group = substr ${ $p_r }[0], 0, 2;
	my @temp;
	my $n = 1;
	shift @{ $p_r };
	${ $xlabel_r }[$i] = 1;
	if(${ $p_r }[0] =~ /@(\d+)/){
		my $j = $i - $1;
		push @{ $main_r }, "\t\t\tInd$j -> Ind$i [xlabel=".$n."];\n"; #####
	} else {
		$label.='\n';
		$label.=(join ' + \n', @{ $p_r });
		if(!$#{ $p_r }){ $label.='\n '; }
	}
	push @{ $main_r }, "\t\t\tInd$i [label=".'"'.$label.'"'." shape=box group=$group "
						.'tooltip="'."Ind$i "."(Line ".${ $index_r }[$i].')"'."];\n";
}

sub rd($$$$$$){
	my ($p_r, $i, $index_r, $main_r, $xlabel_r) = @_;
	my $label = ${ $p_r }[0];
	my $group = substr ${ $p_r }[0], 0, 2;
	my @temp;
	my $n = 1;
	shift @{ $p_r };
	${ $xlabel_r }[$i] = 1;
	if(${ $p_r }[0] =~ /@(\d+)/){
		my $j = $i - $1;
		push @{ $main_r }, "\t\t\tInd$j -> Ind$i [xlabel=".$n."];\n"; #######
	} else {
		$label.='\n';
		$label.=(join ' + \n', @{ $p_r });
		if(!$#{ $p_r }){ $label.='\n '; }
	}
	push @{ $main_r }, "\t\t\tInd$i [label=".'"'.$label.'"'." shape=box group=$group "
						.'tooltip="'."Ind$i "."(Line ".${ $index_r }[$i].')" color=teal'."];\n";
}

sub smth($$$$$){
	my ($p_r, $i, $index_r, $main_r, $xlabel_r) = @_;
	push @{ $main_r }, "\t\t\tInd$i [label=".'"'.${ $p_r }[0].'"'.' group=main '
				.'tooltip="'."Ind$i "."(Line ".${ $index_r }[$i].')"'."];\n";
	shift @{ $p_r };
	my $n = 1; my $n1;
	my @temp;
	for(@{ $p_r }){
		if($_=~/@(\d+)/){
			my $j = $i - $1;
			if(${ $xlabel_r }[$j]){
				push @{ $main_r }, "\t\t\tInd$j -> Ind$i [xlabel"."=$n"." color=teal " 
					."];\n";
			} else {
				push @{ $main_r }, "\t\t\tInd$j -> Ind$i [xlabel"."=$n"."];\n"; ####
			}
		} else {
			if(!$n1){ $n1 = $n; }
			push @temp, $_;
		}
		$n++;
	}
	my $label = (join ' + \n', @temp);
	if($label){
		push @{ $main_r }, "\t\t\tInd$i"."_Arg".$n1." [label=".'"'.$label.'"'." shape=box "
				."group=main tooltip=".'"'."Ind$i".',Arg'.$n1." (Line ".${ $index_r }[$i].')"'."];\n";
		push @{ $main_r }, "\t\t\tInd$i"."_Arg".$n1." -> Ind$i [xlabel=".$n1."];\n"; #####
	}
}

sub structImprove($$$$) {
	my ($a_r, $k, $list_r, $name) = @_;
	my (@res, @r);
	my (@temp, $f, $reg);
	
	for(@{ $list_r }){
		my $i = $_ - $k;
		my $p_r =  ${ $a_r }[$i];
		
		if(${ $p_r }[0]=~/rd(?:b|l|q|sb|sl|f|p|c)/i){
			if(!$f){
				if($#temp >= 0) {
					my @t = @temp;
					push @r, \@t;
					@temp=();
				}
			}
			push @temp, $_;

			$f=1;
		} else {
			if($f){
				my @t = @temp;
				push @r, \@t;
				@temp=();
			}
			my ($one, $two);
			if(${ $p_r }[1]=~/@(\d+)/) { $one=$1; }
			if(${ $p_r }[2]=~/@(\d+)/) { $two=$1; }
			if($one && $two){
				if($one <= ($#temp+1) || $two <= ($#temp+1)){
					if($#temp >= 0) {
						my @t = @temp;
						push @r, \@t;
						@temp=();
					}
				}
				push @temp, $_;
			} else {
				if($#temp >= 0) {
					my @t = @temp;
					push @r, \@t;
					@temp=();
				}
			}
			$f=0; $reg='';
		}
		
	}
	
	if($#temp >= 0){
		my @t = @temp;
		push @r, \@t;
	}
	
	my ($level, $invis, $l, @invis);
	for(@r){
		++$level;
		my @p = @{ $_ };
		
		my $str = "\t\t\t{rank=same; ";
		for(@p){
			$str .= "Ind$_ ";
		}
		$str .= " $name"."$level }\n";
		if($#p>=1) { push @res, $str; } ######################
	}
	if($level){
		$invis .= "\t\t\t";
		for $l (1..$level){
			push @invis, "$name$l";
			push @res, "\t\t\t$name"."$l [shape=point style=invis];\n";
		}
		$invis .= join '->', @invis;
		$invis .= "[style=invis];\n";
		unshift @res, $invis;
	}
	\@res;
}