Initial commit of OpenSPARC T2 design and verification files.
[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Midas_samy / Assembly.pm
# -*- perl -*-
package Midas::Assembly;
use strict;
use warnings;
use File::Copy;
use File::Spec;
use Getopt::Long;
use Cwd;
use IO::File;
use File::Basename;
use Tie::IxHash;
use Midas::Setup ':all';
use Midas::Preprocess ':all';
use Midas::State;
use Midas::Globals;
use Midas::Configure;
use Midas::Paths;
use Midas::Command;
use Midas::PostProcessing ':asm';
use Midas::Error;
use Midas::Segment;
use Midas::Section;
use Midas::TSB;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(assemble_diag);
our @EXPORT_OK = qw();
our %EXPORT_TAGS =
(
'all' => [
@{$Midas::Setup::EXPORT_TAGS{all}},
@{$Midas::Preprocess::EXPORT_TAGS{all}},
qw(
create_sections
assemble_sections
create_sections
write_linker_scripts
),
],
internals => [ qw(
setup_files
preprocess
create_sections
assemble_sections
assembly_cleanup
create_sections
write_linker_scripts
),
@{$Midas::Setup::EXPORT_TAGS{internals}},
@{$Midas::Preprocess::EXPORT_TAGS{internals}}
],
);
Exporter::export_ok_tags('internals', 'all');
our @Options = qw(
start_dir=s
dest_dir=s
diag_root=s
phase=s@
start_phase=s
state=s
argv=s
);
##############################################################################
sub assemble_diag {
my @args = @_;
my %opt = (
);
local (@ARGV) = @args;
GetOptions(\%opt, @Options) or
fatal "Error in arguments to assemble_diag!\n", M_ARGERR;
init_section();
my %phases;
tie %phases, 'Tie::IxHash';
%phases =
(
setup => 1,
preprocess => 1,
sectioning => 1,
assemble => 1,
link => 1,
postprocess => 1,
copydest => 1,
cleanup => 1,
);
if(exists $opt{phase} and defined $opt{phase}) {
foreach my $key (keys %phases) {
$phases{$key} = 0;
}
foreach my $phase (@{$opt{phase}}) {
fatal "No such phase $phase!\n", M_ARGERR
unless exists $phases{$phase};
$phases{$phase} = 1;
}
$CONFIG{force_build} = 1;
}
if(exists $opt{start_phase} and defined $opt{start_phase}) {
fatal "No such phase $opt{start_phase}!\n", M_ARGERR
unless exists $phases{$opt{start_phase}};
foreach my $phase (keys %phases) {
last if $phase eq $opt{start_phase};
$phases{$phase} = 0;
}
$CONFIG{force_build} = 1;
}
if(exists $opt{state} and defined $opt{state}) {
my $state = $opt{state};
fatal "State argument isn't a Midas::State object!\n", M_ARGERR unless
(ref $state) && $state->isa('Midas::State');
if(exists $opt{start_dir} and defined $opt{start_dir}) {
chat "WARNING: -start_dir ignored when -state is also present.\n"
}
if(exists $opt{dest_dir} and defined $opt{dest_dir}) {
chat "WARNING: -dest_dir ignored when -state is also present.\n"
}
if(exists $opt{diag_root} and defined $opt{diag_root}) {
chat "WARNING: -diag_root ignored when -state is also present.\n"
}
$STATE = $state
} else {
$opt{start_dir} = getcwd unless defined $opt{start_dir};
$opt{dest_dir} = getcwd unless defined $opt{dest_dir};
$opt{diag_root} = $ENV{DV_ROOT} unless defined $opt{diag_root};
$STATE =
init_state($opt{diag_root}, $opt{start_dir}, $opt{dest_dir});
}
my $diag = shift @ARGV;
fatal "No diag specified to assemble_diag!\n", M_ARGERR
unless defined $diag;
chat "Running from $0\n", 2;
my $argsfile = path_to_build_file($CONFIG{local_cmdfile}, $STATE);
my $oldargsfile = path_to_build_file($CONFIG{local_oldcmdfile}, $STATE);
my $m4file = path_to_build_file($CONFIG{local_m4}, $STATE);
my $oldm4file = path_to_build_file($CONFIG{local_oldm4}, $STATE);
unlink $oldargsfile if -e $oldargsfile;
unlink $oldm4file if -e $oldm4file;
move $argsfile, $oldargsfile if -e $argsfile;
move $m4file, $oldm4file if -e $m4file;
my $skip_build = 0;
setup_files($diag) if $phases{setup};
# Recompute these after setup since cwd has probably changed
$argsfile = path_to_build_file($CONFIG{local_cmdfile}, $STATE);
$oldargsfile = path_to_build_file($CONFIG{local_oldcmdfile}, $STATE);
$m4file = path_to_build_file($CONFIG{local_m4}, $STATE);
$oldm4file = path_to_build_file($CONFIG{local_oldm4}, $STATE);
if($opt{argv}) {
my $ofh = IO::File->new(">$argsfile") or
fatal "Can't open '$argsfile': $!\n", M_FILE;
print $ofh "midas $opt{argv}\n";
undef $ofh;
}
preprocess() if $phases{preprocess};
if((!$CONFIG{force_build}) and
(-e $oldargsfile) and
(-e $oldm4file) and
(-e $argsfile) and
(are_files_same($oldargsfile, $argsfile)) and
(are_files_same($oldm4file, $m4file)))
{
my @req_source_files = map { expand_product_file($_) }
@{$CONFIG{product_files}{required}};
my @opt_source_files = map { expand_product_file($_) }
@{$CONFIG{product_files}{optional}};
my $have_sources = 1;
foreach my $req_source (@req_source_files) {
next if $req_source =~ /\*/;
$have_sources &&= (-e $req_source);
}
if($have_sources) {
# Want to get the right exe files. Big hack here. Create
# some application objects so that the copy phase will work correctly.
my @app_lines =
`$CONFIG{perl_cmd} -n -e 'print if /^\\s*APPLICATION/' $m4file`;
if($@) {
# Can't get app lines. Oh well, just build normally.
} else {
my @apps;
my $has_default = 0;
foreach my $app_line (@app_lines) {
if($app_line =~ /^\s*APPLICATION\s*(\S+)/) {
my $name = $1;
$has_default = 1 if $name eq 'default';
push @apps, $name;
}
}
push @apps, 'default' unless $has_default;
foreach my $app (@apps) {
my $appobj = Midas::Application->new(name => $app);
$STATE->{apps}{$app} = $appobj;
}
chat "Same args, same input, old products still exist. ".
"My work here is done.\n", 1;
$skip_build = 1;
}
}
}
$STATE->skipping_build($skip_build);
if(not $skip_build) {
my @product_files = map { expand_product_file($_) }
@{$CONFIG{product_files}{clean}};
if(@product_files) {
my $files_string = join ' ', @product_files;
run_command("rm -f $files_string", -errcode => M_FILE);
}
my $gf_version = `$CONFIG{goldfinger_cmd} -version`;
chomp $gf_version;
if($?) {
fatal "Can't find a working version of goldfinger!\n", M_GOLDFINGERMISC;
}
if($gf_version < $CONFIG{goldfinger_version}) {
my $v = $CONFIG{goldfinger_version};
fatal "This version of midas requires at least \n".
"version $v of goldfinger.\n".
"Found version $gf_version.\n", M_GOLDFINGERMISC;
}
create_sections() if $phases{sectioning};
assemble_sections() if $phases{assemble};
link_diag() if $phases{link};
postprocess_assembly() if $phases{postprocess};
}
copy_dest_files() if $phases{copydest};
cd $STATE->get_start_dir;
assembly_cleanup() if $phases{cleanup};
}
##############################################################################
sub are_files_same {
my $file1 = shift;
my $file2 = shift;
my $cmd = "$CONFIG{diff_cmd} $file1 $file2 > /dev/null 2>&1";
my $waitstatus = system($cmd);
my $exitstatus = $waitstatus >> 8;
return 1 if !$exitstatus;
return 0 if ($exitstatus == 1);
fatal "Command '$cmd' failed with status $exitstatus.\n", M_CMDFAIL;
}
##############################################################################
sub expand_product_file {
my $configname = shift;
return path_to_build_file($CONFIG{$configname}, $STATE);
}
##############################################################################
sub expand_for_apps {
my $filename = shift;
return ($filename) unless $filename =~ /\*/;
my @list;
foreach my $app (keys %{$STATE->{apps}}) {
my $file = $STATE->{apps}{$app}->expand_file($filename);
if($STATE->skipping_build and $app eq 'default'
and not -e $file)
{
next;
}
push @list, $STATE->{apps}{$app}->expand_file($filename);
}
return @list;
}
##############################################################################
sub copy_dest_files {
local ($_);
my @req_source_files = map { expand_product_file($_) }
@{$CONFIG{product_files}{required}};
my @opt_source_files = map { expand_product_file($_) }
@{$CONFIG{product_files}{optional}};
@req_source_files = map { expand_for_apps($_); } @req_source_files;
@opt_source_files = map { expand_for_apps($_); } @opt_source_files;
my %file_importance;
foreach my $req_src (@req_source_files) {
$file_importance{$req_src} = 'required';
}
foreach my $opt_src (@opt_source_files) {
$file_importance{$opt_src} = 'optional';
}
my @src_files = (@req_source_files, @opt_source_files);
my $dest_dir = $STATE->get_dest_dir();
return if $dest_dir eq '.';
banner "COPY PHASE";
my @dest_files = map { File::Spec->catfile($dest_dir, basename $_) }
@src_files;
my $dest_files = join ' ', @dest_files;
run_command("rm -f $dest_files") if @dest_files;
foreach my $src (@src_files) {
if(-e $src) {
if($CONFIG{copy_products}) {
chat "Copying $src to '$dest_dir'.\n", 2;
copy $src, $dest_dir or
fatal "Could not copy $src to '$dest_dir': $!\n", M_FILE;
} else {
chat "Hard linking $src to '$dest_dir'.\n", 2;
my $dest_file = File::Spec->catfile($dest_dir, basename $src);
if(not link($src, $dest_file)) {
chat "Hard linking of $src failed. Copying instead.\n", 2;
copy $src, $dest_dir or
fatal "Could not copy $src to '$dest_dir': $!\n", M_FILE;
}
}
} else {
if($file_importance{$src} ne 'optional') {
fatal "$src does not exist in build dir!\n";
}
}
}
}
##############################################################################
sub assembly_cleanup {
return unless $CONFIG{cleanup};
banner "CLEANUP PHASE";
if($STATE->get_created_build_dir() or $CONFIG{force_cleanup}) {
my $build_dir = $STATE->get_build_dir();
if($build_dir eq '.') {
chat "Build directory is the same as start directory. Can't remove.\n";
} else {
run_command("rm -rf " . $STATE->get_build_dir());
}
} else {
chat "Build directory already existed, so not removing it.\n";
}
}
##############################################################################
sub create_sections {
my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
banner "SECTION PARSING PHASE";
my $mmu = $STATE->get_mmu();
my $m4file = path_to_build_file($CONFIG{local_m4}, $STATE);
my $directives = path_to_build_file($CONFIG{local_directives}, $STATE);
my $verbose = ($CONFIG{verbose} == 0) ? '-silent ' :
($CONFIG{verbose} == 2) ? '-v ' : '';
my $error_opt = $Midas::Error::Print_Errors ? '' : '-noprint_errors ';
run_command("$CONFIG{goldfinger_cmd} ${verbose}-splitsec $m4file ".
"-midasfile $directives ${error_opt}".
"-prefix '${Midas::Error::Prg}: '",
'-pass_errcode',
);
my (%sections, %section_count);
my (%tsbs,%tsblinks );
tie %tsbs, 'Tie::IxHash';
tie %tsblinks, 'Tie::IxHash';
local ($_);
my ($ifh, $ofh);
my ($smartlines, $srcfile, $srcline);
my $num_secs = 0;
my $app = Midas::Application->new(name => 'default');
$STATE->{apps}{$app->name()} = $app;
chat "Finding sections in $directives\n";
# First pass, create sections first so attr_ blocks can reference them
$ifh = IO::File->new("<$directives") or
fatal "Can't open $directives: $!\n", M_FILE;
$smartlines = 0;
$srcfile = $m4file;
$srcline = 0;
my %apps;
my $appname = lc $app->name();
my $first_appname = $appname;
while(<$ifh>) {
if(/^\#\s*(?:line\s*)?(\d+)\s+\"(.*)\"/) {
$srcline = $1 - 1;
$srcfile = $2;
$smartlines = 1;
} else {
$srcline++;
}
while($_ =~ /\\$/) {
$_ =~ s/\\\n$/ /;
$_ .= <$ifh>;
$srcline++;
}
if(/^\s*APPLICATION\s*(\S+)\s*(.*)?$/) {
my $name = $1;
my $args = $2;
$app = Midas::Application->new(name => $name,
srcfile => $srcfile,
srcline => $srcline,
args => $args,
);
$appname = lc $name;
if(exists $apps{$appname}) {
fatal
"App '$appname' already exists at file=$srcfile, line=$srcline!\n",
M_APPSYNTAX;
}
$apps{$appname} = $app;
$STATE->{apps}{$name} = $app;
}
if(/^\s*goldfinger_cmd\s*\{/) {
my $string = $_;
$string =~ s/^\s*goldfinger_cmd\s*\{//;
if($string =~ /\}/) {
$string =~ s/\}//;
} else {
while(<$ifh>) {
if(/^\#\s*(?:line\s*)?(\d+)\s+\"(.*)\"/) {
$srcline = $1 - 1;
$srcfile = $2;
$smartlines = 1;
} else {
$srcline++;
}
my $line = $_;
if($line =~ s/\}//) {
$string .= $line;
last;
} else {
$string .= $line;
}
}
}
$app->add_goldfinger_cmd($string);
}
if(/^\s*SECTION\s+(\S+)/) {
my $name = lc $1;
if(not exists $sections{$appname}{$name}) {
my $section = Midas::Section->new_from_line($_, $ifh,
$srcfile, $srcline,
$app);
$app->add_section($section);
$srcfile = $section->{srcfile};
$srcline = $section->{srclinestop};
$name = lc $section->{name};
$sections{$appname}{$name} = $section;
$num_secs++;
} elsif(/^\s*SECTION\s+(\S+)\s+(\S.*)/) {
fatal "SECTION '$1' declared more than once has arguments. \n".
"Arguments only permitted for the initial declaration.\n".
"file=$srcfile, line=$srcline.\n", M_SECSYNTAX;
}
$section_count{$appname}{$name} = []
unless exists $section_count{$appname}{$name};
push @{$section_count{$appname}{$name}}, {
srcfile => $srcfile,
srcline => $srcline,
};
}
if(/^\s*MIDAS_TSB\s+(\S+)/) {
my $tsbname = lc $1;
if(not exists $tsbs{$tsbname}) {
# my $tsb = Midas::TSB->new_from_line($_, $ifh,
# $srcfile, $srcline, $mmu);
my $tsb = $mmu->create_tsb_object_from_line($_, $ifh,
$srcfile, $srcline);
$srcfile = $tsb->{srcfilestop};
$srcline = $tsb->{srclinestop};
$tsbs{$tsbname} = $tsb;
} else {
fatal "Tsb '$tsbname' declared twice!\n".
" First time, file=$tsbs{$tsbname}{srcfile}, ".
"line=$tsbs{$tsbname}{srcline}\n".
" Second time, file=$srcfile, line=$srcline.\n", M_TSBSYNTAX;
}
} elsif(/^\s*MIDAS_TSB_LINK\s+(\S+)/) {
my $tsblinkname = lc $1;
if(not exists $tsblinks{$tsblinkname}) {
# my $tsblink = Midas::TSBLink->new_from_line($_, $ifh,
# $srcfile, $srcline,
# $mmu);
my $tsblink = $mmu->create_tsb_link_object_from_line($_, $ifh,
$srcfile,
$srcline);
$srcfile = $tsblink->{srcfilestop};
$srcline = $tsblink->{srclinestop};
$tsblinks{$tsblinkname} = $tsblink;
} else {
fatal "Tsb_link '$tsblinkname' declared twice!\n".
" First time, file=$tsblinks{$tsblinkname}{srcfile}, ".
"line=$tsblinks{$tsblinkname}{srcline}\n".
" Second time, file=$srcfile, line=$srcline.\n", M_TSBSYNTAX;
}
}
}
undef $ifh;
foreach my $tsbname (keys %tsbs) {
my $linkname = $tsbs{$tsbname}->get_tsblinkname();
if(defined $linkname) {
$linkname = lc $linkname;
if(exists $tsblinks{$linkname}) {
$tsbs{$tsbname}->set_tsblinkobj($tsblinks{$linkname});
} else {
fatal "TSB '$tsbname' has link area '$linkname', which is".
" undefined!\n".
" at file=$tsbs{$tsbname}{srcfile}, ".
"line=$tsbs{$tsbname}{srcline}", M_TSBSYNTAX;
}
}
$MapAttr_Settable{$tsbname} = 1;
}
$STATE->{tsbs} = \%tsbs;
$STATE->{tsblinks} = \%tsblinks;
if(!$num_secs) {
fatal "Diag contains no SECTION directives!\n", M_NOSEC;
}
chat "Processing directives in $directives\n";
# Pass 2, create attr_blocks
$srcfile = $m4file;
$srcline = 0;
$ifh = IO::File->new("<$directives") or die "Can't open $directives: $!\n";
my %opened_sec;
my @linebuf;
my @sections;
my $current_section;
my $current_appname = $first_appname;
while(<$ifh>) {
if(/^\#\s*(?:line\s*)?(\d+)\s+\"(.*)\"/) {
$srcline = $1 - 1;
$srcfile = $2;
$smartlines = 1;
} else {
$srcline++;
}
while($_ =~ /\\$/) {
$_ =~ s/\\\n$/ /;
$_ .= <$ifh>;
$srcline++;
}
if(/^\s*APPLICATION\s+(\S+)/) {
my $appname = lc $1;
$current_appname = $appname;
}
if(/^\s*SECTION\s+(\S+)/) {
my $secname = lc $1;
my $section = $sections{$current_appname}{$secname};
$current_section = $section;
my $rec = shift @{$section_count{$current_appname}{$secname}};
$srcfile = $rec->{srcfile};
$srcline = $rec->{srcline};
if(not $opened_sec{$current_appname}{$secname}) {
push @sections, $section;
}
$opened_sec{$current_appname}{$secname} = 1;
my $nextline = $srcline + 1;
next;
} # end if /^SECTION/
if(/^\s*attr_(\S+)\s*\{/) {
my $attrs = $mmu->parse_section_attrs($_, $ifh,
$srcline, $srcfile);
$_ = "\n";
($srcfile, $srcline) = $attrs->get_end_file_line();
my $secname = $attrs->get_section_name();
$attrs->attr_fatal("attr block does not define a section!\n", M_NOSEC)
unless defined $secname && $secname =~ /\S/;
fatal "Attribute spec for section \"$secname\" but no such section.\n".
"File=$srcfile, Line=$srcline\n", M_MISSINGPARAM
unless exists $sections{$current_appname}{$secname};
my $section = $sections{$current_appname}{$secname};
$attrs->secobj($section);
$section->add_attrs($attrs);
}
if(/^\s*MIDAS_CC\s*(.*?)\s*$/) {
fatal "MIDAS_CC directive outside any section at line=$srcline, ".
"file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $current_section;
$current_section->parse_midas_cc_line($1, $srcline, $srcfile);
$_= "\n";
}
if(/^\s*MIDAS_OBJ\s*(.*?)\s*$/) {
fatal "MIDAS_OBJ directive outside any section at line=$srcline, ".
"file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $current_section;
$current_section->parse_midas_obj_line($1, $srcline, $srcfile);
$_= "\n";
}
if(/^\s*MIDAS_LIB\s*(.*?)\s*$/) {
fatal "MIDAS_LIB directive outside any section at line=$srcline, ".
"file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $current_section;
$current_section->parse_midas_lib_line($1, $srcline, $srcfile);
$_= "\n";
}
}
chat "Performing sanity check on arguments.\n";
my @errors;
foreach my $section (@sections) {
# Do error checking
push @errors, $section->sanity_check();
}
if(@errors) {
my $errorcode = $errors[0]{code};
my $message = join "\n", map { $_->{message} } @errors;
fatal $message, $errorcode;
}
foreach my $appname (keys %{$STATE->{apps}}) {
delete $STATE->{apps}{$appname} if $STATE->{apps}{$appname}->is_blank();
}
foreach my $s (@sections) {
$s->print_debug();
}
}
##############################################################################
sub write_linker_scripts {
my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
# mmu must exist or we never would have been able to create sections
foreach my $app (keys %{$STATE->{apps}}) {
next if $STATE->{apps}{$app}->is_linked();
my @sec_list = $STATE->{apps}{$app}->get_sec_list();
my $script_name = $STATE->{apps}{$app}->ldscr_name();
my $script = path_to_build_file($script_name, $STATE);
chat "Writing linker script $script.\n";
my $ofh = IO::File->new(">$script") or die "Can't open $script: $!\n";
$ofh->print("SECTIONS {\n");
foreach my $sec (@sec_list) {
my $link_attrs = [$sec->get_link_attrs()]->[0];
my @olist = map { basename $_ } $sec->get_object_list();
my @alist = map { basename $_ } $sec->get_library_list(); #libs after .o
push @olist, @alist;
foreach my $seg (Midas::Segment->all_names()) {
if ($link_attrs->has_segment($seg)) {
my $linkname = $sec->get_segment_link_name($seg);
my $elfname = Midas::Segment->name2elf_name($seg);
my $filespec = join " ", map { "$_ ($elfname)" } @olist;
my $addrspec = $link_attrs->get_segment_va($seg) . " :";
$ofh->print("$linkname $addrspec { $filespec }\n");
}
}
}
$ofh->print("}\n");
undef $ofh;
}
}
##############################################################################
sub assemble_sections {
banner "ASSEMBLY PHASE";
foreach my $app_name (keys %{$STATE->{apps}}) {
my $app = $STATE->{apps}{$app_name};
my @sections = $app->get_sec_list();
build_sections(\@sections) if @sections;
}
}
##############################################################################
sub build_sections {
my $seclist = shift;
my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
my $num_threads = $CONFIG{build_threads};
$num_threads = 1 if $num_threads < 1;
my $num_sections = @$seclist;
return unless $num_sections;
$num_threads = $num_sections if $num_sections < $num_threads;
my $sec_pl = ($num_sections > 1) ? 's' : '';
my $thd_pl = ($num_threads > 1) ? 's' : '';
chat "Building $num_sections section$sec_pl using $num_threads ".
"build thread$thd_pl.\n";
if($num_threads == 1) {
foreach my $section (@$seclist) {
$section->build();
}
} else {
my @thread_sections;
my $num_section = -1;
foreach my $section (@$seclist) {
$num_section++;
my $thread = $num_section % $num_threads;
$thread_sections[$thread] = [] unless defined $thread_sections[$thread];
push @{$thread_sections[$thread]}, $section;
}
my $parent_thread = 0;
my $my_thread = 0;
my @child_pids;
my $threads_to_spawn = $num_threads - 1;
my $next_thread = $my_thread + 1;
while($threads_to_spawn) {
my $pid;
if($pid = fork()) {
$next_thread++;
$threads_to_spawn--;
push @child_pids, $pid;
# parent
} elsif(defined $pid) {
$my_thread = $next_thread;
last;
} else {
fatal "Cannot fork thread $next_thread: $!\n", M_CODE;
}
}
chat "Build thread $my_thread is alive!\n", 3;
foreach my $section (@{$thread_sections[$my_thread]}) {
chat "Building section $section->{name} on thread $my_thread\n", 3;
$section->build();
}
if($my_thread != 0) {
exit(0);
}
if(@child_pids) {
foreach my $pid (@child_pids) {
my $waitval;
my $waitstatus;
while() {
$waitval = waitpid($pid, 0);
if($waitval == -1) {
$waitstatus = 0;
last;
} elsif($waitval == 0) {
$waitstatus = 0;
last;
} else {
$waitval = $pid;
$waitstatus = $?;
last;
}
};
my $status = $waitstatus >> 8;
# Child thread has died with nonzero status
if($status != 0) {
my $waitstatus_hex = sprintf "%x", $waitstatus;
fatal "Build thread with pid=$pid died with status $status ".
"(waitstauts=0x$waitstatus_hex).\n", $status;
}
}
}
}
}
##############################################################################
sub link_diag {
my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
banner "LINK PHASE";
write_linker_scripts();
foreach my $app (keys %{$STATE->{apps}}) {
my $appobj = $STATE->{apps}{$app};
next if $appobj->is_linked();
my $ldscript_name = $appobj->ldscr_name();
my $exe_name = $appobj->exe_name();
my $ldscript = path_to_build_file($ldscript_name, $STATE);
my $exe = path_to_build_file($exe_name, $STATE);
my $args = join ' ', @{$CONFIG{ld_opt}};
run_command("$CONFIG{ld_cmd} $args -T $ldscript -o $exe",
-errcode => M_LINKFAIL
);
if(-e $exe) {
chat "$exe successfully created.\n";
} else {
fatal "$exe could not be generated.\n", M_LINKFAIL;
}
}
}
##############################################################################
1;