#!/usr/local/bin/perl
# trace_scan_chain.pl  A script to extract scan chains from netlists
# 
# By Jeff Winston  http://www.kwcpa.com/tools
# Rev. 1.0, 6/4/04 Copyright (C) 2004
# 
# ---------------------------------------------------------------------
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# #of the License, or (at your option) any later version.
 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# #along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
# USA.  or check out http://www.gnu.org/copyleft/gpl.html
# ---------------------------------------------------------------------

# for a thorough description, type trace_scan_chain.pl with no parameters

$| = 1; # enable autoflush

# user editable definitions - see the help description for details

# place and route tools add _ and numbers to the end of clock names when 
# building clock trees.  Trace_Scan_Chain needs to know which numerical suffixes 
# are valid.  The user must supply a list of clock names that end in numbers.
@clock_names_ending_in_numbers = ("clock_90","clock_150","clock_180");

# the below are all library specific.  The defaults are for Artisan

# valid names of output pins of devices found on scan chain
@valid_output_pins = (".Y",".PAD",".Q",".QN",".P",".S",".Z");

# valid names of clock pins for flops
@flop_clock_pins = (".CK",".CKN");

# valid names of clock pins for latches
@non_flop_clock_pins = (".G");

# valid names of scan input pins for flops
@pure_chain_input_pins = (".SI");

# valid names of input pins for lockdown latches
@valid_lockdown_input_pins = (".D");

# valid names of inputs pins for logic elements found on scan chains
@valid_logic_input_pins = (".A");

# valid names of other inputs pins of elements found on scan chains
@other_chain_input_pins = (".P",".PAD");

if ($#ARGV != 2) {
    
    print "Usage: trace_scan_chain.pl <input netlist>  <output file>  <starting signalname>\n\n";
    print "trace_scan_chain.pl will take a flat (typically post-route) netlist, and\n";
    print "a signal name at the end of a scan chain, and will trace out the entire\n";
    print "scan chain.  The output is a report listing the makeup of the scan \n";
    print "chain, with clock domain crossings highlighted.  It is optimized for\n";
    print "Artisan libraries, but all library specifics are abstracted into \n";
    print "lists at the top of the script which can be customized by the user. \n\n";
    print "Note that trace_scan_chain.pl starts at an output and works backwards,\n";
    print "but it has no idea what to do if it encounters a gate with more than\n";
    print "one data input.  Thus, the user must first trace from the pins into\n";
    print "the wire driven by the last D flop in the chain.  This wirename should\n";
    print "be given to trace_scan_chain as the starting signalname.\n\n";
    print "Finally, the user should edit trace_scan_chain.pl and hand-specify\n";
    print "the required list of clock names ending in numbers.\n\n";
    print "Note: This script has been tested with Magma 4.0 netlists.\n\n";
    exit;
}

# open files
$infile = shift @ARGV;
$infilename = "< $infile";
open (INFIL,$infilename);

$outfile = shift @ARGV;
$outfilename = "> $outfile";
open (OUTFIL,$outfilename);

$start = shift @ARGV;

print OUTFIL "Input filename: $infile  Startpoint: $start\n";

#inits
%pins=();
%gates=();
%orig_line=();
%clk=();
%clktype=();
%rclk=();
$concat_line = "";
$l=0;$t=0;$g=0;

while (<INFIL>) {

    # count lines, show count
    $l++; $t++;
    if ($l==50000) {
	$l=0;
	print "Processed $t lines\n";
    }

    # process incoming line - build full lines out of partial ones
    chomp;
    # if terminator
    if (($_ =~ ";") ||
	($_ =~ "//") ||
	($_ =~ "endmodule")) {

	# then end of line
	$real_line = $concat_line . " " . $_;
	$concat_line = "";

    } else { # not end of line
	$concat_line = $concat_line . " " . $_;
	next;
    }

    # skip it if no ( or if starts with "module"
    if ($real_line !~ m/\(/) {next;}
    if (substr($real_line,1,6) eq "module") {next;}

    # put , between first two words, get rid of all spaces
    $real_line =~ s/^\s+//;
    $sp = index($real_line," ");
    substr($real_line,$sp,1) = ",";
    $real_line =~  s/\s+//g;

    # this generates null items in its list
    @words = split /[\(\)\;\,\\]/, $real_line;

    # so parse through to 2nd non-null argument and call it gatename
    $z=0;
    while (length($words[$z]) <2) {$z++;}
    $z++;
    while (length($words[$z]) <2) {$z++;}
    $gatename = $words[$z];
	   
    # store line
    $orig_line{$gatename} = $real_line;

    $p=0; # p=0 means we are ready to start processing a pin/signal pair
          # p=1 means we have a pin, waiting for a wire
    # parse through remaining tokens, finding pin/signal pairs
    for ($x=$z+1; $x<=$#words; $x++) {

	# skip null tokens
	if (length($words[$x]) < 2) {next;}
	
	# need to remove spaces from words, strangely enough (might not need this anymore) 
	$cur_token = $words[$x];
	$cur_token =~ s/\s+//g;

	# if it's a pin, we're starting a new pair
	if (substr($cur_token,0,1)  eq ".") {
	    $pin = $cur_token;
	    $p=1;

	# if not, we're finishing a pair
	} elsif ($p==1) {
	    
	    # create a pinname%signalname pair to store
	    $entry = $pin . "\%" . $cur_token;

	    #store it in a list associate with the gate
	    push ( @{$pins{$gatename}}, $entry);

	    #if the pin is an output pin, store an association between the pin and the gate
	    foreach $outpin (@valid_output_pins) {
		if ($pin eq $outpin) {
		    $gates{$cur_token} = $gatename;
		    last;
		}
	    }

	    # handle clock pins
	    # first, identify the pin
	    $clk_pin_true =0;
	    $flop_clk_pin_true = 0;
	    foreach $clkpin (@flop_clock_pins) {
		if ($pin eq $clkpin) {
		    $flop_clk_pin_true = 1;
		    $clk_pin_true = 1;
		    last;
		}
	    }
	    if ($clk_pin_true == 0) {
		foreach $clkpin (@non_flop_clock_pins) {
		    if ($pin eq $clkpin) {
			$clk_pin_true = 1;
			last;
		    }
		}
	    }

	    # now - if it's any clock pin, 
	    # remove the numerical suffix
	    if ($clk_pin_true == 1) {
		$q = reverse($cur_token);
		$numerical_clock=0;
		foreach $clkname (@clock_names_ending_in_numbers) {
		    $len = length($clkname);
		    if (substr($q,0,$len) eq reverse($clkname)) {
			$numerical_clock=1;
			last;
		    }
		}
		if ($numerical_clock == 1) {
		    $pure_clk_pin = $cur_token;
		} else {
		    $us = index($q,"_");
		    $pred = substr($q,$us+1);
		    $pure_clk_pin = reverse($pred);
		}

		# store associations between the clock pin and the gate
		if ($flop_clk_pin_true) {
		    $clk{$gatename} = $pure_clk_pin;
		}
		$rclk{$gatename} = $cur_token; 
		$clktype{$gatename} = $pin;
	    }
	    # reset toggle
	    $p=0;
	}
    }
    # count gates
    $g++;
}

print "Processed $g gates\n";

# netlist loaded, trace output to input

#initialization
$lastclk = "foo";
$last_gate="foo";
$scan_flop_count=0;
$clkd=0;

# do forever - drop out when we get to the end of the chain
while (1) {

    # get gate driving start signal
    $driving_gate = $gates{$start};

    # if it's the same, or there's no more driving gates, we're done
    if (!$driving_gate || ($last_gate eq $driving_gate)) {
	last;
    }
    $last_gate = $driving_gate;

    # identify lockdown latches
    $gate_is_latch=0;
    if ($orig_line{$driving_gate} =~ "TLAT") {$gate_is_latch=1;}

    # make two passes through pin list so that .A is the last pin we look for  

    $done=0;
    for ($pass=0; $pass < 2; $pass++) {
	foreach $pin (@{$pins{$driving_gate}}) {

	    @elements = split /\%/, $pin;

	    $pure_chain_input_pin=0;
	    $chain_input_pin=0;
	    $lockdown_input_pin=0;
	    $logic_input_pin = 0;
	    foreach $pin (@pure_chain_input_pins) {
		if ($pin eq $elements[0]) {
		    $chain_input_pin=1;
		    $pure_chain_input_pin=1;
		    last;
		}
	    }
	    if ($chain_input_pin == 0) {
		foreach $pin (@other_chain_input_pins) {
		    if ($pin eq $elements[0]) {
			$chain_input_pin=1;
			last;
		    }
		}
	    }
	    if ($chain_input_pin == 0) {
		foreach $pin (@valid_lockdown_input_pins) {
		    if ($pin eq $elements[0]) {
			$lockdown_input_pin=1;
			last;
		    }
		}
	    }
	    if (($pass== 1) && ($chain_input_pin == 0) && ($lockdown_input_pin == 0)) {
		foreach $pin (@valid_logic_input_pins) {
		    if ($pin eq $elements[0]) {
			$logic_input_pin=1;
			last;
		    }
		}
	    }

	    if (($chain_input_pin == 1) ||
		(($lockdown_input_pin == 1) && ($gate_is_latch == 1)) ||
		($logic_input_pin == 1) ) {

		# if it's a clock domain crossing - flag it
		if (defined($clk{$driving_gate}) && ($clk{$driving_gate} ne $lastclk)) {
		    if ($lastclk ne "foo") {
			print OUTFIL "\n $clkd CLOCK DOMAIN CROSSING:  $lastclk -> $clk{$driving_gate} ($clktype{$driving_gate})\n\n";
			$clkd++;
		    }
		    $lastclk = $clk{$driving_gate};
		}

		# otherwise, just print the information for this gate
		print OUTFIL "$scan_flop_count: Wire $start is driven by $driving_gate, which has $elements[1] as input $elements[0]";
		if (exists($rclk{$driving_gate})) {
		    print OUTFIL " and clock $rclk{$driving_gate} ($clktype{$driving_gate})";
		}
		print OUTFIL "\n";

		# advance the start from output ot input
		$start = $elements[1];
		if ($pure_chain_input_pin == 1) {$scan_flop_count++;}

		# exit both loops
		$done=1;
	    }
	    if ($done == 1) {last;}
	}
	if ($done == 1) {last;}
    }
}

# final summary
print OUTFIL "Found $scan_flop_count elements, $clkd clock domain crossings\n";
print "Found $scan_flop_count elements, $clkd clock domain crossings\n";