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

# -*- perl -*-

package Midas::Interface;

use strict;
require Exporter;

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

use Getopt::Long;
use File::Spec;
use File::Find;
use File::Basename;
use FindBin '$Bin';
use Cwd;

use Midas::Globals;


use Midas::Command;

use Midas::Error;

# These modules are used, but they are brought in lazily if needed to speed
# up the case where they're not.

#use Midas::Configure;
#use Midas::Assembler;


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

our @Configurable_commands = qw(pal cpp m4 as ld gcc);

sub midas {
  my @argv = @_;

  my $startdir = getcwd;

  eval {

    local (@ARGV) = @argv;

    clear_globals();
    init_error();


    # set defaults
    my %opt =
      (
       h             => 0,
       verbose       => 2,
       stdinc        => 1,
       include_build => 0,
       include_start => 0,
       stddef        => 1,
       E             => 0,
       print_errors  => 1,
       dest_dir      => '.',

#       build_threads  => 3,
       copy_products  => 0,
       gen_all_tsbs   => 0,
      );


    my @options =
      qw(
	 h
	 stdinc!
	 stddef!
	 include_build!
	 include_start!
	 verbose|v:i
	 noverbose|nov
	 version
	 format
	 find
	 find_root=s
	 E
	 I=s@
	 D=s@
	 L=s@
	 C=s@
	 diag_root=s
	 build_dir=s
	 dest_dir=s
	 mmu=s
	 ttefmt=s
	 tsbtagfmt=s
	 cleanup!
	 force_cleanup!
	 force_build|f!
	
	 build_threads=i
	 copy_products!
	 gen_all_tsbs!

	 file=s@

	 start_phase=s
	 phase=s@

	 print_errors!
	 allow_tsb_conflicts!
	 allow_empty_sections!
	 allow_illegal_page_sizes!
	 allow_duplicate_tags!
	 allow_misaligned_tsb_base!
	 compress_image!
	 env_zero!
	 default_radix=s
	 errcode=i
	 pal_diag_args=s@
	 config=s
	 project=s
	);

    foreach my $cmd (@Configurable_commands) {
      my $use_standard_option = "std_${cmd}_args";
      my $args_option         = "${cmd}_args";
      my $cmd_option          = "${cmd}_cmd";
      $opt{$use_standard_option} = 1;  # make standard the default
      push @options,
	"${use_standard_option}!", "${args_option}=s@", "${cmd_option}=s";
    }

    my @save_argv = @ARGV;

    # Make -D and -I options more palatable to GetOptions
    @ARGV = map { /^(-[DILC])(\S.*)/ ? ($1, $2) : $_ } @ARGV;

    GetOptions(\%opt, @options) or fatal("Command-line parsing failed.\n",
					 M_ARGERR);
    usage(-exitval => M_NOERROR, -verbose => 2) if $opt{h};

    if(defined $opt{version} and $opt{version}) {
      print "Location: $0\n";
      print "Version:  $Midas::VERSION\n";
      exit M_NOERROR;
    }

    if(defined $opt{errcode}) {
      my $string = errcode_to_string($opt{errcode});
      print "CODE \"$opt{errcode}\"= $string\n";
      exit M_NOERROR;
    }

    if($opt{print_errors} == 0) {
      suppress_error_messages();
    }

    if(defined $opt{format} and $opt{format}) {
      my $fmt = File::Spec->catfile($Bin, 'midasformat');
      die "Cannot find \"$fmt\"\n" unless -e $fmt;
      system($fmt);
      exit M_NOERROR;
    }


    $opt{verbose} = 0 if defined $opt{noverbose} && $opt{noverbose};

    my $diag = shift @ARGV;
    fatal "No diag specified!\n", M_ARGERR unless defined $diag;

    if(not defined $opt{diag_root}) {
      if(exists $ENV{DV_ROOT} and defined $ENV{DV_ROOT}) {
	$opt{diag_root} = $ENV{DV_ROOT};
      } else {
	bad_arg("No -diag_root specified and DV_ROOT not set!\n");
      }
    }

    $opt{find} = 1 if (defined $opt{find_root} and $opt{find_root} ne '');
    if(defined $opt{find}) {
      my $find_root = (defined $opt{find_root} and $opt{find_root} ne '') ?
	$opt{find_root} : File::Spec->catdir($opt{diag_root}, 'verif', 'diag');
      $diag = find_diag($diag, $find_root);
    }


    if(defined $opt{ttefmt} and $opt{ttefmt} ne 'sun4u' and 
       $opt{ttefmt} ne 'sun4v') {
      bad_arg("Illegal -ttefmt setting.  Legal values are sun4u and sun4v.\n");
    }

    if(defined $opt{tsbtagfmt} and $opt{tsbtagfmt} ne 'tagaccess' and
       $opt{tsbtagfmt} ne 'tagtarget') {
      bad_arg("Illegal -tsbtagfmt setting '$opt{tsbtagfmt}'.  ".
	      "Legal values are tagaccess and tagtarget.\n");
    }

    if(defined $opt{default_radix} and $opt{default_radix} ne 'decimal' and
       $opt{default_radix} ne 'hex') {
      bad_arg("Illegal -default_radix setting.\n".
	      "Legal values are 'decimal' and 'hex'.\n");
    }

    if($opt{project}) {
      $PROJECT = $opt{project};
    }

    if($opt{config}) {
      $CONFIG_FILE = $opt{config};
    }

    my %config_args;
    my @config_list =
      qw(
	 mmu build_dir cleanup force_cleanup force_build allow_tsb_conflicts
	 allow_empty_sections allow_illegal_page_sizes allow_duplicate_tags
	 allow_misaligned_tsb_base env_zero
	 compress_image ttefmt tsbtagfmt default_radix build_threads
	 copy_products gen_all_tsbs verbose
	);
    foreach my $key (@config_list) {
      $config_args{$key} = $opt{$key} if (exists $opt{$key} and
					  defined $opt{$key});
    }
    # special-case.  Config name different from option name
    if(exists $config_args{mmu}) {
      $config_args{mmu_type} = $config_args{mmu};
      delete $config_args{mmu};
    }


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

    # Configure module

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

    my %config;
    # Midas::Configure takes a while to load.  Only use it if necessary
    my $code = q{
		  use Midas::Configure;

		  init_config();

		  %config =
		  Midas::Configure::configure
		  ( %config_args );
		 };

    eval $code;
    die $@ if $@;

    chat "midas @argv\n", 1;


    ### Configure include paths

    if(not $opt{stdinc}) {
      my @build = ($opt{include_build} ? (builddir => ['.']) : ());
      my @start = ($opt{include_start} ? (startdir => ['.']) : ());
      %config =
	Midas::Configure::configure(
				    cpp_includes => { @build, @start },
				    m4_includes  => { @build, @start },
				    c_includes   => { @build, @start },
				   );
    }

    if(defined $opt{I} and @{$opt{I}}) {
      my $cwd = getcwd;
      my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{I}};
      Midas::Configure::add_cpp_includes(@incs);
      Midas::Configure::add_m4_includes(@incs);
    }

    if(defined $opt{L} and @{$opt{L}}) {
      my $cwd = getcwd;
      my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{L}};
      Midas::Configure::add_link_includes(@incs);
    }

    if(defined $opt{C} and @{$opt{C}}) {
      my $cwd = getcwd;
      my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{C}};
      Midas::Configure::add_csrc_includes(@incs);
    }

    if(defined $opt{pal_diag_args}) {
      Midas::Configure::add_pal_diag_args(@{$opt{pal_diag_args}});
    }

    ### Configure defines

    if(not $opt{stddef}) {
      %config =
	Midas::Configure::configure( cpp_defines => [] );
    }

    if(defined $opt{D} and @{$opt{D}}) {
      Midas::Configure::add_cpp_defines(@{$opt{D}});
    }

    ### Configure commands

    foreach my $command (@Configurable_commands) {
      configure_command_options($command,
				$opt{"std_${command}_args"},
				$opt{"${command}_args"},
				$opt{"${command}_cmd"},
				\%config);
    }

    ### Configure file names

    configure_file_names($opt{file}, \%config) if defined $opt{file};

    ###########################################################################
    # Call magic function
    ###########################################################################

    if($opt{E}) {
      push @{$opt{phase}}, qw(setup preprocess);
    }


    $code = q{
	       # Midas::Assembly takes a while to load.  Only parse
	       # it if necessary.
	       use Midas::Assembly;


	       assemble_diag($diag,
			     -dest_dir  => $opt{dest_dir},
			     -diag_root => $opt{diag_root},
			     (map { -phase => $_ } @{$opt{phase}}),
			     (defined $opt{start_phase} ?
			      (-start_phase => $opt{start_phase}) : ()
			     ),
			     -argv => "@argv",
			    );
	      };

    eval $code;
    die $@ if $@;  # Throw up any exceptions to next level handler

  };

  chdir $startdir;

  return handle_error($@);
}
###############################################################################
###############################################################################

sub usage {
  my @args = @_;

  my $code = q{

		use Pod::Usage;

		pod2usage(@args);

	       };

  eval $code;
  die "Can't load Pod::Usage!: $@\n" if $@;
}

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

sub bad_arg {
  my $message = shift;
  fatal $message, M_ARGERR;
}

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

sub configure_command_options {
  my $command      = shift;
  my $use_standard = shift;
  my $add_args     = shift;
  my $cmd_option   = shift;
  my $configref    = shift;

  if(not defined $configref) {
    my %c = Midas::Configure::configure() unless defined $configref;
    $configref = \%c;
  }

  my $opt_config_key = "${command}_opt";
  my $cmd_config_key = "${command}_cmd";

  bad_arg("No such command \"$command\".\n")
    unless exists $configref->{$opt_config_key};

  if(not $use_standard) {
    Midas::Configure::configure($opt_config_key => []);
  }
  if(defined $add_args and @$add_args) {
    Midas::Configure::append_configuration($opt_config_key => $add_args);
  }
  if(defined $cmd_option) {
    Midas::Configure::configure($cmd_config_key => $cmd_option);
  }
}

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

sub configure_file_names {
  my $file_list = shift;
  my $configref = shift;

  if(not defined $configref) {
    my %c = Midas::Configure::configure() unless defined $configref;
    $configref = \%c;
  }

  my @config;
  foreach my $spec (@$file_list) {
    bad_arg("-file argument is tag=name.\n")
      unless $spec =~ /^(\S+)=(\S.*)$/;
    my ($file, $name) = ($1, $2);
    my $config_tag = "local_$file";
    bad_arg("File tag \"$file\" is not a configurable file.\n")
      unless exists $configref->{$config_tag};
    push @config, $config_tag, $name;
  }
  Midas::Configure::configure(@config) if @config;

}

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

sub find_diag {
  my $diag = shift;
  my $root = shift;

  my $diag_base = basename $diag;
  bad_arg("When -find is used, diag \"$diag\" should be a name, ".
	  "not a path.\n") if ($diag ne $diag_base);

  bad_arg("Can't find with root \"$root\": No such directory.\n")
    unless -d $root;

  my $found;
  my $found_ref = \$found;
  my $wanted = sub {
    if($diag_base eq $_) {
      $$found_ref = $File::Find::name;
    }
  };

  find($wanted, $root);

  bad_arg("Could not find file \"$diag\" in root \"$root\".\n")
    unless defined $found;

  return $found;
}

###############################################################################
###############################################################################
1;
Commit	Line	Data
86530b38 AT	1	# -- perl --
	2
	3	package Midas::Interface;
	4
	5	use strict;
	6	require Exporter;
	7
	8	our @ISA = qw(Exporter);
	9	our @EXPORT = qw(midas);
	10
	11	use Getopt::Long;
	12	use File::Spec;
	13	use File::Find;
	14	use File::Basename;
	15	use FindBin '$Bin';
	16	use Cwd;
	17
	18	use Midas::Globals;
	19
	20
	21	use Midas::Command;
	22
	23	use Midas::Error;
	24
	25	# These modules are used, but they are brought in lazily if needed to speed
	26	# up the case where they're not.
	27
	28	#use Midas::Configure;
	29	#use Midas::Assembler;
	30
	31
	32	###############################################################################
	33	###############################################################################
	34
	35	our @Configurable_commands = qw(pal cpp m4 as ld gcc);
	36
	37	sub midas {
	38	my @argv = @_;
	39
	40	my $startdir = getcwd;
	41
	42	eval {
	43
	44	local (@ARGV) = @argv;
	45
	46	clear_globals();
	47	init_error();
	48
	49
	50	# set defaults
	51	my %opt =
	52	(
	53	h => 0,
	54	verbose => 2,
	55	stdinc => 1,
	56	include_build => 0,
	57	include_start => 0,
	58	stddef => 1,
	59	E => 0,
	60	print_errors => 1,
	61	dest_dir => '.',
	62
	63	# build_threads => 3,
	64	copy_products => 0,
65	gen_all_tsbs => 0,
66	);
67
68
69	my @options =
70	qw(
71	h
72	stdinc!
73	stddef!
74	include_build!
75	include_start!
76	verbose\|v:i
77	noverbose\|nov
78	version
79	format
80	find
81	find_root=s
82	E
83	I=s@
84	D=s@
85	L=s@
86	C=s@
87	diag_root=s
88	build_dir=s
89	dest_dir=s
90	mmu=s
91	ttefmt=s
92	tsbtagfmt=s
93	cleanup!
94	force_cleanup!
95	force_build\|f!
96
97	build_threads=i
98	copy_products!
99	gen_all_tsbs!
100
101	file=s@
102
103	start_phase=s
104	phase=s@
105
106	print_errors!
107	allow_tsb_conflicts!
108	allow_empty_sections!
109	allow_illegal_page_sizes!
110	allow_duplicate_tags!
111	allow_misaligned_tsb_base!
112	compress_image!
113	env_zero!
114	default_radix=s
115	errcode=i
116	pal_diag_args=s@
117	config=s
118	project=s
119	);
120
121	foreach my $cmd (@Configurable_commands) {
122	my $use_standard_option = "std_${cmd}_args";
123	my $args_option = "${cmd}_args";
124	my $cmd_option = "${cmd}_cmd";
125	$opt{$use_standard_option} = 1; # make standard the default
126	push @options,
127	"${use_standard_option}!", "${args_option}=s@", "${cmd_option}=s";
128	}
129
130	my @save_argv = @ARGV;
131
132	# Make -D and -I options more palatable to GetOptions
133	@ARGV = map { /^(-[DILC])(\S.*)/ ? ($1, $2) : $_ } @ARGV;
134
135	GetOptions(\%opt, @options) or fatal("Command-line parsing failed.\n",
136	M_ARGERR);
137	usage(-exitval => M_NOERROR, -verbose => 2) if $opt{h};
138
139	if(defined $opt{version} and $opt{version}) {
140	print "Location: $0\n";
141	print "Version: $Midas::VERSION\n";
142	exit M_NOERROR;
143	}
144
145	if(defined $opt{errcode}) {
146	my $string = errcode_to_string($opt{errcode});
147	print "CODE \"$opt{errcode}\"= $string\n";
148	exit M_NOERROR;
149	}
150
151	if($opt{print_errors} == 0) {
152	suppress_error_messages();
153	}
154
155	if(defined $opt{format} and $opt{format}) {
156	my $fmt = File::Spec->catfile($Bin, 'midasformat');
157	die "Cannot find \"$fmt\"\n" unless -e $fmt;
158	system($fmt);
159	exit M_NOERROR;
160	}
161
162
163	$opt{verbose} = 0 if defined $opt{noverbose} && $opt{noverbose};
164
165	my $diag = shift @ARGV;
166	fatal "No diag specified!\n", M_ARGERR unless defined $diag;
167
168	if(not defined $opt{diag_root}) {
169	if(exists $ENV{DV_ROOT} and defined $ENV{DV_ROOT}) {
170	$opt{diag_root} = $ENV{DV_ROOT};
171	} else {
172	bad_arg("No -diag_root specified and DV_ROOT not set!\n");
173	}
174	}
175
176	$opt{find} = 1 if (defined $opt{find_root} and $opt{find_root} ne '');
177	if(defined $opt{find}) {
178	my $find_root = (defined $opt{find_root} and $opt{find_root} ne '') ?
179	$opt{find_root} : File::Spec->catdir($opt{diag_root}, 'verif', 'diag');
180	$diag = find_diag($diag, $find_root);
181	}
182
183
184
185	if(defined $opt{ttefmt} and $opt{ttefmt} ne 'sun4u' and
186	$opt{ttefmt} ne 'sun4v') {
187	bad_arg("Illegal -ttefmt setting. Legal values are sun4u and sun4v.\n");
188	}
189
190	if(defined $opt{tsbtagfmt} and $opt{tsbtagfmt} ne 'tagaccess' and
191	$opt{tsbtagfmt} ne 'tagtarget') {
192	bad_arg("Illegal -tsbtagfmt setting '$opt{tsbtagfmt}'. ".
193	"Legal values are tagaccess and tagtarget.\n");
194	}
195
196	if(defined $opt{default_radix} and $opt{default_radix} ne 'decimal' and
197	$opt{default_radix} ne 'hex') {
198	bad_arg("Illegal -default_radix setting.\n".
199	"Legal values are 'decimal' and 'hex'.\n");
200	}
201
202	if($opt{project}) {
203	$PROJECT = $opt{project};
204	}
205
206	if($opt{config}) {
207	$CONFIG_FILE = $opt{config};
208	}
209
210	my %config_args;
211	my @config_list =
212	qw(
213	mmu build_dir cleanup force_cleanup force_build allow_tsb_conflicts
214	allow_empty_sections allow_illegal_page_sizes allow_duplicate_tags
215	allow_misaligned_tsb_base env_zero
216	compress_image ttefmt tsbtagfmt default_radix build_threads
217	copy_products gen_all_tsbs verbose
218	);
219	foreach my $key (@config_list) {
220	$config_args{$key} = $opt{$key} if (exists $opt{$key} and
221	defined $opt{$key});
222	}
223	# special-case. Config name different from option name
224	if(exists $config_args{mmu}) {
225	$config_args{mmu_type} = $config_args{mmu};
226	delete $config_args{mmu};
227	}
228
229
230	###########################################################################
231
232	# Configure module
233
234	###########################################################################
235
236	my %config;
237	# Midas::Configure takes a while to load. Only use it if necessary
238	my $code = q{
239	use Midas::Configure;
240
241	init_config();
242
243	%config =
244	Midas::Configure::configure
245	( %config_args );
246	};
247
248	eval $code;
249	die $@ if $@;
250
251	chat "midas @argv\n", 1;
252
253
254	### Configure include paths
255
256	if(not $opt{stdinc}) {
257	my @build = ($opt{include_build} ? (builddir => ['.']) : ());
258	my @start = ($opt{include_start} ? (startdir => ['.']) : ());
259	%config =
260	Midas::Configure::configure(
261	cpp_includes => { @build, @start },
262	m4_includes => { @build, @start },
263	c_includes => { @build, @start },
264	);
265	}
266
267	if(defined $opt{I} and @{$opt{I}}) {
268	my $cwd = getcwd;
269	my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{I}};
270	Midas::Configure::add_cpp_includes(@incs);
271	Midas::Configure::add_m4_includes(@incs);
272	}
273
274	if(defined $opt{L} and @{$opt{L}}) {
275	my $cwd = getcwd;
276	my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{L}};
277	Midas::Configure::add_link_includes(@incs);
278	}
279
280	if(defined $opt{C} and @{$opt{C}}) {
281	my $cwd = getcwd;
282	my @incs = map { File::Spec->rel2abs($_, $cwd) } @{$opt{C}};
283	Midas::Configure::add_csrc_includes(@incs);
284	}
285
286	if(defined $opt{pal_diag_args}) {
287	Midas::Configure::add_pal_diag_args(@{$opt{pal_diag_args}});
288	}
289
290	### Configure defines
291
292	if(not $opt{stddef}) {
293	%config =
294	Midas::Configure::configure( cpp_defines => [] );
295	}
296
297	if(defined $opt{D} and @{$opt{D}}) {
298	Midas::Configure::add_cpp_defines(@{$opt{D}});
299	}
300
301	### Configure commands
302
303	foreach my $command (@Configurable_commands) {
304	configure_command_options($command,
305	$opt{"std_${command}_args"},
306	$opt{"${command}_args"},
307	$opt{"${command}_cmd"},
308	\%config);
309	}
310
311	### Configure file names
312
313	configure_file_names($opt{file}, \%config) if defined $opt{file};
314
315	###########################################################################
316	# Call magic function
317	###########################################################################
318
319	if($opt{E}) {
320	push @{$opt{phase}}, qw(setup preprocess);
321	}
322
323
324	$code = q{
325	# Midas::Assembly takes a while to load. Only parse
326	# it if necessary.
327	use Midas::Assembly;
328
329
330	assemble_diag($diag,
331	-dest_dir => $opt{dest_dir},
332	-diag_root => $opt{diag_root},
333	(map { -phase => $_ } @{$opt{phase}}),
334	(defined $opt{start_phase} ?
335	(-start_phase => $opt{start_phase}) : ()
336	),
337	-argv => "@argv",
338	);
339	};
340
341	eval $code;
342	die $@ if $@; # Throw up any exceptions to next level handler
343
344	};
345
346	chdir $startdir;
347
348	return handle_error($@);
349	}
350	###############################################################################
351	###############################################################################
352
353	sub usage {
354	my @args = @_;
355
356	my $code = q{
357
358	use Pod::Usage;
359
360	pod2usage(@args);
361
362	};
363
364	eval $code;
365	die "Can't load Pod::Usage!: $@\n" if $@;
366	}
367
368	###############################################################################
369
370	sub bad_arg {
371	my $message = shift;
372	fatal $message, M_ARGERR;
373	}
374
375	##############################################################################
376
377	sub configure_command_options {
378	my $command = shift;
379	my $use_standard = shift;
380	my $add_args = shift;
381	my $cmd_option = shift;
382	my $configref = shift;
383
384	if(not defined $configref) {
385	my %c = Midas::Configure::configure() unless defined $configref;
386	$configref = \%c;
387	}
388
389	my $opt_config_key = "${command}_opt";
390	my $cmd_config_key = "${command}_cmd";
391
392	bad_arg("No such command \"$command\".\n")
393	unless exists $configref->{$opt_config_key};
394
395	if(not $use_standard) {
396	Midas::Configure::configure($opt_config_key => []);
397	}
398	if(defined $add_args and @$add_args) {
399	Midas::Configure::append_configuration($opt_config_key => $add_args);
400	}
401	if(defined $cmd_option) {
402	Midas::Configure::configure($cmd_config_key => $cmd_option);
403	}
404	}
405
406	##############################################################################
407
408	sub configure_file_names {
409	my $file_list = shift;
410	my $configref = shift;
411
412	if(not defined $configref) {
413	my %c = Midas::Configure::configure() unless defined $configref;
414	$configref = \%c;
415	}
416
417	my @config;
418	foreach my $spec (@$file_list) {
419	bad_arg("-file argument is tag=name.\n")
420	unless $spec =~ /^(\S+)=(\S.*)$/;
421	my ($file, $name) = ($1, $2);
422	my $config_tag = "local_$file";
423	bad_arg("File tag \"$file\" is not a configurable file.\n")
424	unless exists $configref->{$config_tag};
425	push @config, $config_tag, $name;
426	}
427	Midas::Configure::configure(@config) if @config;
428
429	}
430
431	##############################################################################
432
433	sub find_diag {
434	my $diag = shift;
435	my $root = shift;
436
437	my $diag_base = basename $diag;
438	bad_arg("When -find is used, diag \"$diag\" should be a name, ".
439	"not a path.\n") if ($diag ne $diag_base);
440
441	bad_arg("Can't find with root \"$root\": No such directory.\n")
442	unless -d $root;
443
444	my $found;
445	my $found_ref = \$found;
446	my $wanted = sub {
447	if($diag_base eq $_) {
448	$$found_ref = $File::Find::name;
449	}
450	};
451
452	find($wanted, $root);
453
454	bad_arg("Could not find file \"$diag\" in root \"$root\".\n")
455	unless defined $found;
456
457	return $found;
458	}
459
460	###############################################################################
461	###############################################################################
462	1;