[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Midas_samy / PostProcessing.pm

# -*- perl -*-

package Midas::PostProcessing;
use strict;
use warnings;

use IO::File;
use IO::Pipe;
use File::Basename;

use Midas::Command;
use Midas::Configure;
use Midas::State;
use Midas::Paths;
use Midas::Section;
use Midas::Globals;
# Cant' use Assembly ':internals' because of include circularity
use Midas::Preprocess ':internals';
use Midas::Application;
use Midas::Error;
use Midas::Segment;

require Exporter;

our @ISA         = qw(Exporter);
our @EXPORT      = qw();
our @EXPORT_OK   = qw();

our @common_exports = qw(
			 generate_events
			);
our @asm_exports    = qw(generate_image
			 postprocess_assembly
			);
our @external_exports = qw(postprocess_assembly);
our %EXPORT_TAGS = (
		    common   => [ @common_exports ],
		    asm      => [ @asm_exports, @common_exports ],
		    external => [ @external_exports ],
		    all      => [ @asm_exports, @common_exports ],
		   );

Exporter::export_ok_tags('common', 'asm', 'external', 'all');


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

sub postprocess_assembly {
  my $image    = shift;
  my $symtab   = shift;
  my $sfile    = shift;
  my $events   = shift;

  banner "POSTPROCESSING PHASE";

  generate_image($image);
  generate_events($sfile, $events);
}

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

sub generate_image {
  my $image    = shift;

  my $pushd = Midas::Paths->pushd($STATE->get_build_dir);


  $image    = path_to_build_file($CONFIG{local_image}, $STATE)
    unless defined $image;

  my $symtab = path_to_build_file($CONFIG{local_symtab}, $STATE);

  my $goldfinger =  path_to_build_file($CONFIG{local_goldfinger}, $STATE);

  chat "Generating $goldfinger...\n";

  my $fh = IO::File->new(">$goldfinger") or
    fatal "Can't open $goldfinger: $!\n", M_FILE;


  print $fh "PA_SIZE = $PASIZE;\n";
  print $fh "\n";

  foreach my $app (keys %{$STATE->{apps}}) {
    my $appobj = $STATE->{apps}{$app};
    $appobj->write_to_goldfinger($fh);
  }


  foreach my $tsbname (keys %{$STATE->{tsbs}}) {
    my $tsb = $STATE->{tsbs}{$tsbname};
    $tsb->write_to_goldfinger_file($fh) if $tsb->is_touched();
  }

  foreach my $tsblinkname (keys %{$STATE->{tsblinks}}) {
    my $tsblink = $STATE->{tsblinks}{$tsblinkname};
    $tsblink->write_to_goldfinger_file($fh) if $tsblink->is_touched();
  }

  undef $fh;

  my $Prg = basename $0;

  my $error_opt = $Midas::Error::Print_Errors ? '' : '-noprint_errors ';

  my $verbose = ($CONFIG{verbose} == 0) ? '-silent ' :
    ($CONFIG{verbose} == 2) ? '-v ' : '';
  my $compress_opt = $CONFIG{compress_image} ? '' : '-nocompress ';
  my $allow_tsb_conflicts_opt = $CONFIG{allow_tsb_conflicts} ?
    '-allow_tsb_conflicts ' : '';
  my $allow_duplicate_tags_opt = $CONFIG{allow_duplicate_tags} ?
    '-allow_duplicate_tags ' : '';
  my $zero_env_opt = $CONFIG{env_zero} ? '' : '-noenvzero ';

  my $opts = "${error_opt}${compress_opt}${allow_tsb_conflicts_opt}".
    "${allow_duplicate_tags_opt}${zero_env_opt}";

  my $command =
    "$CONFIG{goldfinger_cmd} ${verbose}-in $goldfinger ".
    "-gentsbs -genimage -imagefile $image -gensymtab -symtabfile $symtab ".
    "${opts}-prefix '${Midas::Error::Prg}: '";

  run_command($command, '-pass_errcode');

  if (-e $symtab) {
    chat "$symtab successfully created.\n";
  } else {
    fatal "$symtab could not be generated.\n", M_GENFAIL;
  }

  if (-e $image) {
    chat "$image successfully created.\n";
  } else {
    fatal "$image could not be generated.\n", M_GENFAIL;
  }


}

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

sub generate_events {
  my $m4file  = shift;
  my $symtab  = shift;
  my $events  = shift;

  my $pushd = Midas::Paths->pushd($STATE->get_build_dir);

  $m4file = path_to_build_file($CONFIG{local_m4}, $STATE)
    unless defined $m4file;
  $symtab = path_to_build_file($CONFIG{local_symtab}, $STATE)
    unless defined $symtab;
  $events = path_to_build_file($CONFIG{local_events}, $STATE)
    unless defined $events;

  chat "Generating $events...\n";

  chat "Loading symbol table from $symtab.\n", 3;
  local ($_);
  my (%vahash, %rahash, %pahash);
  my $ifh = IO::File->new("<$symtab") or fatal "Can't open $symtab: $!\n",
    M_FILE;
  while(<$ifh>) {
    my ($sym, $va, $ra, $pa) = /([\w_\.]+)\s+(\w+)\s+(\w+)(?:\s+(\w+))/;
    next unless defined $va && defined $ra;
    if(not defined $pa) {
      $pa = $ra;
      undef $ra;
    }
    $vahash{$sym} = $va;
    $rahash{$sym} = $ra if defined $ra;
    $pahash{$sym} = $pa;
  }
  undef $ifh;

  my $ofh = IO::Pipe->new();
  my $m4_incs = join ' ', map { "--include=$_"} get_m4_includes();
  my $command = "$CONFIG{m4_cmd} $m4_incs > $events";
  $ofh->writer("$command") or
    fatal "Cannot run m4 to create $events: $!\n", M_GENFAIL;

  $ofh->print("changequote({, })dnl\n");

  my $full_line = "";
  my $ev_null = 1;
  my $ev_collect = 0;
  my $ev_eval = 0;

  $ifh = IO::File->new("<$m4file") or
    fatal "Can't open file $m4file for reading: $!\n", M_FILE;


 CPPFL_LINE:
  while (<$ifh>) {
    my ($evline) = /.*!\s*\$EV\s+(.*)$/;
    my ($evlinep) = /.*!\s*\$EV\+\s+(.*)$/;

    # supress warnings
    $evline  = "" unless defined $evline;
    $evlinep = "" unless defined $evlinep;

    if ($ev_null == 1) {
      if ($evlinep ne "") {
	fatal "Error in parsing event $_", M_EVENTERR;
      }
      if ($evline ne "") {
	$ev_null = 0;
	$ev_collect = 1;
	$full_line .= $evline;
	next CPPFL_LINE;
      }
    }
    if ($ev_collect == 1) {
      if ($evlinep ne "") {
	$full_line .= $evlinep;
      }
      elsif ($evline ne "") {
	$ev_eval = 1;
      }
      else {
	$ev_eval = 1;
	$ev_null = 1;
	$ev_collect = 0;
      }
    }
    if ($ev_eval == 1) {
      $_ = $full_line;
      my $va;
      while (/.*\@VA\([\w_\.]*\).*$/) {
	($va) = /VA\(([\w_\.]*)\)/;
	if (not defined $vahash{$va})
	  {fatal "Error in va address: $_\n", M_EVENTERR;}
	s/\@VA\([\w_\.]*\)/"0x$vahash{$va}"/e;
      }
      while (/.*\@RA\([\w_\.]*\).*$/) {
	($va) = /RA\(([\w_\.]*)\)/;
	if (not defined $rahash{$va})
	  {fatal "Error in ra address: $_\n", M_EVENTERR;}
	s/\@RA\([\w_\.]*\)/"0x$rahash{$va}"/e;
      }
      while (/.*\@PA\([\w_\.]*\).*$/) {
	($va) = /PA\(([\w_\.]*)\)/;
	if (not defined $pahash{$va})
	  {fatal "Error in pa address: $_\n", M_EVENTERR;}
	s/\@PA\([\w_\.]*\)/"0x$pahash{$va}"/e;
      }
      while (/.*expr.*$/) {
	s/expr/"{64'h}mpeval"/e;
      }
      $ofh->print("$_\n");
      $ev_eval = 0;
      $full_line = $evline;
    }
  }

  undef $ifh;
  $ofh->close();

  if($?) {
    my $status = $?;
    my $exit = $status >> 8;
    my $sig  = $status & 127;
    my $core = $status & 128;
    my $core_msg = $core ? "Dumped core." : "";

    if($sig) {
      fatal "Command \"$command\" died via signal $sig. $core_msg\n",
	M_GENFAIL;
    }

    fatal "Command \"$command\" failed with status $exit. $core_msg\n",
      M_GENFAIL;
  }

  undef $ofh;

  if(-e $events) {
    chat "$events successfully created.\n";
  } else {
    fatal "$events could not be generated.\n", M_GENFAIL;
  }
}

##############################################################################
1;
Commit	Line	Data
86530b38 AT	1	# -- perl --
	2
	3	package Midas::PostProcessing;
	4	use strict;
	5	use warnings;
	6
	7	use IO::File;
	8	use IO::Pipe;
	9	use File::Basename;
	10
	11	use Midas::Command;
	12	use Midas::Configure;
	13	use Midas::State;
	14	use Midas::Paths;
	15	use Midas::Section;
	16	use Midas::Globals;
	17	# Cant' use Assembly ':internals' because of include circularity
	18	use Midas::Preprocess ':internals';
	19	use Midas::Application;
	20	use Midas::Error;
	21	use Midas::Segment;
	22
	23	require Exporter;
	24
	25	our @ISA = qw(Exporter);
	26	our @EXPORT = qw();
	27	our @EXPORT_OK = qw();
	28
	29	our @common_exports = qw(
	30	generate_events
	31	);
	32	our @asm_exports = qw(generate_image
	33	postprocess_assembly
	34	);
	35	our @external_exports = qw(postprocess_assembly);
	36	our %EXPORT_TAGS = (
	37	common => [ @common_exports ],
	38	asm => [ @asm_exports, @common_exports ],
	39	external => [ @external_exports ],
	40	all => [ @asm_exports, @common_exports ],
	41	);
	42
	43	Exporter::export_ok_tags('common', 'asm', 'external', 'all');
	44
	45
	46	##############################################################################
	47
	48	sub postprocess_assembly {
	49	my $image = shift;
	50	my $symtab = shift;
	51	my $sfile = shift;
	52	my $events = shift;
	53
	54	banner "POSTPROCESSING PHASE";
	55
	56	generate_image($image);
	57	generate_events($sfile, $events);
	58	}
	59
	60	##############################################################################
	61
	62	sub generate_image {
	63	my $image = shift;
	64
65	my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
66
67
68	$image = path_to_build_file($CONFIG{local_image}, $STATE)
69	unless defined $image;
70
71	my $symtab = path_to_build_file($CONFIG{local_symtab}, $STATE);
72
73	my $goldfinger = path_to_build_file($CONFIG{local_goldfinger}, $STATE);
74
75	chat "Generating $goldfinger...\n";
76
77	my $fh = IO::File->new(">$goldfinger") or
78	fatal "Can't open $goldfinger: $!\n", M_FILE;
79
80
81	print $fh "PA_SIZE = $PASIZE;\n";
82	print $fh "\n";
83
84	foreach my $app (keys %{$STATE->{apps}}) {
85	my $appobj = $STATE->{apps}{$app};
86	$appobj->write_to_goldfinger($fh);
87	}
88
89
90	foreach my $tsbname (keys %{$STATE->{tsbs}}) {
91	my $tsb = $STATE->{tsbs}{$tsbname};
92	$tsb->write_to_goldfinger_file($fh) if $tsb->is_touched();
93	}
94
95	foreach my $tsblinkname (keys %{$STATE->{tsblinks}}) {
96	my $tsblink = $STATE->{tsblinks}{$tsblinkname};
97	$tsblink->write_to_goldfinger_file($fh) if $tsblink->is_touched();
98	}
99
100	undef $fh;
101
102	my $Prg = basename $0;
103
104	my $error_opt = $Midas::Error::Print_Errors ? '' : '-noprint_errors ';
105
106	my $verbose = ($CONFIG{verbose} == 0) ? '-silent ' :
107	($CONFIG{verbose} == 2) ? '-v ' : '';
108	my $compress_opt = $CONFIG{compress_image} ? '' : '-nocompress ';
109	my $allow_tsb_conflicts_opt = $CONFIG{allow_tsb_conflicts} ?
110	'-allow_tsb_conflicts ' : '';
111	my $allow_duplicate_tags_opt = $CONFIG{allow_duplicate_tags} ?
112	'-allow_duplicate_tags ' : '';
113	my $zero_env_opt = $CONFIG{env_zero} ? '' : '-noenvzero ';
114
115	my $opts = "${error_opt}${compress_opt}${allow_tsb_conflicts_opt}".
116	"${allow_duplicate_tags_opt}${zero_env_opt}";
117
118	my $command =
119	"$CONFIG{goldfinger_cmd} ${verbose}-in $goldfinger ".
120	"-gentsbs -genimage -imagefile $image -gensymtab -symtabfile $symtab ".
121	"${opts}-prefix '${Midas::Error::Prg}: '";
122
123	run_command($command, '-pass_errcode');
124
125	if (-e $symtab) {
126	chat "$symtab successfully created.\n";
127	} else {
128	fatal "$symtab could not be generated.\n", M_GENFAIL;
129	}
130
131	if (-e $image) {
132	chat "$image successfully created.\n";
133	} else {
134	fatal "$image could not be generated.\n", M_GENFAIL;
135	}
136
137
138	}
139
140	##############################################################################
141
142	sub generate_events {
143	my $m4file = shift;
144	my $symtab = shift;
145	my $events = shift;
146
147	my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
148
149	$m4file = path_to_build_file($CONFIG{local_m4}, $STATE)
150	unless defined $m4file;
151	$symtab = path_to_build_file($CONFIG{local_symtab}, $STATE)
152	unless defined $symtab;
153	$events = path_to_build_file($CONFIG{local_events}, $STATE)
154	unless defined $events;
155
156	chat "Generating $events...\n";
157
158	chat "Loading symbol table from $symtab.\n", 3;
159	local ($_);
160	my (%vahash, %rahash, %pahash);
161	my $ifh = IO::File->new("<$symtab") or fatal "Can't open $symtab: $!\n",
162	M_FILE;
163	while(<$ifh>) {
164	my ($sym, $va, $ra, $pa) = /([\w_\.]+)\s+(\w+)\s+(\w+)(?:\s+(\w+))/;
165	next unless defined $va && defined $ra;
166	if(not defined $pa) {
167	$pa = $ra;
168	undef $ra;
169	}
170	$vahash{$sym} = $va;
171	$rahash{$sym} = $ra if defined $ra;
172	$pahash{$sym} = $pa;
173	}
174	undef $ifh;
175
176	my $ofh = IO::Pipe->new();
177	my $m4_incs = join ' ', map { "--include=$_"} get_m4_includes();
178	my $command = "$CONFIG{m4_cmd} $m4_incs > $events";
179	$ofh->writer("$command") or
180	fatal "Cannot run m4 to create $events: $!\n", M_GENFAIL;
181
182	$ofh->print("changequote({, })dnl\n");
183
184	my $full_line = "";
185	my $ev_null = 1;
186	my $ev_collect = 0;
187	my $ev_eval = 0;
188
189	$ifh = IO::File->new("<$m4file") or
190	fatal "Can't open file $m4file for reading: $!\n", M_FILE;
191
192
193	CPPFL_LINE:
194	while (<$ifh>) {
195	my ($evline) = /.!\s\$EV\s+(.*)$/;
196	my ($evlinep) = /.!\s\$EV\+\s+(.*)$/;
197
198	# supress warnings
199	$evline = "" unless defined $evline;
200	$evlinep = "" unless defined $evlinep;
201
202	if ($ev_null == 1) {
203	if ($evlinep ne "") {
204	fatal "Error in parsing event $_", M_EVENTERR;
205	}
206	if ($evline ne "") {
207	$ev_null = 0;
208	$ev_collect = 1;
209	$full_line .= $evline;
210	next CPPFL_LINE;
211	}
212	}
213	if ($ev_collect == 1) {
214	if ($evlinep ne "") {
215	$full_line .= $evlinep;
216	}
217	elsif ($evline ne "") {
218	$ev_eval = 1;
219	}
220	else {
221	$ev_eval = 1;
222	$ev_null = 1;
223	$ev_collect = 0;
224	}
225	}
226	if ($ev_eval == 1) {
227	$_ = $full_line;
228	my $va;
229	while (/.\@VA\([\w_\.]\).*$/) {
230	($va) = /VA\(([\w_\.]*)\)/;
231	if (not defined $vahash{$va})
232	{fatal "Error in va address: $_\n", M_EVENTERR;}
233	s/\@VA\([\w_\.]*\)/"0x$vahash{$va}"/e;
234	}
235	while (/.\@RA\([\w_\.]\).*$/) {
236	($va) = /RA\(([\w_\.]*)\)/;
237	if (not defined $rahash{$va})
238	{fatal "Error in ra address: $_\n", M_EVENTERR;}
239	s/\@RA\([\w_\.]*\)/"0x$rahash{$va}"/e;
240	}
241	while (/.\@PA\([\w_\.]\).*$/) {
242	($va) = /PA\(([\w_\.]*)\)/;
243	if (not defined $pahash{$va})
244	{fatal "Error in pa address: $_\n", M_EVENTERR;}
245	s/\@PA\([\w_\.]*\)/"0x$pahash{$va}"/e;
246	}
247	while (/.expr.$/) {
248	s/expr/"{64'h}mpeval"/e;
249	}
250	$ofh->print("$_\n");
251	$ev_eval = 0;
252	$full_line = $evline;
253	}
254	}
255
256	undef $ifh;
257	$ofh->close();
258
259	if($?) {
260	my $status = $?;
261	my $exit = $status >> 8;
262	my $sig = $status & 127;
263	my $core = $status & 128;
264	my $core_msg = $core ? "Dumped core." : "";
265
266	if($sig) {
267	fatal "Command \"$command\" died via signal $sig. $core_msg\n",
268	M_GENFAIL;
269	}
270
271	fatal "Command \"$command\" failed with status $exit. $core_msg\n",
272	M_GENFAIL;
273	}
274
275	undef $ofh;
276
277	if(-e $events) {
278	chat "$events successfully created.\n";
279	} else {
280	fatal "$events could not be generated.\n", M_GENFAIL;
281	}
282	}
283
284	##############################################################################
285	1;