SystemC::Netlist::AutoTrace - Tracing routines

# SystemC - SystemC Perl Interface
# See copyright, etc in below POD section.
######################################################################

package SystemC::Netlist::AutoTrace;
use File::Basename;

use SystemC::Netlist::Module;
$VERSION = '1.336';
use strict;

use vars qw ($Debug_Check_Code);
#$Debug_Check_Code=1;	# Compile in debugging check of sig identifiers

######################################################################
#### Automatics (Preprocessing)

sub _write_autotrace {
    my $self = shift;
    my $fileref = shift;
    my $prefix = shift;

    return if !($self->netlist->tracing || $self->_autotrace('standalone'));
    if ($SystemC::Netlist::File::outputting
	&& $self->_autotrace('manual')) {
	$fileref->print
	    ("${prefix}// Beginning of SystemPerl automatic trace file routine\n",
	     "${prefix}// *MANUALLY CREATED*\n",
	     "${prefix}// End of SystemPerl automatic trace file routine\n",);
	return;
    }

    my $trinfo = $self->_autotrace('trinfo_hashref');
    if (!$trinfo) {
	# Compute state only once - we may print twice if under SLOW block.

	# State common to all routines
	my $trinfo = {
	    ident_code => 0,	# Next code to assign
	    tracesref => {},	# Top of hierarchy of traces for each cell
	    dupsref => {},		# Hash of {signal} = orig signal
	    dupscoderef => {},	# Hash of {signal} = code#
	    recurse => ($self->_autotrace('recurse')),
	};
	$self->_autotrace('trinfo_hashref', $trinfo);

	# Detect duplicate signal information
	if ($self->_autotrace('recurse') && !$self->netlist->{sp_trace_duplicates}) {
	    _tracer_dups_recurse($self,$trinfo);
	    _tracer_dups_show($self,$trinfo) if $Debug_Check_Code;
	}

	# Flatten out all hierarchy under this into a array of signal information
	_tracer_setup($self, $trinfo, $trinfo->{tracesref});
    }

    # Output the data
    if ($fileref->SystemC::Netlist::File::_write_in_slow
	|| $fileref->SystemC::Netlist::File::_write_in_fast) {

	$fileref->print ("${prefix}// Beginning of SystemPerl automatic trace file routine\n");
	if ($self->_autotrace('exists')) {
	    $fileref->print ("${prefix}// Exists switch: predeclared tracing routine\n");
	} else {
	    $fileref->print ("#if WAVES\n",
			     "# include \"SpTraceVcd.h\"\n",);
	    if ($fileref->SystemC::Netlist::File::_write_in_slow) {
		_tracer_include_recurse($self,$trinfo, $fileref,$trinfo->{tracesref});
		_write_tracer_trace ($self, $trinfo, $fileref, $trinfo->{tracesref});
		_write_tracer_init  ($self, $trinfo, $fileref, $trinfo->{tracesref});
		_write_tracer_change($self, $trinfo, $fileref, $trinfo->{tracesref}, "full");
	    }
	    if ($fileref->SystemC::Netlist::File::_write_in_fast) {
		_write_tracer_change($self, $trinfo, $fileref, $trinfo->{tracesref}, "chg");
	    }
	    $fileref->print ("#endif // WAVES\n");
	}
	$fileref->print ("${prefix}// End of SystemPerl automatic trace file routine\n"),
    }
}

sub _tracer_dups_recurse {
    my $modref = shift or return;   # Submodule may not exist if library cell
    my $trinfo = shift;
    my $modhier = shift || "";	# ".cellname" appended each recursion
    # Goal: For each signal, try to find the lowest level in the hierarchy that
    # sources that signal.  (There are the fewest changedetects at lower levels.)

    my $dupsref = $trinfo->{dupsref};	# global entry to write to

    # Add our nets to the layout
    foreach my $cellref ($modref->cells_sorted()) {
	next if $cellref->submod && $cellref->submod->_autotrace('standalone');
	my $submodhier = $modhier.".".$cellref->name;
	foreach my $pinref ($cellref->pins_sorted) {
	    if ($pinref->net && $pinref->port && $pinref->port->net
		&& $pinref->port->net->array eq $pinref->net->array
		&& $pinref->port->net->data_type eq $pinref->net->data_type
		&& $pinref->port->net->msb eq $pinref->net->msb
		&& $pinref->port->net->lsb eq $pinref->net->lsb
		&& $pinref->port->net->stored_lsb eq $pinref->net->stored_lsb
		&& !_net_ignore($pinref->port->net)
		&& !_net_ignore($pinref->net)
		) {
		# Thus, it's the same signal passed across the hierarchy.
		#print "PIN ",$cellref->name," XX ", $pinref->name,"\n";
		my $nethiername = $modhier."->".$pinref->net->name;
		my $subnethiername = $submodhier."->".$pinref->port->net->name;
		# We link *references* so that changing one reference value changes
		# all signal users that point to it.
		my $linkref = $nethiername;
		$dupsref->{$nethiername} ||= \$linkref;
		if ($pinref->port->direction() eq 'out') {
		    # Output, use submod's change
		    ${$dupsref->{$nethiername}} = $subnethiername;
		    $dupsref->{$subnethiername} = $dupsref->{$nethiername};
		} else {
		    # In/inout use upper's change
		    $dupsref->{$subnethiername} = $dupsref->{$nethiername};
		}
	    }
	}
	_tracer_dups_recurse ($cellref->submod,
			      $trinfo,
			      $submodhier,
			      );
    }
}

sub _tracer_dups_show {
    my $modref = shift;
    my $trinfo = shift;
    print "DUPS ",$modref->name,"\n";
    printf "  %-40s %s\n", "NET", "Gets data from NET";
    foreach my $netname (sort (keys %{$trinfo->{dupsref}})) {
	my $outputter_name = ${$trinfo->{dupsref}->{$netname}};
	if ($outputter_name ne $netname) {
	    printf "  %-40s %s\n", $netname, $outputter_name;
	}
    }
}

sub _net_ignore {
    my $netref = shift;
    # Return a reason for ignoring this signal, or undef
    return "Leading _" if ($netref->name =~ /^_/ 	# Skip leading _ signals
			   && $netref->name !~ /^__PVT__[^_]/);
    return "Unknown width of type ".$netref->type() if !$netref->width();
    return "Wide Memory Signal"  if (($netref->width()||0)>256);
    return "Wide Memory Vector"  if ($netref->array()
				     && ($netref->array=~/^[0-9]/)
				     && (($netref->array()||0)>32));
    my $scbv = $netref->is_sc_bv;
    if (!$netref->simple_type) {
	if ($netref->port && $netref->port->direction eq "out") {
	    if (!$netref->netlist->{sp_allow_output_tracing}) {
		return "Can't read output ports -- need patch";
	    }
	}
    }
    return undef;
}

sub _tracer_setup {
    my $modref = shift or return;   # Submodule may not exist if library cell
    my $trinfo = shift;		# Global trace information
    my $tracesref = shift;	# *PARENT's* {cells} entry to write to
    my $level = shift || 1;	# increments each recursion
    my $nethier = shift || "t";	# "->cellname" appended each recursion
    my $modhier = shift || "";	# ".cellname" appended each recursion

    # Tracesref has information on the module
    $tracesref->{modref} = $modref;
    $tracesref->{modhier} = $modhier;
    $tracesref->{nethier} = $nethier,
    $tracesref->{cells} = [];

    if (!$modref->_autotrace('exists')) {
	foreach my $netref ($modref->nets_sorted()) {
	    _tracer_setup_net($trinfo, $tracesref, $modhier."->", $netref, "", "ts->", []);
	}
    }
    if ($trinfo->{recurse}) {
	foreach my $cellref ($modref->cells_sorted()) {
	    next if $cellref->submod && $cellref->submod->_autotrace('standalone');
	    my $subref = {};
	    push @{$tracesref->{cells}}, $subref;
	    _tracer_setup($cellref->submod,
			  $trinfo,
			  $subref,
			  $level+1,
			  $nethier."->".$cellref->name,
			  $modhier.".".$cellref->name,
			  );
	}
    }
}

sub _tracer_setup_accessor {
    my $netref = shift;
    my $orig_accessor = shift || "";
    my $vecref = shift;

    my $ignore = _net_ignore($netref);
    my $accessor = "";	# Function call to get the value of the signal
    my $scbv = $netref->is_sc_bv;
    if ($scbv) {
	$accessor .= "(SP_SC_BV_DATAP(";
    }
    $accessor .= $orig_accessor.$netref->name;
    if ($netref->array) {
	$accessor .= "[_i".($#{$vecref})."]";
    }
    if (($netref->width||0) > 64 && !$scbv) {
	$accessor .= "[0]";
    }
    if (!$netref->simple_type) {
	if ($netref->port && $netref->port->direction eq "out") {
	    # This is nasty, and might even result in bad data
	    # It also requires a library patch
	    if (!$netref->netlist->{sp_allow_output_tracing}) {
		$ignore or die "%Error: Should have ignored, Can't read output ports,";
	    } elsif ($netref->netlist->{sp_allow_output_tracing} eq 'hack') {
		# SystemC 1.0.1a
		$accessor .= ".const_signal()->get_cur_value()";
	    } else {
		$accessor .= ".read()";
	    }
	} else {
	    $accessor .= ".read()";
	}
    }
    if ($scbv) {
	$accessor .= ")[0])";
    }

    return $accessor;
}

sub _tracer_setup_net {
    my $trinfo = shift;		# Global trace information
    my $tracesref = shift;	# *PARENT's* {cells} entry to write to
    my $modhier = shift;
    my $netref = shift;
    my $humanprefix = shift;
    my $upper_accessor = shift;
    my $vecref = shift;

    my $newvecref = $vecref;
    if ($netref->array) {
	$newvecref = [@{$vecref}, $netref->array];
    }
    if (!$netref->width()) {
	if (my $classref = $netref->netlist->find_class($netref->data_type)) {
	    # It's a structure we know about.  Recurse all of the members of the struct
	    foreach my $subnetref ($classref->nets_sorted()) {
		_tracer_setup_net($trinfo, $tracesref,
				  $modhier.".".$netref->name,
				  $subnetref,
				  $humanprefix._dedot($netref->name).".",
				  _tracer_setup_accessor($netref, $upper_accessor,$newvecref).".",
				  $newvecref,
				  );
	    }
	    return;
	}
    }

    my $ignore = _net_ignore($netref);
    my $accessor = _tracer_setup_accessor($netref, $upper_accessor, $newvecref);

    my $code_inc = 0;
    if (!$ignore) {
	$code_inc = (int($netref->width()/32) + 1);
    }

    # Check identicals
    my $dupsref = $trinfo->{dupsref};	# global duplicate information
    my $dupscoderef = $trinfo->{dupscoderef};	# global duplicate code number info

    my $nethiername = $modhier.$netref->name;
    my $identical = $dupsref->{$nethiername} && ${$dupsref->{$nethiername}};
    my $identical_decl; my $identical_use;
    if ($identical && !$ignore) {
	# Thus, it's the same signal passed across the hierarchy.
	if (!defined $dupscoderef->{$identical}) {
	    # First module that references it gets to choose the code for it
	    # This isn't necessarily the same cell that generates the *value*
	    $dupscoderef->{$identical}{code} = ++$trinfo->{ident_code};
	}
	if ($identical ne $nethiername) { 	# Driven from somewhere else
	    # Use previous declaration
	    $identical_use = $dupscoderef->{$identical}{code};
	} else {
	    $identical_decl = $dupscoderef->{$identical}{code};
	}
    }

    # Report errors
    if ($netref->sp_traced && $ignore) {
	$netref->warn("Ignoring SP_TRACED, $ignore: ".$netref->name."\n");
    }

    # Store info for this var
    my $tref = {
	netref => $netref,
	code_inc => $code_inc,
	ignore => $ignore,
	identical_decl => $identical_decl,
	identical_use => $identical_use,
	accessor => $accessor,
	human_name => $humanprefix._dedot($netref->name()),
	vectors => [@{$newvecref}],   # Not used yet; for multi-dim arraying
    };
    push @{$tracesref->{vars}}, $tref;
    $tref->{check_code} = $Debug_Check_Code++ if $Debug_Check_Code;
}

sub _tracer_include_recurse {
    my $self = shift;
    my $trinfo = shift;
    my $fileref = shift;
    my $tracesref = shift;
    my $level = shift||0;

    my $modref = $tracesref->{modref};
    my $header = basename($modref->filename);
    $header =~ s/\.(c+p*|h|sp)/.h/;
    $fileref->print("#".(" "x$level)."include \"${header}\"\n");

    foreach my $cellref (@{$tracesref->{cells}}) {
	_tracer_include_recurse($self,$trinfo,$fileref,$cellref,$level);
    }
}

sub _write_tracer_trace {
    my $self = shift;
    my $trinfo = shift;
    my $fileref = shift;
    #my $tracesref = shift;

    my $mod = $self->name;

    my $trace_class = $self->_autotrace('c') ? "SpTraceVcdCFile" : "SpTraceFile";
    $fileref->print
	("void ${mod}::trace (${trace_class}* tfp, int levels, int options) {\n",
	 "    if(0 && options) {}  // Prevent unused\n",
	 "    tfp->spTrace()->addCallback (&${mod}::traceInit, &${mod}::traceFull,  &${mod}::traceChg, this);\n",);
    my $cmt = "";
    if ($trinfo->{recurse}) {
	$fileref->print ("    // Inline child recursion, so don't need:\n");
	$cmt = "//";
    }
    $fileref->print ("    ${cmt}if (levels > 0) {\n",);
    foreach my $cellref ($self->cells_sorted) {
	my $name = $cellref->name;
	(my $namenobra = $name) =~ tr/\[\]/()/;
	if ($cellref->submod  # Else not linked
	    && $cellref->submod->_autotrace('on')
	    && !$cellref->submod->_autotrace('standalone')) {
	    $fileref->printf ("    ${cmt}    if (this->${name}) this->${name}->trace (tfp, levels-1, options);  // Is-a %s\n",
			      $cellref->submod->name);
	}
    }
    $fileref->print ("    ${cmt}}\n",
		     "}\n",);
}

sub _write_tracer_init {
    my $self = shift;
    my $trinfo = shift;
    my $fileref = shift;
    my $tracesref = shift;

    my $mod = $self->name;
    $fileref->printf("static int ${mod}_checkcode[%d];\n\n", $Debug_Check_Code+1) if $Debug_Check_Code;

    $fileref->print("void ${mod}::traceInit (SpTraceVcd* vcdp, void* userthis, uint32_t code) {\n");
    if ($trinfo->{ident_code}) {
	$fileref->printf("  int _identcode[%d];\n", $trinfo->{ident_code}+1);
	$fileref->printf("  for (int _i=0; _i<%d; _i++) { _identcode[_i]=0; }\n", $trinfo->{ident_code});
    }
    $fileref->print("  // Callback from vcd->open()\n");
    $fileref->print("  if (0 && vcdp && userthis && code) {}  // Prevent unused\n");
    if ($#{$tracesref->{vars}} >= 0) {
	$fileref->print("  int c=code;\n");
	$fileref->print("  ${mod}* t=(${mod}*)userthis;\n");
	$fileref->print("  string prefix = t->name();\n");
	$fileref->print("  // Calculate identical signal codes\n");
    }

    _write_tracer_init_recurse($self,$trinfo,$fileref,$tracesref, 1);
    if ($#{$tracesref->{vars}} >= 0) {
	$fileref->print("  // Setup signal names\n");
	$fileref->print("  c=code;\n");
    }
    _write_tracer_init_recurse($self,$trinfo,$fileref,$tracesref, 0);
    $fileref->print("}\n");
}

sub _dedot {
    my $dot = shift;
    $dot =~ s/__PVT__//g;
    $dot =~ s/__DOT__/./g;
    return $dot;
}

sub _write_tracer_init_recurse {
    my $self = shift;
    my $trinfo = shift;
    my $fileref = shift;
    my $tracesref = shift;
    my $doident = shift;
    my $level = shift||1;

    my $indent = "  "x$level;

    my $mod = $self->name;
    my $modref = $tracesref->{modref};
    if ($doident) {
	$fileref->printf("${indent}\{ // %s\n", $tracesref->{modhier});
    } else {
	$fileref->printf("${indent}\{\n");
	if ($#{$tracesref->{vars}} >= 0) {
	    $fileref->printf("${indent} vcdp->module(prefix+\"%s\");  // Is-a %s\n"
			     , _dedot($tracesref->{modhier}), $modref->name);
	}
    }

    foreach my $tref (@{$tracesref->{vars}}) {
	my $netref = $tref->{netref};
	my $aindent = $indent;
	# Scope to correct parent module
	# Now do the signal
	if ($doident) {
	    $fileref->printf("${aindent}  // ".$tref->{human_name}."\n") if $Debug_Check_Code;
	    if ($tref->{identical_decl}) {   # This code is reused by a child module.
		$fileref->printf("${aindent}  _identcode[".$tref->{identical_decl}."] = c;\n");
	    }
	}
	if ($doident) {
	    $fileref->printf("${aindent}  ${mod}_checkcode[".$tref->{check_code}."] = c-code;\n") if $Debug_Check_Code;
	    next if $tref->{identical_use};
	    next if $tref->{ignore};
	} else {
	    $fileref->printf("${aindent}  if (${mod}_checkcode[".$tref->{check_code}."] != c-code) abort();\n") if $Debug_Check_Code;
	}
	my $c = "c";
	my $ket = "";
	if ($tref->{identical_use} && !$tref->{ignore}) {
	    $c = "lc";
	    $fileref->printf("${aindent}  {int lc=_identcode[".$tref->{identical_use}."];\n");
	    $ket .= "}";
	}
	if (!$tref->{ignore}) {
	    if ($netref->array) {
		$fileref->printf("${aindent}  for (int _i0=0; _i0<%s; ++_i0) {\n"
				 ,$netref->array);
		$aindent .= "  ";
		$ket .= "}";
	    }
	}

	if ($tref->{ignore}) {
	    $fileref->printf("${aindent}  //IGNORED: %s: Type=%s  Array=%s\n"
			     ,$tref->{ignore},$netref->data_type||"",$netref->array||'');
	    $fileref->printf("${aindent}  //{");
	} else {
	    $fileref->printf("${aindent}  {");
	}
	$ket .= "}";

	my $width = $netref->width || 1;
	my $arraynum = ($netref->array ? " _i0":"-1");
	$fileref->printf("");
	my $name = $tref->{human_name};
	if (!$doident) {
	    if ($width == 1) {
		$fileref->printf("vcdp->declBit  (${c},\"%s\",%s"
				 ,$name, $arraynum);
	    } elsif ($width <= 32) {
		$fileref->printf("vcdp->declBus  (${c},\"%s\",%s,%d,%d"
				 ,$name, $arraynum,$netref->msb, $netref->stored_lsb);
	    } elsif ($width <= 64) {
		$fileref->printf("vcdp->declQuad  (${c},\"%s\",%s,%d,%d"
				 ,$name, $arraynum,$netref->msb, $netref->stored_lsb);
	    } else {
		$fileref->printf("vcdp->declArray(${c},\"%s\",%s,%d,%d",
				 ,$name, $arraynum,$netref->msb, $netref->stored_lsb);
	    }
	    $fileref->printf("); ");
	}
	$fileref->printf("${c}+=%s;$ket",$tref->{code_inc});
	if ($doident) {
	    $fileref->printf("\n");
	} else {
	    $fileref->printf(" // Is-a: %s\n", $netref->type);
	}
    }

    foreach my $tref (@{$tracesref->{cells}}) {
	_write_tracer_init_recurse($self, $trinfo, $fileref, $tref, $doident, $level+1);
    }
    $fileref->printf("${indent}\}\n");
}

sub _write_tracer_change {
    my $self = shift;
    my $trinfo = shift;
    my $fileref = shift;
    my $tracesref = shift;
    my $mode = shift;   # full or chg

    my $mod = $self->name;
    $fileref->print("//","="x70,"\n");
    $fileref->print("void ${mod}::trace".ucfirst($mode)." (SpTraceVcd* vcdp, void* userthis, uint32_t code) {\n");
    $fileref->print("  // Callback from vcd->dump()\n");
    $fileref->print("  if (0 && vcdp && userthis && code) {}  // Prevent unused\n");
    if ($#{$tracesref->{vars}} >= 0) {
	$fileref->print("  int c=code;\n");
	$fileref->print("  ${mod}* t=(${mod}*)userthis;\n");
    }
    _write_tracer_change_recurse($self,$trinfo,$fileref,$tracesref,$mode);

    $fileref->print("}\n");
}

sub _write_tracer_change_recurse {
    my $self = shift;
    my $trinfo = shift;
    my $fileref = shift;
    my $tracesref = shift;
    my $mode = shift;   # full or chg
    my $level = shift||1;

    my $indent = "  "x$level;

    my $mod = $self->name;
    my $modref = $tracesref->{modref};
    $fileref->printf("${indent}\{\n");
    if ($#{$tracesref->{vars}} >= 0) {
	$fileref->printf("${indent} register %s* ts = %s;\n"
			 , $modref->name, $tracesref->{nethier});
    }

    my $use_activity=$self->_autotrace('activity');
    if ($use_activity) {
	$fileref->printf("${indent} if (ts->getClearActivity()) {\n");
    } else {
	$fileref->printf("${indent} {\n");
    }

    my $code_inc = 0;
    my $code_math = "";

    foreach my $tref (@{$tracesref->{vars}}) {
	my $netref = $tref->{netref};
	next if $tref->{ignore};
	next if $tref->{identical_use};
	my $accessor = $tref->{accessor};

	$fileref->printf("${indent}  if (${mod}_checkcode[".$tref->{check_code}."] != c-code) abort();\n") if $Debug_Check_Code;

	my $aindent = $indent;
	if ($netref->array) {
	    $fileref->printf("${indent}  for (int _i0=0; _i0<%s; ++_i0) {\n"
			     ,$netref->array);
	    $aindent .= "  ";
	    if ($netref->array =~ /^\d+$/) {
		$code_inc += ($netref->array * $tref->{code_inc});
	    } else {
		$code_math .= "+((".$netref->array.")*".$tref->{code_inc}.")";   # Let compiler sort it out
	    }
	} else {
	    $code_inc += $tref->{code_inc};
	}
	if ($netref->cast_type) {
	    $fileref->printf("${aindent}  {const ".$netref->cast_type." tempVal=%s;\n",
			     $accessor);
	    $fileref->printf("${aindent}   ");
	    $accessor = "tempVal";
	} else {
	    $fileref->printf("${aindent}  {");
	}
	if ($netref->width == 1) {
	    $fileref->printf("vcdp->${mode}Bit  (c,  %s"
			     ,${accessor});
	} elsif ($netref->width <= 32) {
	    $fileref->printf("vcdp->${mode}Bus  (c,  %s,%d"
			     ,${accessor}, $netref->width);
	} elsif ($netref->width <= 64) {
	    $fileref->printf("vcdp->${mode}Quad  (c,  %s,%d"
			     ,${accessor}, $netref->width);
	} else {
	    $fileref->printf("vcdp->${mode}Array(c,&(%s),%d",
			     ,${accessor}, $netref->width);
	}
	$fileref->printf("); c+=%s;}\n",$tref->{code_inc});

	if ($netref->array) {
	    $fileref->printf("${indent}  }\n");
	}
    }
    foreach my $tref (@{$tracesref->{cells}}) {
	my ($subcode_inc, $subcode_math)
	    = _write_tracer_change_recurse($self, $trinfo, $fileref, $tref, $mode, $level+1);
	$code_inc += $subcode_inc;
	$code_math .= $subcode_math;
    }

    if ($use_activity) {
	$fileref->printf("${indent} } else {\n");  # Else no activity
	$fileref->printf("${indent}  c+=${code_inc}${code_math}; // No activity\n");
    }

    $fileref->printf("${indent}}}\n");
    return ($code_inc,$code_math);
}

######################################################################
#### Package return
1;
__END__