#! /usr/local/bin/perl

##############################################################################
#
#    dc_perl
#
#    Copyright 1997 Steve Golson
#
#    You may distribute under the terms of either the GNU General Public
#    License or the Artistic License, as specified in the README file.
#
#    the do_the_right_thing command added by Kurt Baty
#
##############################################################################

#sub my_expect
#    {
#    local( $a, $b, $c ) = @_;
#    @my_res = &expect( $a, $b, $c );
#    #print "expect($a,$b,$c) = [$my_res[2]|$my_res[0]|$my_res[3]]:  <$my_res[1]>\n";
#    return @my_res;
#    }

require 5.002 ;
require "Comm.pl";
&Comm'init( 1.8 );

use Getopt::Std;
use FileHandle;

########## catch signals

sub GotINT {
    print "dc_perl caught signal INT\n" ;
    if ($dc_perl_debug) {
        select (DC_PERL_DEBUG_LOG);
        $| = 1;
	print DC_PERL_DEBUG_LOG ("flush the debug log");
    }
    goto LOOP ;
}

sub GotQUIT {
    print "dc_perl caught signal QUIT\n" ;
    exit;
}

sub GotTERM {
    print "dc_perl caught signal TERM\n" ;
    exit;
}

sub GotSig {
    exit;
}

$SIG{"INT"}  = "GotINT";
$SIG{"QUIT"} = "GotQUIT";
$SIG{"TERM"} = "GotTERM";

########## setup Debuging

$dc_perl_debug = 0;

# uncomment this line to get the dc_perl_debug.log
#$dc_perl_debug = 1;
#

if (dc_perl_debug) {
      unless (open(DC_PERL_DEBUG_LOG, ">dc_perl_debug.log")) {
	if (!(-w "dc_perl_debug.log")) {
	  print STDERR "Error: dc_perl doesn't have write permission to dc_perl_debug.log\n";
	  exit;
        }
	print STDERR "Error: dc_perl can't open dc_perl_debug.log for writing\n";
	exit;
      }
}

########## initialize variables etc.

$hdl_language = "verilog";
$hdl_suffix = ".v";
$constraint_file_suffix = ".const";
$script_file_suffix = ".script";
$gate_level_file_suffix = ".psv";
$synthesis_log_file_suffix = ".synlog";
$design_ware_or_template_suffix = ".dwt";

STDOUT->autoflush(1);
STDERR->autoflush(1);

$dc_shell_prompt = "dc_shell> " ;
$dc_perl_prompt = "dc_perl> " ;
$perl_prompt = "perl> " ;

$dc_shell_tmp_var = "%%dc_perl_tmp_var%%" ;


$perl_mode = 0 ;
$is_batch = 0 ;

########## check options

getopt('f');

if ($opt_f) {
    open(BATCHFILE,"<$opt_f") || die "Could not open batch file $opt_f : $!\n" ;
    }

########## invoke dc_shell

# would rather invoke dc_shell_exec directly, so we know the pid of
# the child -- but how do you do 'which' if not running csh?

&open_dc_shell(1);

########## quietly initialize dc_shell variables

$is_batch = 1 ;

########## execute batch file, if any

$is_batch = 1 ;
if ($opt_f) {
    while (<BATCHFILE>) { &_parse_line($_) ; }
    close(BATCHFILE) ;
    }

########## begin interactive processing

$is_batch = 0 ;
print $dc_perl_prompt ;
print DC_PERL_DEBUG_LOG $dc_perl_prompt if $dc_perl_debug;

LOOP: while (<STDIN>) { 
	# for debugging what just came in
	print DC_PERL_DEBUG_LOG ("just got the line:  $_") if $dc_perl_debug;
	&_parse_line($_) ;
}

die "How did I get here?\n" ;

################################################################################
##
## dc_perl commands
##

################################################################################
##
## open_dc_shell
##
sub open_dc_shell {
    my $variable = shift ;
    ( $Proc_pty_handle, $Proc_tty_handle, $pid ) = &open_proc( "dc_shell" );
    die "dc_shell open failed" unless $Proc_pty_handle;
     
    # read data until you get a prompt
    &wait_for_dc_prompt($variable) ;
    &get_dc_shell_cmd('enable_page_mode = "false"') ;   # disable page mode
    &get_dc_shell_cmd('suppress_errors = suppress_errors + {EQN-10 UID-95 LINK-5 OPT-170}') ;   # disable page mode
    }

################################################################################
##
## close_dc_shell
##
sub close_dc_shell {
    &close_it( $Proc_pty_handle );
    }

########################################
## $return = &dc_shell_cmd($cmd) ;
##
## sends $cmd to child process
## prints and returns the results

sub dc_shell_cmd {
    return &_dc_shell_cmd(1, @_) ;
    }

########################################
## $return = &get_dc_shell_cmd($cmd) ;
##
## sends $cmd to child process
## returns the results without printing anything

sub get_dc_shell_cmd {
    return &_dc_shell_cmd(0, @_) ;
    }

########################################
## $value = &get_dc_shell_variable($variable);
## @value = &get_dc_shell_variable($variable);
##
## gets the value of the specified dc_shell variable
##
## if called in an array context, the value of $variable
## is parsed as a dc_shell list, and each element is returned
## as part of a list. double-quotes are removed from around
## each individual element
##
## if called in a scalar context, the value is returned
## double-quotes and brackets are removed from around the value

sub get_dc_shell_variable {
    my $variable = shift ;
    my ($try,$try2,$variable_and_equal);
    my @list ;

    while (1) {
	$try = &get_dc_shell_cmd("list $variable") ;
	$variable_and_equal = $variable." = ";
	$variable_and_equal =~ s/^ *//;
	if ($try =~ /$variable_and_equal/) {
	    last;
	}
	else {
	    print DC_PERL_DEBUG_LOG
		  ("\nI was right the get_dc_shell_variable subroutine",
		   " is getting messed up\n",
		   "I am lookin for the variable \"$variable\"\n")
		    if $dc_perl_debug;
	    sleep (10);
	}
    }

    #print DC_PERL_DEBUG_LOG "try to get $variable the readback is\n$try\n" if $dc_perl_debug;
    $_ = $try;
    # extract the value
    m/$variable_and_equal(.*)\n/ ;
    $try2 = $1;
    $_ = $try2;
    s/^ *=* *//;
    print DC_PERL_DEBUG_LOG "try to get $variable the extract is $try2\n" if $dc_perl_debug;
    if (wantarray) {    # parse as a list
        # remove surrounding brackets {}
        s/^{// ;
        s/}$// ;
	if ($_ eq "\"\"") {
                print DC_PERL_DEBUG_LOG "the string is only  =  $_\n" if $dc_perl_debug;
		return @list ;
	}
	if ($_ eq "0") {
                print DC_PERL_DEBUG_LOG "the string is only  =  $_\n" if $dc_perl_debug;
		return @list ;
	}
        s/"", *// ;
        # split into a list
        @list = split /, / ;
        # remove quotes "" from around each element
        grep {s/^"// ; s/"$// ;} @list ;
        print DC_PERL_DEBUG_LOG "this \@$variable =  @list\n" if $dc_perl_debug;
        return @list ;
        }
    else {      # parse as a scalar
        # remove surrounding brackets {} and quotes ""
        s/^[{"]*// ;
        s/["}]*$// ;
        print DC_PERL_DEBUG_LOG "this \$$variable =  $_\n" if $dc_perl_debug;
        return $_ ;
        }
    }

########################################
## &set_dc_shell_variable($variable, VALUE) ;
##
## sets the value of the specified dc_shell variable
## VALUE may be a scalar or a list
## if VALUE is a perl list, then $variable is assigned as a dc_shell list
##
## how do you create a dc_shell list with one element?
## make a string with {} around it:
##   &get_dc_shell_cmd("myvar", "{hello}");

sub set_dc_shell_variable {
    my ($variable) = shift ;
    my $num_of_elements = @_ ;
    my $value = "" ;
    my $tmp ;

    # use bogus variable name if you want VALUE left in dc_shell_status
    if ($variable eq "dc_shell_status") {
        &get_dc_shell_cmd("remove_variable $dc_shell_tmp_var") ;
        $variable = $dc_shell_tmp_var ;
        }

    if ($num_of_elements==1) {
        # scalar
        $value = $_[0] ;
        }

    else {
        # list
        $value = &_list_to_synopsys_list(@_);
        }

    &get_dc_shell_cmd("$variable = $value;") ;
    # ?? should this always print ??
    # instead print last line from get_dc_shell_cmd
    # print "$value\n" ;
                        
    return undef ;
    }

########################################
## &begin_perl(); or &begin_perl;
##
## indicates the beginning of perl commands
## all lines between this one and the next "&end_perl;"
## are evaluated by the perl interpreter

sub begin_perl {
    $perl_mode = 1 ;
    $eval_buffer = "" ;
    }

########################################
## &end_perl;
##
## indicates the end of perl commands
## never actually invoked, because "&end_perl;" is parsed as a token
## indicating that everything before it should be evaluated

sub end_perl {
    warn "&end_perl was called with perl_mode $perl_mode" ;
    $perl_mode = 0 ;
    }

##############################################################################
##
## utility subroutines
##

###########################################################
## $a_synosys_list = &_list_to_synopsys_list(a_list) ;
##

sub _list_to_synopsys_list {
	if (@_ < 1) {
		return ("{}");
	} else {
        	return ("{\"".(join "\", \"", @_)."\"}");
        }
}

###########################################################
## @a_list = &_synopsys_list_to_list($a_synopsys_list) ;
##

sub _synopsys_list_to_list {
    my $a_synopsys_list = shift ;
    my @list;
    $_ = $a_synopsys_list;
    # remove surrounding brackets {}
    s/^{// ;
    s/}$// ;
    if ($_ eq "\"\"") {
	return @list ;
    }
    if ($_ eq "0") {
        @list = (0);
	return @list ;
    }
    s/"",\s*// ;
    # split into a list
    @list = split /, / ;
    # remove quotes "" from around each element
    grep {s/^"// ; s/"$// ;} @list ;
    return @list ;
}

########################################
## &perl_cmd($cmd) ;
##
## parses and evals perl commands

sub perl_cmd {
    my $line = shift ;

    if ($line =~ /\s*&end_perl\s*;\s*$/) {
        # found "&end_perl;"
        eval $eval_buffer ; warn $@ if $@ ;
        $perl_mode = 0 ;
        }
    else {
        # add the line you got to the eval buffer
        $eval_buffer .= $line ;
        }
    }

########################################
## &_parse_line($line) ;
##
## $line contains a line read from STDIN or batch file
## parses and executes the line

sub _parse_line {
    my $line = shift ;
    chop $line ;
    #print (quotemeta($line), "\n");
    if ($perl_mode) {           # perl commands
        &perl_cmd($line) ;
        }
    elsif (/^\s*&/) {           # single perl command
        eval $line ; warn $@ if $@ ;
        }
    elsif (/^[\s|\t]*do_the_right_thing(.*)/) {
    # the new do_the_right_thing command
	my (@temp);
	@temp = split (/[\s|\t]+/,$1);
	$_ = $temp[1];
	s/;$//;
	s/\.\S+$//;
	&do_the_right_thing($_);
        }
    elsif (/^[\s|\t]*exit(.*)/) {
        &dc_shell_cmd($line);
        exit;
        }
    elsif (/^[\s|\t]*quit(.*)/) {
        &dc_shell_cmd($line);
        exit;
        }
    else {                      # dc_shell command
        &dc_shell_cmd($line);
        }
    # print prompt
    my $this_prompt = $perl_mode ? $perl_prompt : $dc_perl_prompt;
    print $this_prompt unless $is_batch;
    print DC_PERL_DEBUG_LOG $this_prompt if $dc_perl_debug;
	
}

########################################
## $return = &_dc_shell_cmd($doprint, $cmd) ;
##
## sends $cmd to child process
## returns the results
## prints where appropriate if enabled

sub _dc_shell_cmd {
    my $doprint = shift ;
    my ($lines,$try) ;
    my @the_cmd = @_;
    $_ = @the_cmd[0] ;
    s/^ *//;
    s/^(\S+)//;
    $_ = $1;
    s/\(.*//;
    my $the_first_word_of_the_cmd = $_ ;
    print DC_PERL_DEBUG_LOG
	"\t\$the_first_word_of_the_cmd = \"$the_first_word_of_the_cmd\"\n"
	if $dc_perl_debug;
    # send the command to the child
    &emit_dc_cmd(@the_cmd) ;

    # get the echoed command
    while (1) {
        $try = &get_line(1) ;
	if ($try =~ /$the_first_word_of_the_cmd/) {
	    last;
	}
	else {
	#   print DC_PERL_DEBUG_LOG
	#	  ("\nI was right the _dc_shell_cmd subroutine",
	#	   " is getting messed up\n",
	#	   "looking for the echo of the command:\n",
	#	   "\"$the_first_word_of_the_cmd\"\n",
	#	   "the line that was returned was:\n",
	#	   "\"$try\"\n")
	#	    if $dc_perl_debug;
#	    if (!($OutBuffer =~ /[\s\S]*?\n[\s\S]*/)) {
#		last;
#	    }
	}
    }

    $lines = $try;

    # print echoed command if in batch mode and printing enabled
    print $lines if ($doprint and $is_batch) ;
    print DC_PERL_DEBUG_LOG $lines if $dc_perl_debug;

    # get command output
    $lines = &wait_for_dc_prompt($doprint) ;

    # return everything you got
    return $lines ;
    }

########################################
## &emit_dc_cmd($cmd);
##
## sends $cmd to child

sub emit_dc_cmd {
    print $Proc_pty_handle $_[0]."\n";
    }

########################################
## $return = &wait_for_dc_prompt($doprint);
##
## returns all output received from child, up to but not including
## a line received that contains only a dc_shell prompt and no newline
##
## if $doprint then prints everything that was returned (except the prompt)
##
## could be spoofed by an 'echo "dc_shell> "'
##
## this will hang if you never get a prompt

sub wait_for_dc_prompt {
    my $doprint = shift ;
    # exit immediately if OutBuffer already has the prompt
    # match as much as possible up to a newline
    if ($OutBuffer =~ /(''|[\s\S]*\n)($dc_shell_prompt$)/) {
        print $1 if $doprint ;
        print DC_PERL_DEBUG_LOG $1 if $dc_perl_debug;
	$OutBuffer = "" ;
        return $1 ;
        }
    my $lines = $OutBuffer ;
    my ( $match, $err, $before, $after );
    while (1) {
	( $match, $err, $before, $after ) =
	    &expect( $Proc_pty_handle, 2, $dc_shell_prompt  );
	if( $err ne "TIMEOUT" ) {
    	    print $before if $doprint ;
            print DC_PERL_DEBUG_LOG $before if $dc_perl_debug;
    	    $lines .= $before.$match.$after ;
	    $OutBuffer = $match.$after ; # save the rest
    	    if ($after =~ /(''|[\s\S]*\n)($dc_shell_prompt$)/) {
		print $match.$after if $doprint ;
		print DC_PERL_DEBUG_LOG $match.$after if $dc_perl_debug;
		$OutBuffer = "" ;
		}
    	    last if(defined $match);
	    last if($err eq 'EOF' );
	    }
	}
    return $lines ;
    }

########################################
## $return = &get_line($num);
##
## reads $num lines from child output, and returns them
## anything after the final newline is placed in $OutBuffer
##
## this will hang if you never get a newline

sub get_line {
    my $num = shift ;
    my $i ;
    my $line = "" ;
    for ($i=1; $i<=$num; $i++) {
        $line .= &_get_line() ;
        }
    return $line ;
    }

########################################
## $return = &_get_line();
##
## reads one line from child output, and returns it
## anything after the first newline is placed in $OutBuffer
##
## this will hang if you never get a newline

sub _get_line {
    my $line = $OutBuffer ;
    # exit immediately if OutBuffer already has a newline
    if ($OutBuffer =~ /([\s\S]*?\n)([\s\S]*)/) {
        $OutBuffer = $2 ;
        return $1 ;
        }
    my ( $match, $err, $before, $after );
    while (1) {
    	# match up to the first newline
	( $match, $err, $before, $after ) =
       	    &expect( $Proc_pty_handle, 60, '\n' );
	if( $err ne "TIMEOUT" ) {
	    $line .= $before.$match ; # append to line buffer
	    $OutBuffer = $after ;     # rest to OutBuffer
	    last if(defined $match);
	    last if($err eq 'EOF' );
	    }
        }
    return $line ;
    }

########################################
## @current_designs_dependences = &get_current_design_dependences();
##
## this subroutine returns a list of the sub-designs
## and include files of the current design
## 
## 

sub get_current_design_dependences {
	my (@temp, @current_designs_dependences);
	@temp = &get_sub_design_list;
	my ($count);
	while ($count < @temp) {
		$temp[$count] = ($temp[$count].".db");
        	$count++;
	}
	@current_designs_dependences = (@temp,
					&get_include_files_list);
	$count = 0;
	while ($count < @current_designs_dependences) {
        	print ("$current_designs_dependences[$count]\n");
        	$count++;
	}
	return @current_designs_dependences;
}

########################################
## @sub_designs = &get_sub_design_list();
##
## this subroutine returns a list of the sub-designs
## of the current design
## 
## 

sub get_sub_design_list {
    my (@sub_designs);
    $_ = &get_dc_shell_variable("current_design");
    s/.*: *//;
    my $current_design = $_;
    &_dc_shell_cmd(0,$current_design."_sub_designs = {};"); 
    &_dc_shell_cmd(0, 
	"foreach( each_ref_name, filter(find(reference) ".
	"\"\@is_black_box == true ".
	"&& \@is_unmapped == true ".
	"&& \@is_synlib_module == false ".
	"&& \@is_synlib_operator == false ".
	"&& \@is_combinational == false\")) {\n".
	"    if((get_attribute(-quiet each_ref_name, is_a_generic_tristate) != true)\\\n". 
	"        && (get_attribute(-quiet each_ref_name, is_a_generic_seq) != true)\\\n". 
	"        && (get_attribute(-quiet each_ref_name, hdl_template) == {})) {\n". 
	"		".$current_design."_sub_designs = ".$current_design."_sub_designs - each_ref_name + each_ref_name; \n".
	"    }\n".
	"}" ) ; #remember that _dc_shell_cmd adds a \n
    @sub_designs = &get_dc_shell_variable("$current_design"."_sub_designs");	 
    @sub_designs = sort(@sub_designs);
    return @sub_designs;
}

########################################
## @local_dw_list = &get_local_dw_list();
##
## this subroutine returns a list of the
## local designware or template parts used
## in the current design
## 
## 

sub get_local_dw_list {
    my (@local_dw);
    $_ = &get_dc_shell_variable("current_design");
    s/.*: *//;
    my $current_design = $_;
    &_dc_shell_cmd(0,$current_design."_local_dw = {};"); 
    &_dc_shell_cmd(0, 
	"foreach( each_ref_name, filter(find(reference) ".
	"\"\@is_black_box == true ".
	"&& \@is_unmapped == true ".
	"&& \@is_synlib_module == false ".
	"&& \@is_synlib_operator == false ".
	"&& \@is_combinational == false\")) {\n".
	"    if((get_attribute(-quiet each_ref_name, is_a_generic_tristate) != true)\\\n". 
	"        && (get_attribute(-quiet each_ref_name, is_a_generic_seq) != true)\\\n". 
	"        && (get_attribute(-quiet each_ref_name, hdl_template) != {})) {\n". 
	"		".$current_design."_local_dw = ".$current_design."_local_dw \\\n".
	"		     - get_attribute(each_ref_name,hdl_template) \\\n".
	"		     + get_attribute(each_ref_name,hdl_template); \n".
	"    }\n".
	"}" ) ; #remember that _dc_shell_cmd adds a \n
    @local_dw = &get_dc_shell_variable("$current_design"."_local_dw");	 
    @local_dw = sort(@local_dw);
    return @local_dw;
}

########################################
## @include_files = &get_include_files_list();
##
## this subroutine returns a list of the include files
## of the current design
## 
## 

sub get_include_files_list {
	my (@include_files);
	$_ = &get_dc_shell_variable("current_design");
	s/.*: *//;
	@include_files = &_process_include_file("$_$hdl_suffix",1000);
	@include_files = sort(@include_files);
	return @include_files;
}

########################################
## @include_files = &_process_include_file($a_file_name,$next_filehandle);
##
## Recursively find `include files.
##

sub _process_include_file {
	my (@include_filename_list);
	my ($filename, $filehandle) = @_;
	$filehandle++;
	unless (open($filehandle, $filename)) {
	    print STDERR "Error: Can't open $filename: $!\n";
	    return;
	}
	while (<$filehandle>) {
	    chop;
	    if (/^\s*`include(\s+)"(\S+)"/) {
		@include_filename_list = (@include_filename_list, $2);
		@include_filename_list = (@include_filename_list,
					  &_process_include_file($2, $filehandle));
		next;
	    }
  	}
	close($filehandle);
	return @include_filename_list;
}

#############################################################################
## @clock_ports_list = &get_clock_ports_list(my_sub_designs_clock_port_list);
##
## this subroutine returns a list of the clock ports
## of the current design
## 
## NOTE: that this subroutine assume you are in a current design and that
##	 the 'current_design'_sub_designs variable is set.
## 

sub get_clock_ports_list {
    my @my_sub_designs_clock_port_list = @_;
    my (@clock_ports);
    $_ = &get_dc_shell_variable("current_design");
    s/.*: *//;
    my $current_design = $_;
    &_dc_shell_cmd(0,"clock_ports = {};");
##    &_dc_shell_cmd(0, 
##	"foreach( each_regs_clock_pin, all_registers (-clock_pins)) {\n".
##        "    this_clock_port = find(port,all_connected(all_connected(each_regs_clock_pin)));\n".
##        "    clock_ports = clock_ports - this_clock_port + this_clock_port;\n".
##	"}" ) ; #remember that _dc_shell_cmd adds a \n
    &_dc_shell_cmd(0,"derive_clocks;");
    &_dc_shell_cmd(0,"these_clock_ports = find(port,find(clock));");
    &_dc_shell_cmd(0,"clock_ports = clock_ports - these_clock_ports + these_clock_ports;");
    if (@my_sub_designs_clock_port_list > 0) {
	&set_dc_shell_variable("sub_designs_clock_ports",
			       @my_sub_designs_clock_port_list);
        &_dc_shell_cmd(0, 
	"foreach( each_sub_design, ".$current_design."_sub_designs) {\n".
	"    foreach(each_cell, find(cell)) {\n".
	"        if ((get_attribute(-quiet each_cell, ref_name)) == each_sub_design) {\n".
	"            foreach(each_sub_design_clock_port, sub_designs_clock_ports) {\n".
	"                this_cells_clock_pin = \"\"\n".
	"                this_cells_clock_pin = each_cell + \"/\" + each_sub_design_clock_port\n".
	"                if ({} != find(pin, this_cells_clock_pin)) {\n".
	"                    this_clock_port = find(port,all_connected(all_connected(this_cells_clock_pin)));\n".
	"                    clock_ports = clock_ports - this_clock_port + this_clock_port;\n".
	"                }\n".
	"            }\n".
	"        }\n".
	"    }\n".
	"}" ) ; #remember that _dc_shell_cmd adds a \n
    }
    @clock_ports = &get_dc_shell_variable('clock_ports');	 
    @clock_ports = sort(@clock_ports);
    return @clock_ports;
}

########################################
## &do_the_right_thing($a_design_name);
##
## this subroutine compiles the design
## 
## 
## 

sub do_the_right_thing {
  my $a_design_name = shift;
    unless (open(THIS_DESIGNS_ENVIRONMENT_FILE, "environment")) {
      if (-e "environment") {
	print STDERR "Error: environment exists but dc_perl can't open it\n";
	exit;
      }
      # well there's no environment so I guess we have to make one!
      print ("\nwell there's no environment so I guess we have to make one!\n");
      print DC_PERL_DEBUG_LOG ("\nwell there's no environment so I guess we have to make one!\n") if $dc_perl_debug;
      unless (open(THIS_DESIGNS_ENVIRONMENT_FILE, ">environment")) {
	if (!(-w "environment")) {
	  print STDERR "Error: dc_perl doesn't have write permission to environment\n";
	  exit;
        }
	print STDERR "Error: dc_perl can't open environment for writing\n";
	exit;
      }
      my $design_name_length = length($a_design_name);
      my $leading = int(35 - ($design_name_length / 2));
      my $trailing = 70 - $leading - $design_name_length;
      my $operating_conditions = "";
      &_dc_shell_cmd(0,"free -all");
      &_dc_shell_cmd(1,"read target_library");
      @_ = &get_dc_shell_variable("target_library");
      $_ = @_[0];
      s/\.db$//;
      $target_library = $_;
      $_ = &get_dc_shell_cmd("report_lib $target_library");
      s/(Operating Conditions\:[^\:]*)\://s;
      $_ = $1;
      s/\n.*$/\n/;
      $operating_conditions = $_; 
      print $_;
      $operating_conditions =~  s/\n(.*)worst//;
      if($1 eq "") {
		$operating_conditions =~  s/\n(.*MAX.*\n)//;
      }
      $_ = $1;
      s/ *(\S*) *//; 
      $operating_conditions = $1; 
      print "The operating conditions you want set are \[$operating_conditions\] \: ";
      $ask_the_user = <STDIN>;
      #print "\"$ask_the_user\"\n";
      if ($ask_the_user ne "\n") {
	chop($ask_the_user);
	$operating_conditions = $ask_the_user;
      }
      $default_clock_period = 10;
      print "The default clock period you want is \[$default_clock_period\] \: ";
      $ask_the_user = <STDIN>;
      #print "\"$ask_the_user\"\n";
      if ($ask_the_user ne "\n") {
	chop($ask_the_user);
	$default_clock_period = $ask_the_user;
      }
      my $good_nand_gate = "";
      my $good_nand_gate_input = "";
      $cells_to_gates_ratio = 1;
      unless (open(TEMP_GOOD_NAND_GATE_FINDER, ">temp_good_nand_gate_finder.v")) {
	if (!(-w "temp_good_nand_gate_finder.v")) {
	  print STDERR "Error: dc_perl doesn't have write permission to temp_good_nand_gate_finder.v\n";
	  exit;
        }
	print STDERR "Error: dc_perl can't open temp_good_nand_gate_finder.v for writing\n";
	exit;
      }
      print TEMP_GOOD_NAND_GATE_FINDER (
	"module good_nand_gate_finder(clk,test_ins,test_outs);\n".
	"input	      clk;\n".
	"input	[1:0] test_ins;\n\n".
	"output [7:0] test_outs;\n".
     	"reg	[1:0] ins_saved;\n".
     	"reg	[7:0] test_outs;\n".
	"wire	      make_test_outs;\n\n".
	"always \@ (posedge clk)\n".
	"  ins_saved <= test_ins;\n\n".
	"always \@ (posedge clk)\n".
	"  test_outs <= {8{make_test_outs}};\n\n".
	"good_nand_gate good_nand_gate(ins_saved[1],ins_saved[0],make_test_outs);\n\n".
	"endmodule\n\n".
	"module good_nand_gate(a,b,zn);\n".
	"input	      a,b;\n".
	"output       zn;\n".
	"wire	      zn;\n\n".
	"assign	zn = !(a & b);\n\n".
	"endmodule\n\n");
      close (TEMP_GOOD_NAND_GATE_FINDER);
      &_dc_shell_cmd(0,"read -format verilog temp_good_nand_gate_finder.v");
      &_dc_shell_cmd(0,"set_operating_conditions $operating_conditions"); 
      &_dc_shell_cmd(0,"create_clock -period 1 clk");
      &_dc_shell_cmd(0,"compile");
      #&_dc_shell_cmd(0,"write -hier -f verilog -output good_nand_gate_finder.psv");
      $_ = &_dc_shell_cmd(0,"report -area"); 
      s/Total cell area\:\s+(\S+)//;
      $cells_to_gates_ratio = int($1 / 10.0) / 10.0;
      if ($cells_to_gates_ratio < 1.0) {           
        $cells_to_gates_ratio = 1;
      }
      &_dc_shell_cmd(0,"current_design = good_nand_gate"); 
      &_dc_shell_cmd(0,"report -reference"); 
      &_dc_shell_cmd(0,"good_nand_gate_ref_name = find(reference)");
      $good_nand_gate = &get_dc_shell_variable("good_nand_gate_ref_name");
      print "A good drive nand gate in your library is \[$good_nand_gate\] \: ";
      $ask_the_user = <STDIN>;
      #print "\"$ask_the_user\"\n";
      if ($ask_the_user ne "\n") {
	chop($ask_the_user);
	$good_nand_gate = $ask_the_user;
      }
      &_dc_shell_cmd(0,"good_nand_gate_cell_inpin = find(pin,all_connected(all_connected(find(port,a))))");
      $good_nand_gate_input = &get_dc_shell_variable("good_nand_gate_cell_inpin");
      $good_nand_gate_input =~ s/([^\/]+\/)//;
      $good_nand_gate_input = "$target_library\/$good_nand_gate\/$good_nand_gate_input";
      print "The cells-to-gates ratio for your library has a value of \[$cells_to_gates_ratio\] \: ";
      $ask_the_user = <STDIN>;
      #print "\"$ask_the_user\"\n";
      if ($ask_the_user ne "\n") {
	chop($ask_the_user);
	$cells_to_gates_ratio = $ask_the_user;
      }
      &_dc_shell_cmd(0,"free -all");
      $sys_junk = system("\\rm temp_good_nand_gate_finder.v");
      print DC_PERL_DEBUG_LOG "\\rm temp_good_nand_gate_finder.v" if $dc_perl_debug;
      print DC_PERL_DEBUG_LOG "$sys_junk\n" if $dc_perl_debug;
      #print a banner in the top of the environment
      print THIS_DESIGNS_ENVIRONMENT_FILE (
	"/*########################################################################*/\n".
	"/*#                                                                      #*/\n".
	"/*#    This environment file was generated by dc_perl for the design     #*/\n");
      print THIS_DESIGNS_ENVIRONMENT_FILE (
	"/*#"," " x $leading,$a_design_name," " x $trailing, "#*/\n");	
      print THIS_DESIGNS_ENVIRONMENT_FILE (
	"/*#                                                                      #*/\n".
	"/*########################################################################*/\n".
	"\n");
      print THIS_DESIGNS_ENVIRONMENT_FILE (
        "set_operating_conditions $operating_conditions\n". 
	"set_wire_load -mode segmented\n".
	"suppress_errors = suppress_errors + {EQN-10 UID-348 UID-401}\n".
	"default_clock_period = $default_clock_period  * (1 - .20) /* 20% timing margin */\n".
        "set_driving_cell -cell $good_nand_gate all_inputs()\n".
	"set_load 4 * load_of($good_nand_gate_input) all_inputs()\n".
	"set_load 20 * load_of($good_nand_gate_input) all_outputs()\n".
        "max_transition 6.0\n".
	"cells_to_gates_ratio = $cells_to_gates_ratio\n".
	"\n");
    }
    else {
      while (<THIS_DESIGNS_ENVIRONMENT_FILE>) {
	if(/^\s*cells_to_gates_ratio = (\S+)/) {
          $cells_to_gates_ratio = $1;
        }
      }
    }
    close(THIS_DESIGNS_ENVIRONMENT_FILE);
    $Makefile_flag = 1;
    unless (open(THE_MAKEFILE, "Makefile")) {
      if (-e "Makefile") {
	print STDERR "Error: Makefile exists but dc_perl can't open it\n";
	exit;
      }
      # well there's no Makefile so I guess we have to make one!
      print ("\nwell there's no Makefile so I guess we have to make one!\n\n");
      print DC_PERL_DEBUG_LOG ("\nwell there's no Makefile so I guess we have to make one!\n\n") if $dc_perl_debug;
      unless (open(THE_MAKEFILE, ">Makefile")) {
	if (!(-w "Makefile")) {
	  print STDERR "Error: dc_perl doesn't have write permission to Makefile\n";
	  exit;
        }
	print STDERR "Error: dc_perl can't open Makefile for writing\n";
	exit;
      }
      my $design_name_length = length($a_design_name);
      my $leading = int(35 - ($design_name_length / 2));
      my $trailing = 70 - $leading - $design_name_length;
      #print a banner in the top of the Makefile
      print THE_MAKEFILE (
	"########################################################################\n".
	"#                                                                      #\n".
	"#        This Makefile was generated by dc_perl for the design         #\n");
      print THE_MAKEFILE (
	"#"," " x $leading,$a_design_name," " x $trailing, "#\n");	
      print THE_MAKEFILE (
	"#                                                                      #\n".
	"########################################################################\n".
	"\n".
	"\n");
      print THE_MAKEFILE ".SUFFIXES: $hdl_suffix $constraint_file_suffix ",
			"$script_file_suffix $design_ware_or_template_suffix ",
			".db $gate_level_file_suffix $synthesis_log_file_suffix\n";
      print THE_MAKEFILE "$hdl_suffix$constraint_file_suffix:\n",
			"\ttouch \$\*$constraint_file_suffix\n\n";
      print THE_MAKEFILE "$constraint_file_suffix$script_file_suffix:\n",
			"\ttouch \$\*$script_file_suffix\n\n";
      print THE_MAKEFILE "$script_file_suffix.db:\n",
			"\tdc_shell -f \$\*$script_file_suffix \> \$\*$synthesis_log_file_suffix\n\n\n";
      print THE_MAKEFILE "$hdl_suffix$design_ware_or_template_suffix:\n",
			"\tdc_shell -f \$\*$script_file_suffix \> \$\*$synthesis_log_file_suffix\n\n\n";
      print THE_MAKEFILE "# The design dependences\n\n";
      print ("building make dependences for design $a_design_name\n");
      print DC_PERL_DEBUG_LOG ("building make dependences for design $a_design_name\n") if $dc_perl_debug;
      @dependences_list = ();
      my @heirarchical_makefile_dependences
	 = &_makefile_dependences($a_design_name,1,"top");
      print THE_MAKEFILE @heirarchical_makefile_dependences;
      $Makefile_flag = 0;
    }
    close(THE_MAKEFILE);
    print ("a Makefile exists \n");
    print DC_PERL_DEBUG_LOG ("a Makefile exists \n") if $dc_perl_debug;
    if($Makefile_flag == 1) {
      &_auto_rebudget($a_design_name);
    }
# Close the dc_shell
    &close_dc_shell();
# Get the current time
    $before_make = time();
    ( $sec, $min, $hour ) = localtime( $before_make );
    printf( "Starting make %02d:%02d:%02d\n", $hour, $min, $sec );
# Run a make
    system("make");
# Get the current time again
    $after_make = time();
    ( $sec, $min, $hour ) = localtime( $after_make );
    printf( "Ending make %02d:%02d:%02d after %d seconds\n",
	$hour, $min, $sec, $after_make - $before_make );
# Open up a new dc_shell
    &open_dc_shell(0);
}

########################################################################
## @designs_makefile_dependences
##   = &_makefile_dependences($design_name,$level,$design_type);
##
## this subroutine returns
## a list of the makefile_dependences of the current design heirarchy
## ie: it recursively gets the makefile_dependences of this design
## and all sub_designs
## 

sub _makefile_dependences {
  my ($design_name, $this_level, $design_type) = @_;
  print DC_PERL_DEBUG_LOG "find dependences design $design_name type $design_type/n" if $dc_perl_debug;
  my ($sys_junk);
  my @temp = ();
  my @temp2= ();
  my @sub_design_list = ();
  my @local_dw_list = ();
  @sub_designs_clock_port_list = (); # note: this is not a local variable
  my @my_sub_designs_clock_port_list = ();
  my @makefile_dependences_list = ();
  my ($count, $line_len, $line_number);
  my @breadcrumb_trail_list = ();
  my $breadcrumb_trail = ();
  my $design_name_length = 1;
  my $leading = 1;
  my $trailing = 1;
  if (open(THIS_DESIGNS_HLD_FILE, "$design_name$hdl_suffix")) {
    close(THIS_DESIGNS_HLD_FILE);
    &_dc_shell_cmd(0,"read -format $hdl_language $design_name$hdl_suffix"); 
    $_ = &get_dc_shell_variable("current_design");
    s/.*: *//;
    if ($design_name ne $_) {
      unless (open(THIS_DESIGNS_SCRIPT_FILE, "$design_name$script_file_suffix")) {
        if (-e "$design_name$script_file_suffix") {
          print STDERR "Error: $design_name$script_file_suffix exists but dc_perl can't open it\n";
          exit;
        }
        unless (open(THIS_DESIGNS_SCRIPT_FILE, ">$design_name$script_file_suffix")) {
	  if (!(-w "$design_name$script_file_suffix")) {
	    print STDERR "Error: dc_perl doesn't have write permission to $design_name$script_file_suffix\n";
	    exit;
          }
	  print STDERR "Error: dc_perl can't open $design_name$script_file_suffix for writing\n";
	  exit;
        }
        if ($design_type ne "dw") {
          print "Error: the file \"$design_name$hdl_suffix\" has some problem\n\n";
          print DC_PERL_DEBUG_LOG "Error: the file \"$design_name$hdl_suffix\" has some problem\n\n" if $dc_perl_debug;
          print "read -format $hdl_language $design_name$hdl_suffix\n";
          &_dc_shell_cmd(1,"read -format $hdl_language $design_name$hdl_suffix"); 
          print THIS_DESIGNS_SCRIPT_FILE (
	    "/*#  This is a temp script file for the design $design_name  #*/\n".
	    "/*#  delete this temp script file when you have fixed the source  #*/\n".
            "read -format $hdl_language $design_name$hdl_suffix\n". 
	    "exit\n");
          print (" the design",
	    "   " x $this_level,
	    "\"$design_name\" has no $design_name$script_file_suffix file creating one\n");
          print DC_PERL_DEBUG_LOG
	    (" the design",
	     "   " x $this_level,
	     "\"$design_name\" has no $design_name$script_file_suffix file creating one\n")
		if $dc_perl_debug;
        }
	else {
          @breadcrumb_trail_list = (0,0,$design_type);
          $breadcrumb_trail = &_list_to_synopsys_list(@breadcrumb_trail_list);
          $design_name_length = length($design_name);
          $leading = int(35 - ($design_name_length / 2));
          $trailing = 70 - $leading - $design_name_length;
          #print a banner in the top of the script file
          print THIS_DESIGNS_SCRIPT_FILE (
	    "/*########################################################################*/\n".
	    "/*#                                                                      #*/\n".
	    "/*#        This script file was generated by dc_perl for the design      #*/\n");
          print THIS_DESIGNS_SCRIPT_FILE (
	    "/*#"," " x $leading,$design_name," " x $trailing, "#*/\n");	
          print THIS_DESIGNS_SCRIPT_FILE (
	    "/*#                                                                      #*/\n".
	    "/*########################################################################*/\n".
	    "/* dc_perl's breadcrumb_trail: $breadcrumb_trail */\n".
	    "\n");
          print THIS_DESIGNS_SCRIPT_FILE (
            "/* a template design */\n". 
            "read -format $hdl_language $design_name$hdl_suffix\n". 
	    "sh touch $design_name$design_ware_or_template_suffix\n".
	    "exit\n");
        }
      }
      close(THIS_DESIGNS_SCRIPT_FILE);
      return @makefile_dependences_list;
    }
    print DC_PERL_DEBUG_LOG " \"$design_name\" equals \"$_\"\n" if $dc_perl_debug;
    @sub_design_list = &get_sub_design_list;
    $count = 0;
    while ($count < @sub_design_list) {
      $temp[$count] = ($sub_design_list[$count].".db");
      $count++;
    }
    @local_dw_list = &get_local_dw_list;
    $count = 0;
    while ($count < @local_dw_list) {
      $temp2[$count] = ($local_dw_list[$count].$design_ware_or_template_suffix);
      $count++;
    }
    @temp = (@temp,@temp2,&get_include_files_list,"environment");
  }
  else {
    if (-e "$design_name$hdl_suffix") {
      print STDERR "WARNING: file $design_name$hdl_suffix doesn't exist\n";
    }
    else {
      print STDERR "Error: dc_perl can't open $design_name$hdl_suffix\n";
      exit;
    }
  }
  $count = 0;
  $line_number = 0;
  while ($count < @temp) {
    #print "I am working on makefile_dependences_list\[$line_number\] $design_name\n ";
    if ($count == 0) { # the first line
      if ($design_type ne "dw") {
	$makefile_dependences_list[$line_number]
          = ("$design_name.db: $temp[$count]");
      }
      else {
	$makefile_dependences_list[$line_number]
          = ("$design_name$design_ware_or_template_suffix: $temp[$count]");
      }
      $line_len = length($makefile_dependences_list[$line_number]);
    }
    elsif (($line_len + length($temp[$count])) < 71) {
      $makefile_dependences_list[$line_number]
       = ("$makefile_dependences_list[$line_number] $temp[$count]");
      $line_len = length($makefile_dependences_list[$line_number]);
    }
    else {
      $makefile_dependences_list[$line_number] = ("$makefile_dependences_list[$line_number] \\\n");
      $line_number++;
      $makefile_dependences_list[$line_number] = ("\t$temp[$count]");
      $line_len = length($makefile_dependences_list[$line_number]);
    }
    #print ("    working on \"$design_name\" \$makefile_dependences_list\[$line_number\]\n      = \"$makefile_dependences_list[$line_number]\"\n");
    $count++;
  }
  $makefile_dependences_list[$line_number]
   = ("$makefile_dependences_list[$line_number]\n");
  $line_number++;
  $makefile_dependences_list[$line_number] = "\n";
  $count = 0;
  while ($count < @sub_design_list) {
    print (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has a sub-design \"$sub_design_list[$count]\"\n");
    print DC_PERL_DEBUG_LOG 
	  (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has a sub-design \"$sub_design_list[$count]\"\n")
		if $dc_perl_debug;
    if (grep(/^$sub_design_list[$count]$/,@dependences_list) == 0) {
      @dependences_list = (@dependences_list,$sub_design_list[$count]); 
      @makefile_dependences_list
       = (@makefile_dependences_list,
          &_makefile_dependences($sub_design_list[$count],$this_level+1,""));
    }
    else {
      &_makefile_dependences($sub_design_list[$count],$this_level+1,"");
    }
    #print "I am back after getting \"$sub_design_list[$count]\"\n";
    @my_sub_designs_clock_port_list = (@my_sub_designs_clock_port_list,
				       @sub_designs_clock_port_list);
    $count++;
  }
  $count = 0;
  while ($count < @local_dw_list) {
    print (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has local designware reference \"$local_dw_list[$count]\"\n");
    print DC_PERL_DEBUG_LOG 
	  (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has local designware reference \"$local_dw_list[$count]\"\n")
		if $dc_perl_debug;
    if (grep(/^$local_dw_list[$count]$/,@dependences_list) == 0) {
      @dependences_list = (@dependences_list,$local_dw_list[$count]); 
      @makefile_dependences_list
       = (@makefile_dependences_list,
          &_makefile_dependences($local_dw_list[$count],$this_level+1,"dw"));
    }
    else {
      &_makefile_dependences($local_dw_list[$count],$this_level+1,"dw");
    }
    #print "I am back after getting \"$local_dw_list[$count]\"\n";
    $count++;
  }
  if ($design_type eq "dw") {
    &_dc_shell_cmd(0,"analyze -format $hdl_language $design_name$hdl_suffix"); 
  }
  else {
    ##################################################################################
    #
    # setup constraint files for each design
    #
    ##################################################################################
    unless (open(THIS_DESIGNS_CONSTRAINT_FILE, "$design_name$constraint_file_suffix")) {
      if (-e "$design_name$constraint_file_suffix") {
        print STDERR "Error: $design_name$constraint_file_suffix exists but dc_perl can't open it\n";
        exit;
      }
      unless (open(THIS_DESIGNS_CONSTRAINT_FILE, ">$design_name$constraint_file_suffix")) {
	if (!(-w "$design_name$constraint_file_suffix")) {
	  print STDERR "Error: dc_perl doesn't have write permission to $design_name$constraint_file_suffix\n";
	  exit;
        }
	print STDERR "Error: dc_perl can't open $design_name$constraint_file_suffix for writing\n";
	exit;
      }
      &_dc_shell_cmd(0,"current_design = $design_name"); 
      my (@clock_ports_list) = &get_clock_ports_list(@my_sub_designs_clock_port_list);
      # set this list for the guy above me
      @sub_designs_clock_port_list = @clock_ports_list;
      $count = 0;
      while ($count < @sub_design_list) {
        &_dc_shell_cmd(0,"free $sub_design_list[$count];");
        $count++;
      }
      $count = 0;
      my $uc_temp_local_dw;
      while ($count < @local_dw_list) {
	$uc_temp_local_dw = uc $local_dw_list[$count];
        if (-e "$uc_temp_local_dw\.mra") {
	  $sys_junk = system("\\rm $local_dw_list[$count]\*\.syn $uc_temp_local_dw\.mra");
          print DC_PERL_DEBUG_LOG "\\rm $local_dw_list[$count]\*\.syn $uc_temp_local_dw\.mra\n" if $dc_perl_debug;
          print DC_PERL_DEBUG_LOG "$sys_junk\n" if $dc_perl_debug;
	  &_dc_shell_cmd(0,"free $local_dw_list[$count]\*;"); 
        }
        $count++;
      }
      #&_dc_shell_cmd(0,"list_designs"); 
      @breadcrumb_trail_list = (0,&_list_to_synopsys_list(@clock_ports_list),0,0);
      $breadcrumb_trail = &_list_to_synopsys_list(@breadcrumb_trail_list);
      $design_name_length = length($design_name);
      $leading = int(35 - ($design_name_length / 2));
      $trailing = 70 - $leading - $design_name_length;
      #print a banner in the top of the constraint file
      print THIS_DESIGNS_CONSTRAINT_FILE (
	"/*########################################################################*/\n".
	"/*#                                                                      #*/\n".
	"/*#     This constraint file was generated by dc_perl for the design     #*/\n");
      print THIS_DESIGNS_CONSTRAINT_FILE (
	"/*#"," " x $leading,$design_name," " x $trailing, "#*/\n");	
      print THIS_DESIGNS_CONSTRAINT_FILE (
	"/*#                                                                      #*/\n".
	"/*########################################################################*/\n".
	"/* dc_perl's breadcrumb_trail: $breadcrumb_trail */\n".
	"\n");
      print THIS_DESIGNS_CONSTRAINT_FILE (
	"reset_design\n".
	"include environment\n".
	"clock_period = default_clock_period /* this is a guess */\n".
	"create_clock -period clock_period -name inputs_virtual_clk\n".
	"create_clock -period clock_period -name outputs_virtual_clk\n");
      $count = 0;
      while ($count < @clock_ports_list) {
        print THIS_DESIGNS_CONSTRAINT_FILE (
	  "create_clock -period clock_period $clock_ports_list[$count]\n".
	  "set_drive 0 $clock_ports_list[$count]\n");
        $count++;
      }
      print THIS_DESIGNS_CONSTRAINT_FILE (
	"set_input_delay clock_period * 5 / 8 all_inputs()\n".
	"set_input_delay clock_period * 1 / 8 all_inputs() -clock inputs_virtual_clk\n".
	"set_output_delay clock_period * 7 / 8 all_outputs()\n".
	"set_output_delay clock_period * 3 / 8 all_outputs() -clock outputs_virtual_clk\n".
	"max_area 1000 * cells_to_gates_ratio\n");
      $count = 0;
      while ($count < @sub_design_list) {
        print THIS_DESIGNS_CONSTRAINT_FILE (
	  "set_dont_touch find\(reference,$sub_design_list[$count]\)\n");
        $count++;
      }
      print THIS_DESIGNS_CONSTRAINT_FILE (
	"\n".
	"/*############  Put any over riding constraints below here  ############*/\n".
	"\n".
	"/* ie: set_input_delay clock_period * 7 / 8  late_arriving_input_signal */\n".
	"\n".
	"\n");
      print (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has no $design_name$constraint_file_suffix file creating one\n");
      print DC_PERL_DEBUG_LOG
	  (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has no $design_name$constraint_file_suffix file creating one\n")
		if $dc_perl_debug;
    }
    close(THIS_DESIGNS_CONSTRAINT_FILE);
  }
  ##################################################################################
  #
  # setup script files for each design
  #
  ##################################################################################
  unless (open(THIS_DESIGNS_SCRIPT_FILE, "$design_name$script_file_suffix")) {
    if (-e "$design_name$script_file_suffix") {
      print STDERR "Error: $design_name$script_file_suffix exists but dc_perl can't open it\n";
      exit;
    }
    unless (open(THIS_DESIGNS_SCRIPT_FILE, ">$design_name$script_file_suffix")) {
	if (!(-w "$design_name$script_file_suffix")) {
	  print STDERR "Error: dc_perl doesn't have write permission to $design_name$script_file_suffix\n";
	  exit;
        }
	print STDERR "Error: dc_perl can't open $design_name$script_file_suffix for writing\n";
	exit;
    }
    my $this_design_should_be_compiled = 1;
    my @other_cells_list = ();
    if (@sub_design_list > 1) {
      &_dc_shell_cmd(0, 
	"$design_name"."_other_cells = filter(find(reference), ".
	"$design_name"."_sub_designs)") ; #remember that _dc_shell_cmd adds a \n
      @other_cells_list = &get_dc_shell_variable("$design_name"."_other_cells");
      if (@other_cells_list == 0 ) {
	$this_design_should_be_compiled = 0;
      }	 
    }
    @breadcrumb_trail_list = ($this_design_should_be_compiled,0,$design_type);
    $breadcrumb_trail = &_list_to_synopsys_list(@breadcrumb_trail_list);
    $design_name_length = length($design_name);
    $leading = int(35 - ($design_name_length / 2));
    $trailing = 70 - $leading - $design_name_length;
    #print a banner in the top of the script file
    print THIS_DESIGNS_SCRIPT_FILE (
	"/*########################################################################*/\n".
	"/*#                                                                      #*/\n".
	"/*#        This script file was generated by dc_perl for the design      #*/\n");
    print THIS_DESIGNS_SCRIPT_FILE (
	"/*#"," " x $leading,$design_name," " x $trailing, "#*/\n");	
    print THIS_DESIGNS_SCRIPT_FILE (
	"/*#                                                                      #*/\n".
	"/*########################################################################*/\n".
	"/* dc_perl's breadcrumb_trail: $breadcrumb_trail */\n".
	"\n");
    if ($design_type ne "dw") {
      print THIS_DESIGNS_SCRIPT_FILE (
        "read -format $hdl_language $design_name$hdl_suffix\n". 
	"link\n".
        "verbose_messages = \"false\"\n".
	"include $design_name$constraint_file_suffix\n".
        "verbose_messages = \"true\"\n");
      if ($this_design_should_be_compiled) {
        print THIS_DESIGNS_SCRIPT_FILE (
	"compile\n".
	"ungroup -all -flatten\n".
	"compile -inc\n");
      }
      else {
        print THIS_DESIGNS_SCRIPT_FILE (
	"/* $design_name contains only sub-modules and no logic */\n");
      }
      print THIS_DESIGNS_SCRIPT_FILE (
	"check_design -one_level\n".
	"create_schematic\n".
	"write\n".
	"write -f $hdl_language -output $design_name$gate_level_file_suffix\n".
	"report -const -verb -area\n".
	"report_timing -path full -max_paths 4\n".
	"exit\n");
    }
    else {
      print THIS_DESIGNS_SCRIPT_FILE (
        "analyze -format $hdl_language $design_name$hdl_suffix\n". 
	"sh touch $design_name$design_ware_or_template_suffix\n".
	"exit\n");
    }
    print (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has no $design_name$script_file_suffix file creating one\n");
    print DC_PERL_DEBUG_LOG
	  (" the design",
	   "   " x $this_level,
	   "\"$design_name\" has no $design_name$script_file_suffix file creating one\n")
		if $dc_perl_debug;
  }
  close(THIS_DESIGNS_SCRIPT_FILE);
  #print ("\n\"$design_name\" has \$makefile_dependences_list = \n\n",@makefile_dependences_list,"\n\n");
  return @makefile_dependences_list;
}


########################################################################
##
##  &_auto_rebudget($design_name);
##
## this subroutine rebudgets all the subdesigns in the design
## 

sub _auto_rebudget {
  my $design_name = shift;
  my ($count, $count2, $count3, $count4);
  my $len;
  my $first_instance = 1;
  my (@instance_cross_ref, @temp, @all_sub_designs);
  my (@sd_first_instance);
  my ($a_report_clock, $clk_ptr_tmp, $clk_loop_done);
  my ($tmp_clock, $tmp_clock_period);
  my (@clock_list, @clock_declared_list);
  my (@this_sd_pins, @this_sd_pins_timing);
  my $other_temp;
  my @timing_data;
  my ($new_time_at_pin,$extra,$pin_direction,$pin_clk);
  my ($replace_const_file);
  my ($this_const_file_line, $const_file_read_state, $breadcrumb_trail);
  my (@breadcrumb_trail_list, @clock_ports_list);
  my (@clock_const_lines, @set_ioput_delay_lines);
  my $a_report_area;
  print ("Starting auto-rebudgeting \n");
  print DC_PERL_DEBUG_LOG ("Starting auto-rebudgeting \n") if $dc_perl_debug;
  if (open(THIS_DESIGNS_HLD_FILE, "$design_name.db")) {
    close(THIS_DESIGNS_HLD_FILE);
    print (" reading in $design_name.db\n");
    print DC_PERL_DEBUG_LOG (" reading in $design_name.db\n") if $dc_perl_debug;
    &_dc_shell_cmd(0,"read $design_name.db"); 
    &_dc_shell_cmd(0,"verbose_messages = \"false\""); 
    print (" linking\n");
    print DC_PERL_DEBUG_LOG (" linking\n") if $dc_perl_debug;
    &_dc_shell_cmd(0,"link");
    print (" generating an instance cross reference list\n");
    print DC_PERL_DEBUG_LOG (" generating an instance cross reference list\n") if $dc_perl_debug;
    &_dc_shell_cmd(0,"instance_cross_ref = {}");
    &_dc_shell_cmd(0, 
	"foreach( each_instance, filter( find(-hierarchy cell), \"\@is_hierarchical == true\")) { \n".
	"    instance_cross_ref = instance_cross_ref \\\n".
	"        + get_attribute(each_instance,ref_name) \\\n".
	"        + each_instance;\n".
	"}" ) ; #remember that _dc_shell_cmd adds a \n
    @instance_cross_ref = &get_dc_shell_variable("instance_cross_ref");	 
    &_dc_shell_cmd(0,"all_sub_designs = find(-hierarchy design)");
    @all_sub_designs = &get_dc_shell_variable("all_sub_designs");	 
    print (" generate a list of the clocks\n");
    print DC_PERL_DEBUG_LOG (" generate a list of the clocks\n") if $dc_perl_debug;
    $a_report_clock = &_dc_shell_cmd(0,"report_clock -attributes -nosplit");
    $clk_ptr_tmp = index($a_report_clock,"----------\n");
    if($clk_ptr_tmp >= 0) {
      $a_report_clock = substr($a_report_clock,$clk_ptr_tmp+length("----------\n"));
      $clk_loop_done = 0;
      $count = 0;
      while ($clk_loop_done < 1) {
	$a_report_clock =~ s/^(\S+)\s+(\S+)\s+.*\n//;
        $tmp_clock = $1;
        $tmp_clock_period = $2;
        if($tmp_clock =~ /-/) {
          $clk_loop_done = 1;
        }
        else {
          $clock_list[$count*2] = $tmp_clock;
          $clock_list[$count*2+1] = $tmp_clock_period;
          print ("  found clock \"$clock_list[$count*2]\" with period $clock_list[$count*2+1]\n");
          print DC_PERL_DEBUG_LOG ("  found clock \"$clock_list[$count*2]\" with period $clock_list[$count*2+1]\n") if $dc_perl_debug;
          $count++;
        }
      }
    }
    else {
      print ("\nThere are NO clocks in this design?\n");
      print DC_PERL_DEBUG_LOG ("\nThere are NO clocks in this design?\n") if $dc_perl_debug;
    }
    $count = 0;
    while ($count < @all_sub_designs) {
      print (" rebudgeting sub_design $all_sub_designs[$count]\n");
      print DC_PERL_DEBUG_LOG (" rebudgeting sub_design $all_sub_designs[$count]\n") if $dc_perl_debug;
      $first_instance = 1;
      $count2 = 0;
      while ($count2 < @instance_cross_ref) {
	if($all_sub_designs[$count] eq $instance_cross_ref[$count2]) {
          print ("  has instance $instance_cross_ref[$count2+1]\n");
          print DC_PERL_DEBUG_LOG ("  has instance = $instance_cross_ref[$count2+1]\n") if $dc_perl_debug;
          if($first_instance == 1) {
	    $sd_first_instance[$count] = $instance_cross_ref[$count2+1];
	    $this_sd_pins = ();
	    $this_sd_pins_timing = ();
          }
          &_dc_shell_cmd(0,"this_sd_pins = find(pin,$instance_cross_ref[$count2+1]/*)");
          @temp = &get_dc_shell_variable("this_sd_pins");
          @temp = sort(@temp);
          $len = length($instance_cross_ref[$count2+1]) + 1;	 
          $count4 = 0;
          $count3 = 0;
          while ($count3 < @temp) {
            $temp[$count3] = substr($temp[$count3],$len);
            $other_temp = $temp[$count3];
            $temp[$count3] =~ s/\[.*\]$//;
            if($other_temp eq $temp[$count3]) {
	      if($first_instance == 1) {
                $this_sd_pins[$count4] = $temp[$count3];
                $this_sd_pins_timing[$count4*4] = 0;
                $this_sd_pins_timing[$count4*4+1] = "";
                $this_sd_pins_timing[$count4*4+2] = "";
                $this_sd_pins_timing[$count4*4+3] = "";
	      }
	      $count4++;
            }	
            elsif($count4 == 0) {
	      if($first_instance == 1) {
                $this_sd_pins[$count4] = $temp[$count3];
                $this_sd_pins_timing[$count4*4] = 0;
                $this_sd_pins_timing[$count4*4+1] = "";
                $this_sd_pins_timing[$count4*4+2] = "";
                $this_sd_pins_timing[$count4*4+3] = "";
	      }
	      $count4++;
            }	
            elsif($temp[$count3] ne $this_sd_pins[$count4-1]) {
	      if($first_instance == 1) {
                $this_sd_pins[$count4] = $temp[$count3];
                $this_sd_pins_timing[$count4*4] = 0;
                $this_sd_pins_timing[$count4*4+1] = "";
                $this_sd_pins_timing[$count4*4+2] = "";
                $this_sd_pins_timing[$count4*4+3] = "";
	      }
	      $count4++;
            }
            elsif($temp[$count3] ne $this_sd_pins[$count4-1]) {
              print DC_PERL_DEBUG_LOG ("PROBLEM: pins don't match on $instance_cross_ref[$count2+1]\n") if $dc_perl_debug;
            }
            if(($count == 0) && ($first_instance == 1) && ($count3 == 0)) {
              print ("  timing the whole design\n");
              print DC_PERL_DEBUG_LOG ("  timing the whole design\n") if $dc_perl_debug;
            }
            @timing_data = &parse_timing_report($instance_cross_ref[$count2+1],$other_temp);
  	    ($new_time_at_pin,$extra,$pin_direction,$pin_clk) = @timing_data;
	    if(    ($this_sd_pins_timing[($count4-1)*4] == 0)
		|| (    ($pin_direction eq "input")
		     && ($new_time_at_pin > $this_sd_pins_timing[($count4-1)*4]))
		|| (    ($pin_direction eq "output")
		     && ($new_time_at_pin < $this_sd_pins_timing[($count4-1)*4]))) {
              $this_sd_pins_timing[($count4-1)*4] = $new_time_at_pin;
              $this_sd_pins_timing[($count4-1)*4+1] = $extra;
              $this_sd_pins_timing[($count4-1)*4+2] = $pin_direction;
	      $this_sd_pins_timing[($count4-1)*4+3] = $pin_clk;
            }
            $count3++;
          }
          $first_instance = 0;
        }
	$count2 = $count2 + 2;
      }
      ##################################################################################
      #
      # rebudget constraint files for each design
      #
      ##################################################################################
      unless (open(THIS_DESIGNS_CONSTRAINT_FILE, "$all_sub_designs[$count]$constraint_file_suffix")) {
        if (-e "$all_sub_designs[$count]$constraint_file_suffix") {
          print STDERR "Error: $all_sub_designs[$count]$constraint_file_suffix".
		       " exists but dc_perl can't open it\n";
          exit;
        }
	print STDERR "Error: dc_perl can't open $all_sub_designs[$count]$constraint_file_suffix\n";
	exit;
      }
      if (open(THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE,
			"$all_sub_designs[$count]$constraint_file_suffix\_tmp")) {
        close(THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE);
        system("\\rm $all_sub_designs[$count]$constraint_file_suffix\_tmp");
      }
      else {
        if (-e "$all_sub_designs[$count]$constraint_file_suffix\_tmp") {
          print STDERR  "Error: $all_sub_designs[$count]$constraint_file_suffix\_tmp".
			" exists but dc_perl can't open it\n";
          exit;
        }
      }
      unless (open(THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE,
			">$all_sub_designs[$count]$constraint_file_suffix\_tmp")) {
    	  if (!(-w "$all_sub_designs[$count]$constraint_file_suffix\_tmp")) {
	    print STDERR "Error: dc_perl doesn't have write permission to".
			 " $all_sub_designs[$count]$constraint_file_suffix\_tmp\n";
	    exit;
          }
  	  print STDERR  "Error: dc_perl can't open $all_sub_designs[$count]$constraint_file_suffix\_tmp".
			" for writing\n";
	  exit;
      }
      $const_file_read_state = "looking for breadcrumbs";
      $replace_const_file = 0;
      while (<THIS_DESIGNS_CONSTRAINT_FILE>) {
	$this_const_file_line = $_;
        if($const_file_read_state eq "looking for breadcrumbs") {
	  if(/dc_perl\'s breadcrumb_trail\: (.*) \*\/$/) {
	    $breadcrumb_trail = $1;
	    @breadcrumb_trail_list = &_synopsys_list_to_list($breadcrumb_trail);
	    @clock_ports_list = &_synopsys_list_to_list($breadcrumb_trail_list[1]);
            if($breadcrumb_trail_list[0] == 0) {
	      $replace_const_file = 1;
	    }
            @breadcrumb_trail_list = ($breadcrumb_trail_list[0]+1,
				      &_list_to_synopsys_list(@clock_ports_list),0,0);
            $breadcrumb_trail = &_list_to_synopsys_list(@breadcrumb_trail_list);
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE (
	      "/* dc_perl's breadcrumb_trail: $breadcrumb_trail */\n");
	    $const_file_read_state = "looking for clock statements";
            print DC_PERL_DEBUG_LOG ("looking for clock statements\n")	if $dc_perl_debug;
	  }
          else {
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($this_const_file_line);
          }
        }
        elsif($const_file_read_state eq "looking for clock statements") {
	  if((/^\s*clock_period/) || (/^\s*create_clock/)) {
	    @clock_declared_list = ();
            @clock_const_lines = ();
            $count2 = 0;
            while ($count2 < @clock_ports_list) {
	      $tmp_clock = &_find_named_clock($sd_first_instance[$count],$clock_ports_list[$count2]);
	      $tmp_clock_period = -1;
              $count3 = 0;
              while ($count3 < @clock_list) {
                if($clock_list[$count3*2] eq $tmp_clock) {
		  $clock_declared_list[$count3*2] = "used";
		  $tmp_clock_period = $clock_list[$count3*2+1];
                  $count3 = @clock_list;
                }
                else {
                  $count3 = $count3 + 2;
                }
              }
	      if($tmp_clock_period <= 0) {
	        print STDERR "Error: dc_perl has found a clock \"$tmp_clock\" which has no period\n";
	        exit;
	      }
	      @clock_const_lines = (@clock_const_lines,
	          "create_clock -period $tmp_clock_period\t".
		  "$clock_ports_list[$count2]\t-name $tmp_clock\n");
              $count2 = $count2 + 2;
            }
            $count2 = 0;
            while ($count2 < @clock_list) {
              $count3 = 0;
              while ($count3 < @this_sd_pins) {
                if(    ($clock_list[@clock_list-$count2-2] eq $this_sd_pins_timing[$count3*4+3])
		    && ($clock_declared_list[@clock_list-$count2-2] ne "used")) {
		  $clock_declared_list[@clock_list-$count2-2] = "needed";
                  $count3 = @this_sd_pins;
                }
                else {
                  $count3++;
                }
              }
              if($clock_declared_list[@clock_list-$count2-2] eq "needed") {
	        @clock_const_lines = ("create_clock -period ".
		    "$clock_list[@clock_list-$count2-1]\t".
		    "-name $clock_list[@clock_list-$count2-2]\n",
		    @clock_const_lines);
	      }
              $count2 = $count2 + 2;
	    }
            $count2 = 0;
            while ($count2 < @clock_const_lines) {
	      print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($clock_const_lines[$count2]);
              $count2++;
	    }
	    $const_file_read_state = "looking for in-output_delay statements";
            print DC_PERL_DEBUG_LOG ("looking for in-output_delay statements\n")	if $dc_perl_debug;
          }
          else {
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($this_const_file_line);
          }
        }
        elsif($const_file_read_state eq "looking for in-output_delay statements") {
	  if(/^\s*create_clock/) {
	  }
	  elsif(/^\s*set_input_delay/) {
            @set_ioput_delay_lines = ();
            $count2 = 0;
            while ($count2 < @this_sd_pins) {
              if($this_sd_pins_timing[$count2*4+2] eq "input") {
                @set_ioput_delay_lines = (@set_ioput_delay_lines,
			"set_input_delay  $this_sd_pins_timing[$count2*4]\t".
			"$this_sd_pins[$count2]\t-clock $this_sd_pins_timing[$count2*4+3]\n"); 
		print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE
			($set_ioput_delay_lines[@set_ioput_delay_lines-1]);
	      }
	      $count2++;
	    }
            $count2 = 0;
            while ($count2 < @this_sd_pins) {
              if($this_sd_pins_timing[$count2*4+2] eq "output") {
		$new_time_at_pin = 0;
                $count3 = 0;
                while ($count3 < @clock_list) {
                  if($clock_list[$count3*2] eq $this_sd_pins_timing[$count2*4+3]) {
		    $new_time_at_pin = $clock_list[$count3*2+1] - $this_sd_pins_timing[$count2*4];
                    $count3 = @clock_list;
                  }
                  else {
                    $count3 = $count3 + 2;
                  }
                }
                @set_ioput_delay_lines = (@set_ioput_delay_lines,
			"set_output_delay $new_time_at_pin\t".
			"$this_sd_pins[$count2]\t-clock $this_sd_pins_timing[$count2*4+3]\n"); 
                print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE
			($set_ioput_delay_lines[@set_ioput_delay_lines-1]);
	      }
	      $count2++;
	    }
	    $const_file_read_state = "looking for the end of delay statements";
            print DC_PERL_DEBUG_LOG ("looking for the end of delay statements\n")	if $dc_perl_debug;
          }
          else {
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($this_const_file_line);
          }
        }
        elsif($const_file_read_state eq "looking for the end of delay statements") {
	  if((/^\s*set_input_delay/) || (/^\s*set_output_delay/)) {
          }
          elsif(/^\s*max_area/) {
            &_dc_shell_cmd(0,"current_instance = $sd_first_instance[$count]"); 
            $a_report_area = &_dc_shell_cmd(0,"report_area");
	    $a_report_area =~ s/Total cell area:\s+(\S+)//;
            $other_temp = $1 / $cells_to_gates_ratio;
	    $a_report_area =~ s/Total area:\s+(\S+)//;
            if(($1 / $cells_to_gates_ratio) > $other_temp) {
              $other_temp = $1 / $cells_to_gates_ratio;
            }
            $other_temp = int($other_temp / 100) * 100 + 100;
            &_dc_shell_cmd(0,"current_instance"); 
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE
	      "max_area $other_temp * cells_to_gates_ratio\n";
          }
	  else {
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($this_const_file_line);
	    $const_file_read_state = "looking for over riding constraints";
            print DC_PERL_DEBUG_LOG ("looking for over riding constraints\n")	if $dc_perl_debug;
          }
        }
        elsif($const_file_read_state eq "looking for over riding constraints") {
          if(/over riding constraints below here/) {
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($this_const_file_line);
	    $const_file_read_state = "looking for end of file";
            print DC_PERL_DEBUG_LOG ("looking for end of file\n")	if $dc_perl_debug;
          }
          else {
            print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($this_const_file_line);
          }
        }
        elsif($const_file_read_state eq "looking for end of file") {
          print THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE ($this_const_file_line);
        }
      }
      close(THIS_DESIGNS_REBUGETED_CONSTRAINT_FILE);
      close(THIS_DESIGNS_CONSTRAINT_FILE);
      #
      # should check each line of the old rebudgeted constraint file against
      # the new rebudgeted constraint file to see if there has been almost
      # no change (ie. less than +/- 0.2 ns) in the timing to avoid unnessary
      # recompiles (ie. don't replace the .const file and make won't recompile)
      #
      $replace_const_file = 1;
      #
      # test to see if the .const file should be replaced
      if($replace_const_file == 1) {
        system("\\mv $all_sub_designs[$count]$constraint_file_suffix $all_sub_designs[$count]$constraint_file_suffix\_old");
        system("\\mv $all_sub_designs[$count]$constraint_file_suffix\_tmp $all_sub_designs[$count]$constraint_file_suffix");
      }
      $count++;
    }
  }
  else {
    if (-e "$design_name.db") {
      print STDERR "WARNING: file $design_name.db doesn't exist\n";
    }
    else {
      print STDERR "Error: dc_perl can't open $design_name.db\n";
      exit;
    }
  }
  return 1;
}


########################################
## @timing_data = &parse_timing_report($instance,$pin);
##
## this subroutine returns a list of the timing
## info for this pin parsed from thetiming report
## 
## 

sub parse_timing_report {
  my ($instance,$pin) = @_;
  my @timing_data = (0, "", "", "");
  my $a_timing_report;
  my ($input_clk,$output_clk);
  my ($pin_clk,$time_at_pin,$pin_direction,$arrival_time,$required_time,$slack);
  my ($instance_pin_pattern);
  my ($temp1,$temp2,$count);
  my (@tmp_list);
  $a_timing_report = &_dc_shell_cmd(0,"report_timing -path full -nosplit -input_pins -through $instance/$pin");
  $temp1 = index($a_timing_report,"No paths.");
  if($temp1 >= 0) {
    $timing_data[2] = "no paths";		
  }
  else { 
    $temp1 = index($a_timing_report,"Startpoint\:");
    if($temp1 >= 0) {
      $a_timing_report = substr($a_timing_report,$temp1);
    }
    $_ = $a_timing_report;
    s/clocked by\s+(\S+)\n//;
    $input_clk = $1;
    chop($input_clk);
    $temp1 = index($a_timing_report,"Endpoint\:");
    if($temp1 >= 0) {
      $a_timing_report = substr($a_timing_report,$temp1);
    }
    $_ = $a_timing_report;
    s/clocked by\s+(\S+)\n//;
    $output_clk = $1;
    chop($output_clk);
    $instance_pin_pattern = $instance."\/".$pin." ";
    $temp1 = index($a_timing_report,$instance_pin_pattern);
    if($temp1 >= 0) {
      $_ = substr($a_timing_report,$temp1);
      s/\s*\S+\s+\S+\s+\S+\s+(\S+)\s+\S+\s*\n\s*(\S+)//;
      $time_at_pin = $1;
      $temp2 = $2;
    }
    else {
      $time_at_pin = 0;
      $temp2 = $instance;
    }
    $_ = $a_timing_report;
    s/data arrival time\s+(\S+)\s*\n//;
    $arrival_time = $1;
    s/data required time\s+(\S+)//;
    $required_time = $1;
    s/slack\s+\S+\s+(\S+)//;
    $slack = $1;
    if ($temp2 =~ /$instance/) {
      $pin_direction = "input";
      $pin_clk = $input_clk;
    } else {
      $pin_direction = "output";
      $pin_clk = $output_clk;
    }
    if ($arrival_time != 0) {
      $timing_data[0] = int(($required_time/$arrival_time) * $time_at_pin * 100) / 100;		
    }
    $timing_data[1] = "";		
    $timing_data[2] = $pin_direction;		
    $timing_data[3] = $pin_clk;		
    print DC_PERL_DEBUG_LOG ("pin \"$instance/$pin\" ")		if $dc_perl_debug;
    print DC_PERL_DEBUG_LOG ("is an \"$pin_direction\" ") 	if $dc_perl_debug;
    print DC_PERL_DEBUG_LOG ("clock by \"$pin_clk\" ")		if $dc_perl_debug;
    print DC_PERL_DEBUG_LOG ("at time \"$time_at_pin\"\n")	if $dc_perl_debug;
    print DC_PERL_DEBUG_LOG ("  has slack of \"$slack\" ")	if $dc_perl_debug;
    print DC_PERL_DEBUG_LOG ("on an arrival time of \"$arrival_time\" ")	if $dc_perl_debug;
    print DC_PERL_DEBUG_LOG ("vs. required time of \"$required_time\"\n")	if $dc_perl_debug;
    print DC_PERL_DEBUG_LOG ("  set a new time of \"$timing_data[0]\"\n")	if $dc_perl_debug;
  }
  return @timing_data;
}

########################################
## $named_clock = &_find_named_clock($instance,$clock_pin);
##
## this subroutine returns the named_clock used
## by the clock_pin of this instance
## 
## 

sub _find_named_clock {
  my ($instance,$clock_pin) = @_;
  my $named_clock;
  my ($a_fanout_report,$a_timing_report);
  my ($clk_ptr_tmp,$flip_flop_clock_pin);
  $a_fanout_report = &_dc_shell_cmd(0,
    "report_transitive_fanout -nosplit -from find(pin,$instance/$clock_pin)");
  $clk_ptr_tmp = index($a_fanout_report,"----------\n");
  if($clk_ptr_tmp >= 0) {
    $a_fanout_report = substr($a_fanout_report,$clk_ptr_tmp+length("----------\n"));
    $a_fanout_report =~ s/^\s*\S+\s+(\S+)\s+//;
    $flip_flop_clock_pin = $1;
    print DC_PERL_DEBUG_LOG ("\$flip_flop_clock_pin = $flip_flop_clock_pin\n") if $dc_perl_debug;
    $a_timing_report = &_dc_shell_cmd(0,
      "report_timing -nosplit -from $flip_flop_clock_pin");
    $_ = $a_timing_report;
    s/clocked by\s+(\S+)\n//;
    $named_clock = $1;
    chop($named_clock);
    print DC_PERL_DEBUG_LOG ("\$named_clock = $named_clock\n") if $dc_perl_debug;
  }
  else {
    print ("\nThere is some problem with the report_transitive_fanout?\n");
    print DC_PERL_DEBUG_LOG ("\nThere is some problem with the report_transitive_fanout?\n") if $dc_perl_debug;
    exit;
  }
  return $named_clock;
}

########################################

sub BEGIN {
    print "dc_perl version 0.207\n" ;
}

sub END {
    print "Thank you for using dc_perl.\n" ;
}

#####################################################################