use Midas
::Preprocess
':internals';
use TRELoad
'BitFieldTie';
our @EXPORT = qw(init_section);
##############################################################################
##############################################################################
$this = fields
::new
($this);
foreach my $key (keys %args) {
$this->{$key} = $args{$key};
##############################################################################
my $srcfile_start = $srcfile;
my $srcline_start = $srcline;
my $mmu = $STATE->get_mmu();
fatal
"Badly formatted SECTION line=$srcline, file=$srcfile:\n$_",
M_SECSYNTAX
unless /^\s*SECTION\s*(\S+)\s*(.*)\s*$/;
my @secargs = split ',', $2;
foreach my $secarg (@secargs) {
if($secarg =~ /(\S+)=(\S+)/) {
$section_args->{lc $1} = $2;
} elsif($secarg =~ /(\S+)/) {
$section_args->{lc $1} = 1;
if(keys %$section_args) {
$link_attrs = $mmu->create_attrs_object('link');
$link_attrs->init_from_args($srcfile, $srcline, name
=> $secname,
my $file = "sec${secnum}.${name}.s";
$file = path_to_build_file
$file; # in build_dir
(my $ofile = $file) =~ s/\.s$/.o/;
my $source = Midas
::Source
::Assembly
->new(sfile
=> $file,
foreach my $segment (Midas
::Segment
->all_names()) {
$seg_hash{$segment} = [];
my $this = Midas
::Section
->new
link_attrs
=> defined $link_attrs ?
[ $link_attrs ] : [],
srcfile
=> $srcfile_start,
srcline
=> $srcline_start,
##############################################################################
return @
{$this->{seg_attrs
}{$segment}};
##############################################################################
if($attrs->{type
} eq 'link') {
push @
{$this->{link_attrs
}}, $attrs;
} elsif(exists $this->{seg_attrs
}{$attrs->{type
}}) {
my $len = @
{$this->{seg_attrs
}{$attrs->{type
}}};
push @
{$this->{seg_attrs
}{$attrs->{type
}}}, $attrs;
$attrs->unique_name($this->secname . "_$attrs->{type}_$len");
##############################################################################
foreach my $seg (Midas
::Segment
->all_names()) {
push @attrs, $this->get_segment_attrs($seg);
##############################################################################
return @
{$this->{link_attrs
}};
##############################################################################
chat
"Section $this->{name}\n", 3;
foreach my $seg (Midas
::Segment
->all_names()) {
my $num = $this->get_segment_attrs($seg);
chat
" num_$seg\t=$num\n", 3;
my $nl = $this->get_link_attrs();
chat
" num_link = $nl\n", 3;
my @files = @
{$this->{files
}}; my $n_files = @files;
chat
" FILES ($n_files)\n", 3;
chat
" " . $f->debug_string . "\n", 3;
##############################################################################
# This function may be called from a child thread, sot it is important
# that it doesn't write any state (i.e., have any side-effects)
foreach my $source (@
{$this->{files
}}) {
#############################################################################
##############################################################################
sub preprocess_midas_directive
{
$output =~ s/(\$(\w+))/exists $ENV{$2} ? $ENV{$2} : $1/ge;
##############################################################################
sub parse_midas_cc_line
{
my ($file, $output, $args);
my $processed = $this->preprocess_midas_directive($line);
if($processed =~ /\bFILE\s*=\s*(\S+)/) {
if($processed =~ /\bOUTPUT\s*=\s*(\S+)/) {
if($processed =~ /\bARGS\s*=\s*(.*)$/) {
fatal
"MIDAS_CC line does not contain FILE argument at line=$srcline, ".
"file=$srcfile\n", M_DIRECTIVESYNTAX
unless defined $file;
$assemble = 1 if defined $args && $args =~ /(\s|\A)-S(\s|\Z)/;
if(not defined $output) {
($sfile = $file) =~ s/\.c$/.s/;
($ofile = $sfile) =~ s/\.s$/.o/;
} elsif($sfile =~ /\.s$/) {
($ofile = $sfile) =~ s/\.s$/.o/;
} elsif($sfile =~ /\.o$/) {
if(not defined $output) {
($ofile = $file) =~ s/\.c$/.o/;
chat
" cfile = $file\n", 3;
chat
" sfile = $sfile\n", 3;
chat
" ofile = $ofile\n", 3;
chat
" assemble = $assemble\n", 3;
chat
" args = $args\n", 3;
chat
" fullsource = $full_file", 3;
my $source = Midas
::Source
::C
->new(
fullsource
=> $full_file,
$source->copy_to_build_dir();
$source->process_source();
push @
{$this->{files
}}, $source;
##############################################################################
sub parse_midas_obj_line
{
my $processed = $this->preprocess_midas_directive($line);
if($processed =~ /\bFILE\s*=\s*(\S+)/) {
fatal
"MIDAS_OBJ line does not contain FILE argument at line=$srcline, ".
"file=$srcfile\n", M_DIRECTIVESYNTAX
unless defined $file;
chat
" ofile = $file\n", 3;
my $source = Midas
::Source
::Object
->new(
$source->copy_to_build_dir();
$source->process_source();
push @
{$this->{files
}}, $source;
##############################################################################
sub parse_midas_lib_line
{
my $processed = $this->preprocess_midas_directive($line);
if($processed =~ /\bFILE\s*=\s*(\S+)/) {
fatal
"MIDAS_LIB line does not contain FILE argument at line=$srcline, ".
"file=$srcfile\n", M_DIRECTIVESYNTAX
unless defined $file;
chat
" ofile = $file\n", 3;
my $source = Midas
::Source
::Library
->new(
$source->copy_to_build_dir();
$source->process_source();
push @
{$this->{files
}}, $source;
##############################################################################
map { $_->get_object_file() }
grep { ! $_->is_library() }
##############################################################################
map { $_->get_object_file() }
grep { $_->is_library() }
##############################################################################
my $fline = "File=$this->{srcfile}, Line=$this->{srclinestop}";
if(scalar($this->get_map_attrs()) == 0) {
my $message = "Section $this->{name} has no attr blocks!\n";
$message .=" at $fline\n";
push @messages, { message
=> $message, code
=> M_SECSYNTAX
};
foreach my $link_attr ($this->get_link_attrs()) {
push @messages, $link_attr->sanity_check();
foreach my $seg (Midas
::Segment
->all_names()) {
$link_seg{$seg} = 0 unless exists $link_seg{$seg};
$link_seg{$seg} ||= $link_attr->has_segment($seg);
foreach my $attr ($this->get_map_attrs()) {
push @messages, $attr->sanity_check();
foreach my $seg (Midas
::Segment
->all_names()) {
my @seg_attrs = $this->get_segment_attrs($seg);
if(not $CONFIG{allow_empty_sections
}) {
if($link_seg{$seg} and ! @seg_attrs) {
"Section $this->{name} has ${seg}_va but no attr_${seg} ".
push @messages, { message
=> $message, code
=> M_SECSYNTAX
};
foreach my $attr (@seg_attrs) {
my $attr_fline = $attr->get_fline();
if(not $link_seg{$seg}) {
my $message = "Section $this->{name} has attr_$seg but no ${seg}_va\n".
push @messages, { message
=> $message, code
=> M_SECSYNTAX
};
##############################################################################
return 1 if scalar $this->get_segment_attrs($segment);
##############################################################################
sub get_section_link_tag
{
my @olist = $this->get_object_list();
@olist = $this->get_library_list() unless @olist;
my $sectag = basename
$olist[0], '.o', '.a';
##############################################################################
sub get_segment_link_name
{
my $sectag = $this->get_section_link_tag();
my $link_suffix = Midas
::Segment
->name2link_suffix($segment);
return "$sectag$link_suffix";
##############################################################################
##############################################################################