[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Midas / 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

	 addphdr!	

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