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

# -*- perl -*-

package Midas::Section;
use strict;

use File::Spec;
use File::Copy;
use File::Basename;
use Carp;

use Midas::Command;
use Midas::Configure;
use Midas::Paths;
use Midas::Preprocess ':internals';
use Midas::State;
use Midas::Globals;
use Midas::Source;
use Midas::Application;
use Midas::Error;
use Midas::Segment;

use TRELoad 'BitFieldTie';

use fields qw(
	      name

	      seg_attrs
	      link_attrs

	      files

	      srcfile
	      srcline
	      srcfilestop
	      srclinestop

	      args

	      appobj

	     );

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(init_section);

our $Num = 0;

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

sub init_section {
  $Num = 0;
}

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

sub new {
  my $this = shift;
  my %args = @_;

  unless (ref $this) {
    $this = fields::new($this);
  }

  foreach my $key (keys %args) {
    $this->{$key} = $args{$key};
  }
  return $this;
}

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

sub new_from_line {
  my $class     = shift;
  my $startline = shift;
  my $fh        = shift;
  my $srcfile   = shift;
  my $srcline   = shift;
  my $appobj    = shift;

  my $srcfile_start = $srcfile;
  my $srcline_start = $srcline;

  local ($_);
  $_ = $startline;


  my $mmu = $STATE->get_mmu();


  fatal "Badly formatted SECTION line=$srcline, file=$srcfile:\n$_",
    M_SECSYNTAX unless /^\s*SECTION\s*(\S+)\s*(.*)\s*$/;

  my $secname = $1;
  my @secargs = split ',', $2;

  my $link_attrs;


  my $section_args = {};
  foreach my $secarg (@secargs) {
    $secarg =~ s/\s+//g;
    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,
				%$section_args);
  }


  my $name = lc $secname;
  $name =~ s/^\.//;
  my $secnum = $Num++;
  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,
					    ofile => $ofile,
					    fullsource => $file,
					   );

  my %seg_hash = ();
  foreach my $segment (Midas::Segment->all_names()) {
    $seg_hash{$segment} = [];
  }

  my $this = Midas::Section->new
    (
     name         => $secname,
     args         => $section_args,
     seg_attrs    => \%seg_hash,
     link_attrs   => defined $link_attrs ? [ $link_attrs ] : [],
     files        => [ $source ],
     srcfile      => $srcfile_start,
     srcline      => $srcline_start,
     srcfilestop  => $srcfile,
     srclinestop  => $srcline,
     appobj       => $appobj,
    );

  return $this;

}

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

sub get_segment_attrs {
  my $this = shift;
  my $segment = shift;
  return @{$this->{seg_attrs}{$segment}};
}

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

sub add_attrs {
  my $this = shift;
  my $attrs = shift;

  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");
  }
}

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

sub get_map_attrs {
  my $this = shift;
  my @attrs;
  foreach my $seg (Midas::Segment->all_names()) {
    push @attrs, $this->get_segment_attrs($seg);
  }
  return @attrs;
}

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

sub get_link_attrs {
  my $this = shift;
  return @{$this->{link_attrs}};
}

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

sub print_debug {
  my $this = shift;

  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;
  foreach my $f (@files) {
    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)
sub build {
  my $this = shift;
  foreach my $source (@{$this->{files}}) {
    $source->build();
  }
}

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

sub secname {
  my $this = shift;
  return lc $this->{name};
}

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

sub preprocess_midas_directive {
  my $this = shift;
  my $line = shift;

  my $output = $line;


  $output =~ s/(\$(\w+))/exists $ENV{$2} ? $ENV{$2} : $1/ge;

  return $output;
}

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

sub parse_midas_cc_line {
  my $this = shift;
  my $line = shift;
  my $srcline = shift;
  my $srcfile = shift;

  my ($file, $output, $args);
  my $processed = $this->preprocess_midas_directive($line);
  if($processed =~ /\bFILE\s*=\s*(\S+)/) {
    $file = $1;
  }
  if($processed =~ /\bOUTPUT\s*=\s*(\S+)/) {
    $output = $1;
  }
  if($processed =~ /\bARGS\s*=\s*(.*)$/) {
    $args = $1;
  }

  fatal "MIDAS_CC line does not contain FILE argument at line=$srcline, ".
    "file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $file;

  my $assemble = 0;
  $assemble = 1 if defined $args && $args =~ /(\s|\A)-S(\s|\Z)/;

  my $sfile;
  my $ofile;

  my $full_file = $file;
  $file = basename $file;

  if($assemble) {
    $sfile = $output;
    if(not defined $output) {
      if($file =~ /\.c$/) {
	($sfile = $file) =~ s/\.c$/.s/;
      } else {
	$sfile = $file . ".s";
      }
      ($ofile = $sfile) =~ s/\.s$/.o/;
    } elsif($sfile =~ /\.s$/) {
      ($ofile = $sfile) =~ s/\.s$/.o/;
    } elsif($sfile =~ /\.o$/) {
      $ofile = $sfile;
      $sfile =~ s/\.o$/.s/;
    } else {
      $ofile = $sfile . ".o";
    }
  } else {
    $ofile = $output;
    if(not defined $output) {
      if($file =~ /\.c$/) {
	($ofile = $file) =~ s/\.c$/.o/;
      } else {
	$ofile = $file . ".o";
      }
    }
  }

  my $rec = {
	     cfile => $file,
	     sfile => $sfile,
	     ofile => $ofile,
	     assemble => $assemble,
	     args => $args,
	    };

  chat "LINE: $line\n", 3;
  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(
				     cfile => $file,
				     sfile => $sfile,
				     ofile => $ofile,
				     args => $args,
				     fullsource => $full_file,
				    );

  $source->copy_to_build_dir();
  $source->process_source();

  push @{$this->{files}}, $source;

}

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

sub parse_midas_obj_line {
  my $this = shift;
  my $line = shift;
  my $srcline = shift;
  my $srcfile = shift;

  my $file;
  my $processed = $this->preprocess_midas_directive($line);
  if($processed =~ /\bFILE\s*=\s*(\S+)/) {
    $file = $1;
  }

  fatal "MIDAS_OBJ line does not contain FILE argument at line=$srcline, ".
    "file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $file;

  chat "LINE: $line\n", 3;
  chat "  ofile = $file\n", 3;

  my $source = Midas::Source::Object->new(
					  ofile => $file,
					  fullsource => $file,
					 );

  $source->copy_to_build_dir();
  $source->process_source();

  push @{$this->{files}}, $source;

}

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

sub parse_midas_lib_line {
  my $this = shift;
  my $line = shift;
  my $srcline = shift;
  my $srcfile = shift;

  my $file;
  my $processed = $this->preprocess_midas_directive($line);
  if($processed =~ /\bFILE\s*=\s*(\S+)/) {
    $file = $1;
  }

  fatal "MIDAS_LIB line does not contain FILE argument at line=$srcline, ".
    "file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $file;

  chat "LINE: $line\n", 3;
  chat "  ofile = $file\n", 3;

  my $source = Midas::Source::Library->new(
					   ofile => $file,
					   fullsource => $file,
					  );

  $source->copy_to_build_dir();
  $source->process_source();

  push @{$this->{files}}, $source;

}

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

sub get_object_list {
  my $this = shift;

  my @olist =
    map { $_->get_object_file() }
      grep { ! $_->is_library() }
	@{$this->{files}};
  return @olist;
}

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

sub get_library_list {
  my $this = shift;

  my @alist =
    map { $_->get_object_file() }
      grep { $_->is_library() }
	@{$this->{files}};
  return @alist;
}

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

sub sanity_check {
  my $this = shift;

  my $fline = "File=$this->{srcfile}, Line=$this->{srclinestop}";

  my $error = 0;
  my @messages;

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

  my %link_seg;
  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) {
	my $message =
	  "Section $this->{name} has ${seg}_va but no attr_${seg} ".
	    "blocks\n at $fline\n";
	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".
	  " at $attr_fline\n";
	push @messages, { message => $message, code => M_SECSYNTAX };
     }
    }
  }

  return @messages;
}

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

sub has_segment {
  my $this = shift;
  my $segment = shift;
  return 1 if scalar $this->get_segment_attrs($segment);
  return;
}

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

sub get_section_link_tag {
  my $this = shift;
  my @olist = $this->get_object_list();
  @olist = $this->get_library_list() unless @olist;
  my $sectag = basename $olist[0], '.o', '.a';
  return $sectag;
}

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

sub get_segment_link_name {
  my $this = shift;
  my $segment = shift;
  my $sectag = $this->get_section_link_tag();
  my $link_suffix = Midas::Segment->name2link_suffix($segment);
  return "$sectag$link_suffix";
}

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


1;
Commit	Line	Data
86530b38 AT	1	# -- perl --
	2
	3	package Midas::Section;
	4	use strict;
	5
	6	use File::Spec;
	7	use File::Copy;
	8	use File::Basename;
	9	use Carp;
	10
	11	use Midas::Command;
	12	use Midas::Configure;
	13	use Midas::Paths;
	14	use Midas::Preprocess ':internals';
	15	use Midas::State;
	16	use Midas::Globals;
	17	use Midas::Source;
	18	use Midas::Application;
	19	use Midas::Error;
	20	use Midas::Segment;
	21
	22	use TRELoad 'BitFieldTie';
	23
	24	use fields qw(
	25	name
	26
	27	seg_attrs
	28	link_attrs
	29
	30	files
	31
	32	srcfile
	33	srcline
	34	srcfilestop
	35	srclinestop
	36
	37	args
	38
	39	appobj
	40
	41	);
	42
	43	require Exporter;
	44	our @ISA = qw(Exporter);
	45	our @EXPORT = qw(init_section);
	46
	47	our $Num = 0;
	48
	49	##############################################################################
	50
	51	sub init_section {
	52	$Num = 0;
	53	}
	54
	55	##############################################################################
	56
	57	sub new {
	58	my $this = shift;
	59	my %args = @_;
	60
	61	unless (ref $this) {
	62	$this = fields::new($this);
	63	}
	64
65	foreach my $key (keys %args) {
66	$this->{$key} = $args{$key};
67	}
68	return $this;
69	}
70
71	##############################################################################
72
73	sub new_from_line {
74	my $class = shift;
75	my $startline = shift;
76	my $fh = shift;
77	my $srcfile = shift;
78	my $srcline = shift;
79	my $appobj = shift;
80
81	my $srcfile_start = $srcfile;
82	my $srcline_start = $srcline;
83
84	local ($_);
85	$_ = $startline;
86
87
88	my $mmu = $STATE->get_mmu();
89
90
91	fatal "Badly formatted SECTION line=$srcline, file=$srcfile:\n$_",
92	M_SECSYNTAX unless /^\sSECTION\s(\S+)\s(.)\s*$/;
93
94	my $secname = $1;
95	my @secargs = split ',', $2;
96
97	my $link_attrs;
98
99
100	my $section_args = {};
101	foreach my $secarg (@secargs) {
102	$secarg =~ s/\s+//g;
103	if($secarg =~ /(\S+)=(\S+)/) {
104	$section_args->{lc $1} = $2;
105	} elsif($secarg =~ /(\S+)/) {
106	$section_args->{lc $1} = 1;
107	}
108	}
109
110	if(keys %$section_args) {
111	$link_attrs = $mmu->create_attrs_object('link');
112	$link_attrs->init_from_args($srcfile, $srcline, name => $secname,
113	%$section_args);
114	}
115
116
117	my $name = lc $secname;
118	$name =~ s/^\.//;
119	my $secnum = $Num++;
120	my $file = "sec${secnum}.${name}.s";
121
122	$file = path_to_build_file $file; # in build_dir
123
124
125	(my $ofile = $file) =~ s/\.s$/.o/;
126
127	my $source = Midas::Source::Assembly->new(sfile => $file,
128	ofile => $ofile,
129	fullsource => $file,
130	);
131
132	my %seg_hash = ();
133	foreach my $segment (Midas::Segment->all_names()) {
134	$seg_hash{$segment} = [];
135	}
136
137	my $this = Midas::Section->new
138	(
139	name => $secname,
140	args => $section_args,
141	seg_attrs => \%seg_hash,
142	link_attrs => defined $link_attrs ? [ $link_attrs ] : [],
143	files => [ $source ],
144	srcfile => $srcfile_start,
145	srcline => $srcline_start,
146	srcfilestop => $srcfile,
147	srclinestop => $srcline,
148	appobj => $appobj,
149	);
150
151	return $this;
152
153	}
154
155	##############################################################################
156
157	sub get_segment_attrs {
158	my $this = shift;
159	my $segment = shift;
160	return @{$this->{seg_attrs}{$segment}};
161	}
162
163	##############################################################################
164
165	sub add_attrs {
166	my $this = shift;
167	my $attrs = shift;
168
169	if($attrs->{type} eq 'link') {
170	push @{$this->{link_attrs}}, $attrs;
171	} elsif(exists $this->{seg_attrs}{$attrs->{type}}) {
172	my $len = @{$this->{seg_attrs}{$attrs->{type}}};
173	push @{$this->{seg_attrs}{$attrs->{type}}}, $attrs;
174	$attrs->unique_name($this->secname . "_$attrs->{type}_$len");
175	}
176	}
177
178	##############################################################################
179
180	sub get_map_attrs {
181	my $this = shift;
182	my @attrs;
183	foreach my $seg (Midas::Segment->all_names()) {
184	push @attrs, $this->get_segment_attrs($seg);
185	}
186	return @attrs;
187	}
188
189	##############################################################################
190
191	sub get_link_attrs {
192	my $this = shift;
193	return @{$this->{link_attrs}};
194	}
195
196	##############################################################################
197
198	sub print_debug {
199	my $this = shift;
200
201	chat "Section $this->{name}\n", 3;
202
203	foreach my $seg (Midas::Segment->all_names()) {
204	my $num = $this->get_segment_attrs($seg);
205	chat " num_$seg\t=$num\n", 3;
206	}
207
208
209	my $nl = $this->get_link_attrs();
210	chat " num_link = $nl\n", 3;
211
212	my @files = @{$this->{files}}; my $n_files = @files;
213	chat " FILES ($n_files)\n", 3;
214	foreach my $f (@files) {
215	chat " " . $f->debug_string . "\n", 3;
216	}
217	}
218
219	##############################################################################
220
221	# This function may be called from a child thread, sot it is important
222	# that it doesn't write any state (i.e., have any side-effects)
223	sub build {
224	my $this = shift;
225	foreach my $source (@{$this->{files}}) {
226	$source->build();
227	}
228	}
229
230	#############################################################################
231
232	sub secname {
233	my $this = shift;
234	return lc $this->{name};
235	}
236
237	##############################################################################
238
239	sub preprocess_midas_directive {
240	my $this = shift;
241	my $line = shift;
242
243	my $output = $line;
244
245
246	$output =~ s/(\$(\w+))/exists $ENV{$2} ? $ENV{$2} : $1/ge;
247
248	return $output;
249	}
250
251	##############################################################################
252
253	sub parse_midas_cc_line {
254	my $this = shift;
255	my $line = shift;
256	my $srcline = shift;
257	my $srcfile = shift;
258
259	my ($file, $output, $args);
260	my $processed = $this->preprocess_midas_directive($line);
261	if($processed =~ /\bFILE\s=\s(\S+)/) {
262	$file = $1;
263	}
264	if($processed =~ /\bOUTPUT\s=\s(\S+)/) {
265	$output = $1;
266	}
267	if($processed =~ /\bARGS\s=\s(.*)$/) {
268	$args = $1;
269	}
270
271	fatal "MIDAS_CC line does not contain FILE argument at line=$srcline, ".
272	"file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $file;
273
274	my $assemble = 0;
275	$assemble = 1 if defined $args && $args =~ /(\s\|\A)-S(\s\|\Z)/;
276
277	my $sfile;
278	my $ofile;
279
280	my $full_file = $file;
281	$file = basename $file;
282
283	if($assemble) {
284	$sfile = $output;
285	if(not defined $output) {
286	if($file =~ /\.c$/) {
287	($sfile = $file) =~ s/\.c$/.s/;
288	} else {
289	$sfile = $file . ".s";
290	}
291	($ofile = $sfile) =~ s/\.s$/.o/;
292	} elsif($sfile =~ /\.s$/) {
293	($ofile = $sfile) =~ s/\.s$/.o/;
294	} elsif($sfile =~ /\.o$/) {
295	$ofile = $sfile;
296	$sfile =~ s/\.o$/.s/;
297	} else {
298	$ofile = $sfile . ".o";
299	}
300	} else {
301	$ofile = $output;
302	if(not defined $output) {
303	if($file =~ /\.c$/) {
304	($ofile = $file) =~ s/\.c$/.o/;
305	} else {
306	$ofile = $file . ".o";
307	}
308	}
309	}
310
311	my $rec = {
312	cfile => $file,
313	sfile => $sfile,
314	ofile => $ofile,
315	assemble => $assemble,
316	args => $args,
317	};
318
319	chat "LINE: $line\n", 3;
320	chat " cfile = $file\n", 3;
321	chat " sfile = $sfile\n", 3;
322	chat " ofile = $ofile\n", 3;
323	chat " assemble = $assemble\n", 3;
324	chat " args = $args\n", 3;
325	chat " fullsource = $full_file", 3;
326
327	my $source = Midas::Source::C->new(
328	cfile => $file,
329	sfile => $sfile,
330	ofile => $ofile,
331	args => $args,
332	fullsource => $full_file,
333	);
334
335	$source->copy_to_build_dir();
336	$source->process_source();
337
338	push @{$this->{files}}, $source;
339
340	}
341
342	##############################################################################
343
344	sub parse_midas_obj_line {
345	my $this = shift;
346	my $line = shift;
347	my $srcline = shift;
348	my $srcfile = shift;
349
350	my $file;
351	my $processed = $this->preprocess_midas_directive($line);
352	if($processed =~ /\bFILE\s=\s(\S+)/) {
353	$file = $1;
354	}
355
356	fatal "MIDAS_OBJ line does not contain FILE argument at line=$srcline, ".
357	"file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $file;
358
359	chat "LINE: $line\n", 3;
360	chat " ofile = $file\n", 3;
361
362	my $source = Midas::Source::Object->new(
363	ofile => $file,
364	fullsource => $file,
365	);
366
367	$source->copy_to_build_dir();
368	$source->process_source();
369
370	push @{$this->{files}}, $source;
371
372	}
373
374	##############################################################################
375
376	sub parse_midas_lib_line {
377	my $this = shift;
378	my $line = shift;
379	my $srcline = shift;
380	my $srcfile = shift;
381
382	my $file;
383	my $processed = $this->preprocess_midas_directive($line);
384	if($processed =~ /\bFILE\s=\s(\S+)/) {
385	$file = $1;
386	}
387
388	fatal "MIDAS_LIB line does not contain FILE argument at line=$srcline, ".
389	"file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $file;
390
391	chat "LINE: $line\n", 3;
392	chat " ofile = $file\n", 3;
393
394	my $source = Midas::Source::Library->new(
395	ofile => $file,
396	fullsource => $file,
397	);
398
399	$source->copy_to_build_dir();
400	$source->process_source();
401
402	push @{$this->{files}}, $source;
403
404	}
405
406	##############################################################################
407
408	sub get_object_list {
409	my $this = shift;
410
411	my @olist =
412	map { $_->get_object_file() }
413	grep { ! $_->is_library() }
414	@{$this->{files}};
415	return @olist;
416	}
417
418	##############################################################################
419
420	sub get_library_list {
421	my $this = shift;
422
423	my @alist =
424	map { $_->get_object_file() }
425	grep { $_->is_library() }
426	@{$this->{files}};
427	return @alist;
428	}
429
430	##############################################################################
431
432	sub sanity_check {
433	my $this = shift;
434
435	my $fline = "File=$this->{srcfile}, Line=$this->{srclinestop}";
436
437	my $error = 0;
438	my @messages;
439
440	if(scalar($this->get_map_attrs()) == 0) {
441	my $message = "Section $this->{name} has no attr blocks!\n";
442	$message .=" at $fline\n";
443	push @messages, { message => $message, code => M_SECSYNTAX };
444	}
445
446	my %link_seg;
447	foreach my $link_attr ($this->get_link_attrs()) {
448	push @messages, $link_attr->sanity_check();
449
450	foreach my $seg (Midas::Segment->all_names()) {
451	$link_seg{$seg} = 0 unless exists $link_seg{$seg};
452	$link_seg{$seg} \|\|= $link_attr->has_segment($seg);
453	}
454	}
455
456	foreach my $attr ($this->get_map_attrs()) {
457	push @messages, $attr->sanity_check();
458	}
459
460	foreach my $seg (Midas::Segment->all_names()) {
461	my @seg_attrs = $this->get_segment_attrs($seg);
462	if(not $CONFIG{allow_empty_sections}) {
463	if($link_seg{$seg} and ! @seg_attrs) {
464	my $message =
465	"Section $this->{name} has ${seg}_va but no attr_${seg} ".
466	"blocks\n at $fline\n";
467	push @messages, { message => $message, code => M_SECSYNTAX };
468	}
469	}
470	foreach my $attr (@seg_attrs) {
471	my $attr_fline = $attr->get_fline();
472	if(not $link_seg{$seg}) {
473	my $message = "Section $this->{name} has attr_$seg but no ${seg}_va\n".
474	" at $attr_fline\n";
475	push @messages, { message => $message, code => M_SECSYNTAX };
476	}
477	}
478	}
479
480	return @messages;
481	}
482
483	##############################################################################
484
485	sub has_segment {
486	my $this = shift;
487	my $segment = shift;
488	return 1 if scalar $this->get_segment_attrs($segment);
489	return;
490	}
491
492	##############################################################################
493
494	sub get_section_link_tag {
495	my $this = shift;
496	my @olist = $this->get_object_list();
497	@olist = $this->get_library_list() unless @olist;
498	my $sectag = basename $olist[0], '.o', '.a';
499	return $sectag;
500	}
501
502	##############################################################################
503
504	sub get_segment_link_name {
505	my $this = shift;
506	my $segment = shift;
507	my $sectag = $this->get_section_link_tag();
508	my $link_suffix = Midas::Segment->name2link_suffix($segment);
509	return "$sectag$link_suffix";
510	}
511
512	##############################################################################
513	##############################################################################
514
515
516	1;