[OpenSPARC-T2-DV] / tools / perlmod / Midas / 3.32 / lib / site_perl / 5.8.0 / Midas / PostProcessing.pm

# ========== Copyright Header Begin ==========================================
# 
# OpenSPARC T2 Processor File: PostProcessing.pm
# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
#
# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# For the avoidance of doubt, and except that if any non-GPL license 
# choice is available it will apply instead, Sun elects to use only 
# the General Public License version 2 (GPLv2) at this time for any 
# software where a choice of GPL license versions is made 
# available with the language indicating that GPLv2 or any later version 
# may be used, or where a choice of which version of the GPL is applied is 
# otherwise unspecified. 
#
# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara, 
# CA 95054 USA or visit www.sun.com if you need additional information or 
# have any questions. 
# 
# ========== Copyright Header End ============================================
# -*- 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	# ========== Copyright Header Begin ==========================================
	2	#
	3	# OpenSPARC T2 Processor File: PostProcessing.pm
	4	# Copyright (C) 1995-2007 Sun Microsystems, Inc. All Rights Reserved
	5	# 4150 Network Circle, Santa Clara, California 95054, U.S.A.
	6	#
	7	# * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
	8	#
	9	# This program is free software; you can redistribute it and/or modify
	10	# it under the terms of the GNU General Public License as published by
	11	# the Free Software Foundation; version 2 of the License.
	12	#
	13	# This program is distributed in the hope that it will be useful,
	14	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	# GNU General Public License for more details.
	17	#
	18	# You should have received a copy of the GNU General Public License
	19	# along with this program; if not, write to the Free Software
	20	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	21	#
	22	# For the avoidance of doubt, and except that if any non-GPL license
	23	# choice is available it will apply instead, Sun elects to use only
	24	# the General Public License version 2 (GPLv2) at this time for any
	25	# software where a choice of GPL license versions is made
	26	# available with the language indicating that GPLv2 or any later version
	27	# may be used, or where a choice of which version of the GPL is applied is
	28	# otherwise unspecified.
	29	#
	30	# Please contact Sun Microsystems, Inc., 4150 Network Circle, Santa Clara,
	31	# CA 95054 USA or visit www.sun.com if you need additional information or
	32	# have any questions.
	33	#
	34	# ========== Copyright Header End ============================================
	35	# -- perl --
	36
	37	package Midas::PostProcessing;
	38	use strict;
	39	use warnings;
	40
	41	use IO::File;
	42	use IO::Pipe;
	43	use File::Basename;
	44
	45	use Midas::Command;
	46	use Midas::Configure;
	47	use Midas::State;
	48	use Midas::Paths;
	49	use Midas::Section;
	50	use Midas::Globals;
	51	# Cant' use Assembly ':internals' because of include circularity
	52	use Midas::Preprocess ':internals';
	53	use Midas::Application;
	54	use Midas::Error;
	55	use Midas::Segment;
	56
	57	require Exporter;
	58
	59	our @ISA = qw(Exporter);
	60	our @EXPORT = qw();
	61	our @EXPORT_OK = qw();
	62
	63	our @common_exports = qw(
	64	generate_events
65	);
66	our @asm_exports = qw(generate_image
67	postprocess_assembly
68	);
69	our @external_exports = qw(postprocess_assembly);
70	our %EXPORT_TAGS = (
71	common => [ @common_exports ],
72	asm => [ @asm_exports, @common_exports ],
73	external => [ @external_exports ],
74	all => [ @asm_exports, @common_exports ],
75	);
76
77	Exporter::export_ok_tags('common', 'asm', 'external', 'all');
78
79
80	##############################################################################
81
82	sub postprocess_assembly {
83	my $image = shift;
84	my $symtab = shift;
85	my $sfile = shift;
86	my $events = shift;
87
88	banner "POSTPROCESSING PHASE";
89
90	generate_image($image);
91	generate_events($sfile, $events);
92	}
93
94	##############################################################################
95
96	sub generate_image {
97	my $image = shift;
98
99	my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
100
101
102	$image = path_to_build_file($CONFIG{local_image}, $STATE)
103	unless defined $image;
104
105	my $symtab = path_to_build_file($CONFIG{local_symtab}, $STATE);
106
107	my $goldfinger = path_to_build_file($CONFIG{local_goldfinger}, $STATE);
108
109	chat "Generating $goldfinger...\n";
110
111	my $fh = IO::File->new(">$goldfinger") or
112	fatal "Can't open $goldfinger: $!\n", M_FILE;
113
114
115	print $fh "PA_SIZE = $PASIZE;\n";
116	print $fh "\n";
117
118	foreach my $app (keys %{$STATE->{apps}}) {
119	my $appobj = $STATE->{apps}{$app};
120	$appobj->write_to_goldfinger($fh);
121	}
122
123
124	foreach my $tsbname (keys %{$STATE->{tsbs}}) {
125	my $tsb = $STATE->{tsbs}{$tsbname};
126	$tsb->write_to_goldfinger_file($fh) if $tsb->is_touched();
127	}
128
129	foreach my $tsblinkname (keys %{$STATE->{tsblinks}}) {
130	my $tsblink = $STATE->{tsblinks}{$tsblinkname};
131	$tsblink->write_to_goldfinger_file($fh) if $tsblink->is_touched();
132	}
133
134	undef $fh;
135
136	my $Prg = basename $0;
137
138	my $error_opt = $Midas::Error::Print_Errors ? '' : '-noprint_errors ';
139
140	my $verbose = ($CONFIG{verbose} == 0) ? '-silent ' :
141	($CONFIG{verbose} == 2) ? '-v ' : '';
142	my $compress_opt = $CONFIG{compress_image} ? '' : '-nocompress ';
143	my $allow_tsb_conflicts_opt = $CONFIG{allow_tsb_conflicts} ?
144	'-allow_tsb_conflicts ' : '';
145	my $allow_duplicate_tags_opt = $CONFIG{allow_duplicate_tags} ?
146	'-allow_duplicate_tags ' : '';
147	my $zero_env_opt = $CONFIG{env_zero} ? '' : '-noenvzero ';
148
149	my $opts = "${error_opt}${compress_opt}${allow_tsb_conflicts_opt}".
150	"${allow_duplicate_tags_opt}${zero_env_opt}";
151
152	my $command =
153	"$CONFIG{goldfinger_cmd} ${verbose}-in $goldfinger ".
154	"-gentsbs -genimage -imagefile $image -gensymtab -symtabfile $symtab ".
155	"${opts}-prefix '${Midas::Error::Prg}: '";
156
157	run_command($command, '-pass_errcode');
158
159	if (-e $symtab) {
160	chat "$symtab successfully created.\n";
161	} else {
162	fatal "$symtab could not be generated.\n", M_GENFAIL;
163	}
164
165	if (-e $image) {
166	chat "$image successfully created.\n";
167	} else {
168	fatal "$image could not be generated.\n", M_GENFAIL;
169	}
170
171
172	}
173
174	##############################################################################
175
176	sub generate_events {
177	my $m4file = shift;
178	my $symtab = shift;
179	my $events = shift;
180
181	my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
182
183	$m4file = path_to_build_file($CONFIG{local_m4}, $STATE)
184	unless defined $m4file;
185	$symtab = path_to_build_file($CONFIG{local_symtab}, $STATE)
186	unless defined $symtab;
187	$events = path_to_build_file($CONFIG{local_events}, $STATE)
188	unless defined $events;
189
190	chat "Generating $events...\n";
191
192	chat "Loading symbol table from $symtab.\n", 3;
193	local ($_);
194	my (%vahash, %rahash, %pahash);
195	my $ifh = IO::File->new("<$symtab") or fatal "Can't open $symtab: $!\n",
196	M_FILE;
197	while(<$ifh>) {
198	my ($sym, $va, $ra, $pa) = /([\w_\.]+)\s+(\w+)\s+(\w+)(?:\s+(\w+))/;
199	next unless defined $va && defined $ra;
200	if(not defined $pa) {
201	$pa = $ra;
202	undef $ra;
203	}
204	$vahash{$sym} = $va;
205	$rahash{$sym} = $ra if defined $ra;
206	$pahash{$sym} = $pa;
207	}
208	undef $ifh;
209
210	my $ofh = IO::Pipe->new();
211	my $m4_incs = join ' ', map { "--include=$_"} get_m4_includes();
212	my $command = "$CONFIG{m4_cmd} $m4_incs > $events";
213	$ofh->writer("$command") or
214	fatal "Cannot run m4 to create $events: $!\n", M_GENFAIL;
215
216	$ofh->print("changequote({, })dnl\n");
217
218	my $full_line = "";
219	my $ev_null = 1;
220	my $ev_collect = 0;
221	my $ev_eval = 0;
222
223	$ifh = IO::File->new("<$m4file") or
224	fatal "Can't open file $m4file for reading: $!\n", M_FILE;
225
226
227	CPPFL_LINE:
228	while (<$ifh>) {
229	my ($evline) = /.!\s\$EV\s+(.*)$/;
230	my ($evlinep) = /.!\s\$EV\+\s+(.*)$/;
231
232	# supress warnings
233	$evline = "" unless defined $evline;
234	$evlinep = "" unless defined $evlinep;
235
236	if ($ev_null == 1) {
237	if ($evlinep ne "") {
238	fatal "Error in parsing event $_", M_EVENTERR;
239	}
240	if ($evline ne "") {
241	$ev_null = 0;
242	$ev_collect = 1;
243	$full_line .= $evline;
244	next CPPFL_LINE;
245	}
246	}
247	if ($ev_collect == 1) {
248	if ($evlinep ne "") {
249	$full_line .= $evlinep;
250	}
251	elsif ($evline ne "") {
252	$ev_eval = 1;
253	}
254	else {
255	$ev_eval = 1;
256	$ev_null = 1;
257	$ev_collect = 0;
258	}
259	}
260	if ($ev_eval == 1) {
261	$_ = $full_line;
262	my $va;
263	while (/.\@VA\([\w_\.]\).*$/) {
264	($va) = /VA\(([\w_\.]*)\)/;
265	if (not defined $vahash{$va})
266	{fatal "Error in va address: $_\n", M_EVENTERR;}
267	s/\@VA\([\w_\.]*\)/"0x$vahash{$va}"/e;
268	}
269	while (/.\@RA\([\w_\.]\).*$/) {
270	($va) = /RA\(([\w_\.]*)\)/;
271	if (not defined $rahash{$va})
272	{fatal "Error in ra address: $_\n", M_EVENTERR;}
273	s/\@RA\([\w_\.]*\)/"0x$rahash{$va}"/e;
274	}
275	while (/.\@PA\([\w_\.]\).*$/) {
276	($va) = /PA\(([\w_\.]*)\)/;
277	if (not defined $pahash{$va})
278	{fatal "Error in pa address: $_\n", M_EVENTERR;}
279	s/\@PA\([\w_\.]*\)/"0x$pahash{$va}"/e;
280	}
281	while (/.expr.$/) {
282	s/expr/"{64'h}mpeval"/e;
283	}
284	$ofh->print("$_\n");
285	$ev_eval = 0;
286	$full_line = $evline;
287	}
288	}
289
290	undef $ifh;
291	$ofh->close();
292
293	if($?) {
294	my $status = $?;
295	my $exit = $status >> 8;
296	my $sig = $status & 127;
297	my $core = $status & 128;
298	my $core_msg = $core ? "Dumped core." : "";
299
300	if($sig) {
301	fatal "Command \"$command\" died via signal $sig. $core_msg\n",
302	M_GENFAIL;
303	}
304
305	fatal "Command \"$command\" failed with status $exit. $core_msg\n",
306	M_GENFAIL;
307	}
308
309	undef $ofh;
310
311	if(-e $events) {
312	chat "$events successfully created.\n";
313	} else {
314	fatal "$events could not be generated.\n", M_GENFAIL;
315	}
316	}
317
318	##############################################################################
319	1;