| 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; |