projects / OpenSPARC-T2-DV / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
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
CommitLineData
86530b38
AT		 1# -*- perl -*-
2
3package Midas::Assembly;
4use strict;
5use warnings;
6
7use File::Copy;
8use File::Spec;
9use Getopt::Long;
10use Cwd;
11use IO::File;
12use File::Basename;
13use Tie::IxHash;
14
15use Midas::Setup ':all';
16use Midas::Preprocess ':all';
17
18use Midas::State;
19use Midas::Globals;
20use Midas::Configure;
21use Midas::Paths;
22use Midas::Command;
23use Midas::PostProcessing ':asm';
24use Midas::Error;
25use Midas::Segment;
26use Midas::Section;
27
28
29use Midas::TSB;
30
31require Exporter;
32
33our @ISA = qw(Exporter);
34our @EXPORT = qw(assemble_diag);
35our @EXPORT_OK = qw();
36
37our %EXPORT_TAGS =
38 (
39 'all' => [
40 @{$Midas::Setup::EXPORT_TAGS{all}},
41 @{$Midas::Preprocess::EXPORT_TAGS{all}},
42
43 qw(
44 create_sections
45 assemble_sections
46
47 create_sections
48 write_linker_scripts
49 ),
50 ],
51 internals => [ qw(
52 setup_files
53 preprocess
54 create_sections
55 assemble_sections
56 assembly_cleanup
57
58 create_sections
59 write_linker_scripts
60 ),
61 @{$Midas::Setup::EXPORT_TAGS{internals}},
62 @{$Midas::Preprocess::EXPORT_TAGS{internals}}
63 ],
64 );
65Exporter::export_ok_tags('internals', 'all');
66
67our @Options = qw(
68 start_dir=s
69 dest_dir=s
70 diag_root=s
71 phase=s@
72 start_phase=s
73 state=s
74 argv=s
75 );
76
77
78##############################################################################
79
80sub assemble_diag {
81 my @args = @_;
82
83 my %opt = (
84 );
85 local (@ARGV) = @args;
86
87 GetOptions(\%opt, @Options) or
88 fatal "Error in arguments to assemble_diag!\n", M_ARGERR;
89
90 init_section();
91
92 my %phases;
93 tie %phases, 'Tie::IxHash';
94 %phases =
95 (
96 setup => 1,
97 preprocess => 1,
98 sectioning => 1,
99 assemble => 1,
100 link => 1,
101 postprocess => 1,
102 copydest => 1,
103 cleanup => 1,
104 );
105
106 if(exists $opt{phase} and defined $opt{phase}) {
107 foreach my $key (keys %phases) {
108 $phases{$key} = 0;
109 }
110 foreach my $phase (@{$opt{phase}}) {
111 fatal "No such phase $phase!\n", M_ARGERR
112 unless exists $phases{$phase};
113 $phases{$phase} = 1;
114 }
115 $CONFIG{force_build} = 1;
116 }
117
118 if(exists $opt{start_phase} and defined $opt{start_phase}) {
119 fatal "No such phase $opt{start_phase}!\n", M_ARGERR
120 unless exists $phases{$opt{start_phase}};
121 foreach my $phase (keys %phases) {
122 last if $phase eq $opt{start_phase};
123 $phases{$phase} = 0;
124 }
125 $CONFIG{force_build} = 1;
126 }
127
128 if(exists $opt{state} and defined $opt{state}) {
129
130 my $state = $opt{state};
131
132 fatal "State argument isn't a Midas::State object!\n", M_ARGERR unless
133 (ref $state) && $state->isa('Midas::State');
134
135 if(exists $opt{start_dir} and defined $opt{start_dir}) {
136 chat "WARNING: -start_dir ignored when -state is also present.\n"
137 }
138 if(exists $opt{dest_dir} and defined $opt{dest_dir}) {
139 chat "WARNING: -dest_dir ignored when -state is also present.\n"
140 }
141 if(exists $opt{diag_root} and defined $opt{diag_root}) {
142 chat "WARNING: -diag_root ignored when -state is also present.\n"
143 }
144
145 $STATE = $state
146
147 } else {
148 $opt{start_dir} = getcwd unless defined $opt{start_dir};
149 $opt{dest_dir} = getcwd unless defined $opt{dest_dir};
150 $opt{diag_root} = $ENV{DV_ROOT} unless defined $opt{diag_root};
151 $STATE =
152 init_state($opt{diag_root}, $opt{start_dir}, $opt{dest_dir});
153 }
154
155 my $diag = shift @ARGV;
156 fatal "No diag specified to assemble_diag!\n", M_ARGERR
157 unless defined $diag;
158
159 chat "Running from $0\n", 2;
160
161 my $argsfile = path_to_build_file($CONFIG{local_cmdfile}, $STATE);
162 my $oldargsfile = path_to_build_file($CONFIG{local_oldcmdfile}, $STATE);
163 my $m4file = path_to_build_file($CONFIG{local_m4}, $STATE);
164 my $oldm4file = path_to_build_file($CONFIG{local_oldm4}, $STATE);
165
166
167 unlink $oldargsfile if -e $oldargsfile;
168 unlink $oldm4file if -e $oldm4file;
169
170 move $argsfile, $oldargsfile if -e $argsfile;
171 move $m4file, $oldm4file if -e $m4file;
172
173 my $skip_build = 0;
174 setup_files($diag) if $phases{setup};
175
176
177 # Recompute these after setup since cwd has probably changed
178 $argsfile = path_to_build_file($CONFIG{local_cmdfile}, $STATE);
179 $oldargsfile = path_to_build_file($CONFIG{local_oldcmdfile}, $STATE);
180 $m4file = path_to_build_file($CONFIG{local_m4}, $STATE);
181 $oldm4file = path_to_build_file($CONFIG{local_oldm4}, $STATE);
182
183
184 if($opt{argv}) {
185 my $ofh = IO::File->new(">$argsfile") or
186 fatal "Can't open '$argsfile': $!\n", M_FILE;
187
188 print $ofh "midas $opt{argv}\n";
189 undef $ofh;
190 }
191
192
193 preprocess() if $phases{preprocess};
194
195 if((!$CONFIG{force_build}) and
196 (-e $oldargsfile) and
197 (-e $oldm4file) and
198 (-e $argsfile) and
199 (are_files_same($oldargsfile, $argsfile)) and
200 (are_files_same($oldm4file, $m4file)))
201 {
202
203 my @req_source_files = map { expand_product_file($_) }
204 @{$CONFIG{product_files}{required}};
205 my @opt_source_files = map { expand_product_file($_) }
206 @{$CONFIG{product_files}{optional}};
207
208 my $have_sources = 1;
209 foreach my $req_source (@req_source_files) {
210 next if $req_source =~ /\*/;
211 $have_sources &&= (-e $req_source);
212 }
213 if($have_sources) {
214
215
216 # Want to get the right exe files. Big hack here. Create
217 # some application objects so that the copy phase will work correctly.
218
219 my @app_lines =
220 `$CONFIG{perl_cmd} -n -e 'print if /^\\s*APPLICATION/' $m4file`;
221
222 if($@) {
223 # Can't get app lines. Oh well, just build normally.
224 } else {
225
226 my @apps;
227 my $has_default = 0;
228 foreach my $app_line (@app_lines) {
229 if($app_line =~ /^\s*APPLICATION\s*(\S+)/) {
230 my $name = $1;
231 $has_default = 1 if $name eq 'default';
232 push @apps, $name;
233 }
234 }
235 push @apps, 'default' unless $has_default;
236
237 foreach my $app (@apps) {
238 my $appobj = Midas::Application->new(name => $app);
239 $STATE->{apps}{$app} = $appobj;
240 }
241
242
243 chat "Same args, same input, old products still exist. ".
244 "My work here is done.\n", 1;
245 $skip_build = 1;
246
247 }
248 }
249 }
250
251 $STATE->skipping_build($skip_build);
252
253 if(not $skip_build) {
254
255 my @product_files = map { expand_product_file($_) }
256 @{$CONFIG{product_files}{clean}};
257
258 if(@product_files) {
259 my $files_string = join ' ', @product_files;
260 run_command("rm -f $files_string", -errcode => M_FILE);
261 }
262
263
264 my $gf_version = `$CONFIG{goldfinger_cmd} -version`;
265 chomp $gf_version;
266 if($?) {
267 fatal "Can't find a working version of goldfinger!\n", M_GOLDFINGERMISC;
268 }
269
270 if($gf_version < $CONFIG{goldfinger_version}) {
271 my $v = $CONFIG{goldfinger_version};
272 fatal "This version of midas requires at least \n".
273 "version $v of goldfinger.\n".
274 "Found version $gf_version.\n", M_GOLDFINGERMISC;
275
276 }
277
278
279 create_sections() if $phases{sectioning};
280 assemble_sections() if $phases{assemble};
281
282
283 link_diag() if $phases{link};
284
285 postprocess_assembly() if $phases{postprocess};
286
287 }
288
289 copy_dest_files() if $phases{copydest};
290 cd $STATE->get_start_dir;
291
292 assembly_cleanup() if $phases{cleanup};
293
294}
295
296##############################################################################
297
298sub are_files_same {
299 my $file1 = shift;
300 my $file2 = shift;
301
302 my $cmd = "$CONFIG{diff_cmd} $file1 $file2 > /dev/null 2>&1";
303 my $waitstatus = system($cmd);
304 my $exitstatus = $waitstatus >> 8;
305
306 return 1 if !$exitstatus;
307 return 0 if ($exitstatus == 1);
308 fatal "Command '$cmd' failed with status $exitstatus.\n", M_CMDFAIL;
309}
310
311##############################################################################
312
313sub expand_product_file {
314 my $configname = shift;
315
316 return path_to_build_file($CONFIG{$configname}, $STATE);
317}
318
319##############################################################################
320
321sub expand_for_apps {
322 my $filename = shift;
323
324 return ($filename) unless $filename =~ /\*/;
325
326 my @list;
327 foreach my $app (keys %{$STATE->{apps}}) {
328 my $file = $STATE->{apps}{$app}->expand_file($filename);
329
330 if($STATE->skipping_build and $app eq 'default'
331 and not -e $file)
332 {
333 next;
334 }
335
336 push @list, $STATE->{apps}{$app}->expand_file($filename);
337 }
338 return @list;
339}
340
341##############################################################################
342
343sub copy_dest_files {
344 local ($_);
345
346 my @req_source_files = map { expand_product_file($_) }
347 @{$CONFIG{product_files}{required}};
348 my @opt_source_files = map { expand_product_file($_) }
349 @{$CONFIG{product_files}{optional}};
350
351
352 @req_source_files = map { expand_for_apps($_); } @req_source_files;
353 @opt_source_files = map { expand_for_apps($_); } @opt_source_files;
354
355 my %file_importance;
356 foreach my $req_src (@req_source_files) {
357 $file_importance{$req_src} = 'required';
358 }
359 foreach my $opt_src (@opt_source_files) {
360 $file_importance{$opt_src} = 'optional';
361 }
362
363 my @src_files = (@req_source_files, @opt_source_files);
364
365 my $dest_dir = $STATE->get_dest_dir();
366 return if $dest_dir eq '.';
367
368 banner "COPY PHASE";
369
370 my @dest_files = map { File::Spec->catfile($dest_dir, basename $_) }
371 @src_files;
372
373 my $dest_files = join ' ', @dest_files;
374 run_command("rm -f $dest_files") if @dest_files;
375
376 foreach my $src (@src_files) {
377 if(-e $src) {
378 if($CONFIG{copy_products}) {
379 chat "Copying $src to '$dest_dir'.\n", 2;
380 copy $src, $dest_dir or
381 fatal "Could not copy $src to '$dest_dir': $!\n", M_FILE;
382 } else {
383 chat "Hard linking $src to '$dest_dir'.\n", 2;
384 my $dest_file = File::Spec->catfile($dest_dir, basename $src);
385 if(not link($src, $dest_file)) {
386 chat "Hard linking of $src failed. Copying instead.\n", 2;
387 copy $src, $dest_dir or
388 fatal "Could not copy $src to '$dest_dir': $!\n", M_FILE;
389 }
390
391 }
392 } else {
393 if($file_importance{$src} ne 'optional') {
394 fatal "$src does not exist in build dir!\n";
395 }
396 }
397 }
398}
399
400##############################################################################
401
402sub assembly_cleanup {
403 return unless $CONFIG{cleanup};
404
405 banner "CLEANUP PHASE";
406
407 if($STATE->get_created_build_dir() or $CONFIG{force_cleanup}) {
408 my $build_dir = $STATE->get_build_dir();
409 if($build_dir eq '.') {
410 chat "Build directory is the same as start directory. Can't remove.\n";
411 } else {
412 run_command("rm -rf " . $STATE->get_build_dir());
413 }
414 } else {
415 chat "Build directory already existed, so not removing it.\n";
416 }
417}
418
419##############################################################################
420
421sub create_sections {
422 my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
423
424 banner "SECTION PARSING PHASE";
425
426 my $mmu = $STATE->get_mmu();
427
428 my $m4file = path_to_build_file($CONFIG{local_m4}, $STATE);
429
430 my $directives = path_to_build_file($CONFIG{local_directives}, $STATE);
431
432
433 my $verbose = ($CONFIG{verbose} == 0) ? '-silent ' :
434 ($CONFIG{verbose} == 2) ? '-v ' : '';
435
436 my $error_opt = $Midas::Error::Print_Errors ? '' : '-noprint_errors ';
437
438 run_command("$CONFIG{goldfinger_cmd} ${verbose}-splitsec $m4file ".
439 "-midasfile $directives ${error_opt}".
440 "-prefix '${Midas::Error::Prg}: '",
441 '-pass_errcode',
442 );
443
444 my (%sections, %section_count);
445 my (%tsbs,%tsblinks );
446 tie %tsbs, 'Tie::IxHash';
447 tie %tsblinks, 'Tie::IxHash';
448 local ($_);
449
450 my ($ifh, $ofh);
451 my ($smartlines, $srcfile, $srcline);
452
453 my $num_secs = 0;
454
455 my $app = Midas::Application->new(name => 'default');
456 $STATE->{apps}{$app->name()} = $app;
457
458 chat "Finding sections in $directives\n";
459 # First pass, create sections first so attr_ blocks can reference them
460 $ifh = IO::File->new("<$directives") or
461 fatal "Can't open $directives: $!\n", M_FILE;
462
463 $smartlines = 0;
464 $srcfile = $m4file;
465 $srcline = 0;
466 my %apps;
467 my $appname = lc $app->name();
468 my $first_appname = $appname;
469 while(<$ifh>) {
470 if(/^\#\s*(?:line\s*)?(\d+)\s+\"(.*)\"/) {
471 $srcline = $1 - 1;
472 $srcfile = $2;
473 $smartlines = 1;
474 } else {
475 $srcline++;
476 }
477
478 while($_ =~ /\\$/) {
479 $_ =~ s/\\\n$/ /;
480 $_ .= <$ifh>;
481 $srcline++;
482 }
483
484 if(/^\s*APPLICATION\s*(\S+)\s*(.*)?$/) {
485 my $name = $1;
486 my $args = $2;
487
488 $app = Midas::Application->new(name => $name,
489 srcfile => $srcfile,
490 srcline => $srcline,
491 args => $args,
492 );
493 $appname = lc $name;
494 if(exists $apps{$appname}) {
495 fatal
496 "App '$appname' already exists at file=$srcfile, line=$srcline!\n",
497 M_APPSYNTAX;
498 }
499
500 $apps{$appname} = $app;
501
502 $STATE->{apps}{$name} = $app;
503 }
504
505 if(/^\s*goldfinger_cmd\s*\{/) {
506 my $string = $_;
507 $string =~ s/^\s*goldfinger_cmd\s*\{//;
508
509 if($string =~ /\}/) {
510 $string =~ s/\}//;
511 } else {
512 while(<$ifh>) {
513 if(/^\#\s*(?:line\s*)?(\d+)\s+\"(.*)\"/) {
514 $srcline = $1 - 1;
515 $srcfile = $2;
516 $smartlines = 1;
517 } else {
518 $srcline++;
519 }
520
521 my $line = $_;
522 if($line =~ s/\}//) {
523 $string .= $line;
524 last;
525 } else {
526 $string .= $line;
527 }
528
529 }
530 }
531
532 $app->add_goldfinger_cmd($string);
533 }
534
535 if(/^\s*SECTION\s+(\S+)/) {
536 my $name = lc $1;
537
538 if(not exists $sections{$appname}{$name}) {
539
540 my $section = Midas::Section->new_from_line($_, $ifh,
541 $srcfile, $srcline,
542 $app);
543
544 $app->add_section($section);
545
546 $srcfile = $section->{srcfile};
547 $srcline = $section->{srclinestop};
548
549 $name = lc $section->{name};
550
551 $sections{$appname}{$name} = $section;
552 $num_secs++;
553 } elsif(/^\s*SECTION\s+(\S+)\s+(\S.*)/) {
554 fatal "SECTION '$1' declared more than once has arguments. \n".
555 "Arguments only permitted for the initial declaration.\n".
556 "file=$srcfile, line=$srcline.\n", M_SECSYNTAX;
557 }
558
559 $section_count{$appname}{$name} = []
560 unless exists $section_count{$appname}{$name};
561 push @{$section_count{$appname}{$name}}, {
562 srcfile => $srcfile,
563 srcline => $srcline,
564 };
565 }
566 if(/^\s*MIDAS_TSB\s+(\S+)/) {
567 my $tsbname = lc $1;
568
569 if(not exists $tsbs{$tsbname}) {
570# my $tsb = Midas::TSB->new_from_line($_, $ifh,
571# $srcfile, $srcline, $mmu);
572 my $tsb = $mmu->create_tsb_object_from_line($_, $ifh,
573 $srcfile, $srcline);
574
575 $srcfile = $tsb->{srcfilestop};
576 $srcline = $tsb->{srclinestop};
577 $tsbs{$tsbname} = $tsb;
578 } else {
579 fatal "Tsb '$tsbname' declared twice!\n".
580 " First time, file=$tsbs{$tsbname}{srcfile}, ".
581 "line=$tsbs{$tsbname}{srcline}\n".
582 " Second time, file=$srcfile, line=$srcline.\n", M_TSBSYNTAX;
583 }
584 } elsif(/^\s*MIDAS_TSB_LINK\s+(\S+)/) {
585 my $tsblinkname = lc $1;
586
587 if(not exists $tsblinks{$tsblinkname}) {
588# my $tsblink = Midas::TSBLink->new_from_line($_, $ifh,
589# $srcfile, $srcline,
590# $mmu);
591
592 my $tsblink = $mmu->create_tsb_link_object_from_line($_, $ifh,
593 $srcfile,
594 $srcline);
595
596
597 $srcfile = $tsblink->{srcfilestop};
598 $srcline = $tsblink->{srclinestop};
599 $tsblinks{$tsblinkname} = $tsblink;
600 } else {
601 fatal "Tsb_link '$tsblinkname' declared twice!\n".
602 " First time, file=$tsblinks{$tsblinkname}{srcfile}, ".
603 "line=$tsblinks{$tsblinkname}{srcline}\n".
604 " Second time, file=$srcfile, line=$srcline.\n", M_TSBSYNTAX;
605 }
606 }
607 }
608 undef $ifh;
609
610 foreach my $tsbname (keys %tsbs) {
611 my $linkname = $tsbs{$tsbname}->get_tsblinkname();
612
613 if(defined $linkname) {
614 $linkname = lc $linkname;
615 if(exists $tsblinks{$linkname}) {
616 $tsbs{$tsbname}->set_tsblinkobj($tsblinks{$linkname});
617 } else {
618 fatal "TSB '$tsbname' has link area '$linkname', which is".
619 " undefined!\n".
620 " at file=$tsbs{$tsbname}{srcfile}, ".
621 "line=$tsbs{$tsbname}{srcline}", M_TSBSYNTAX;
622 }
623 }
624
625 $MapAttr_Settable{$tsbname} = 1;
626 }
627
628 $STATE->{tsbs} = \%tsbs;
629 $STATE->{tsblinks} = \%tsblinks;
630
631 if(!$num_secs) {
632 fatal "Diag contains no SECTION directives!\n", M_NOSEC;
633 }
634
635
636 chat "Processing directives in $directives\n";
637
638 # Pass 2, create attr_blocks
639
640 $srcfile = $m4file;
641 $srcline = 0;
642 $ifh = IO::File->new("<$directives") or die "Can't open $directives: $!\n";
643
644 my %opened_sec;
645 my @linebuf;
646 my @sections;
647
648 my $current_section;
649 my $current_appname = $first_appname;
650
651 while(<$ifh>) {
652 if(/^\#\s*(?:line\s*)?(\d+)\s+\"(.*)\"/) {
653 $srcline = $1 - 1;
654 $srcfile = $2;
655 $smartlines = 1;
656 } else {
657 $srcline++;
658 }
659
660 while($_ =~ /\\$/) {
661 $_ =~ s/\\\n$/ /;
662 $_ .= <$ifh>;
663 $srcline++;
664 }
665
666 if(/^\s*APPLICATION\s+(\S+)/) {
667 my $appname = lc $1;
668 $current_appname = $appname;
669 }
670
671
672 if(/^\s*SECTION\s+(\S+)/) {
673 my $secname = lc $1;
674
675 my $section = $sections{$current_appname}{$secname};
676 $current_section = $section;
677
678 my $rec = shift @{$section_count{$current_appname}{$secname}};
679
680 $srcfile = $rec->{srcfile};
681 $srcline = $rec->{srcline};
682
683 if(not $opened_sec{$current_appname}{$secname}) {
684 push @sections, $section;
685 }
686 $opened_sec{$current_appname}{$secname} = 1;
687 my $nextline = $srcline + 1;
688 next;
689 } # end if /^SECTION/
690
691 if(/^\s*attr_(\S+)\s*\{/) {
692
693 my $attrs = $mmu->parse_section_attrs($_, $ifh,
694 $srcline, $srcfile);
695 $_ = "\n";
696
697
698 ($srcfile, $srcline) = $attrs->get_end_file_line();
699
700 my $secname = $attrs->get_section_name();
701
702 $attrs->attr_fatal("attr block does not define a section!\n", M_NOSEC)
703 unless defined $secname && $secname =~ /\S/;
704
705 fatal "Attribute spec for section \"$secname\" but no such section.\n".
706 "File=$srcfile, Line=$srcline\n", M_MISSINGPARAM
707 unless exists $sections{$current_appname}{$secname};
708
709 my $section = $sections{$current_appname}{$secname};
710 $attrs->secobj($section);
711 $section->add_attrs($attrs);
712
713 }
714
715
716 if(/^\s*MIDAS_CC\s*(.*?)\s*$/) {
717 fatal "MIDAS_CC directive outside any section at line=$srcline, ".
718 "file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $current_section;
719 $current_section->parse_midas_cc_line($1, $srcline, $srcfile);
720 $_= "\n";
721 }
722 if(/^\s*MIDAS_OBJ\s*(.*?)\s*$/) {
723 fatal "MIDAS_OBJ directive outside any section at line=$srcline, ".
724 "file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $current_section;
725 $current_section->parse_midas_obj_line($1, $srcline, $srcfile);
726 $_= "\n";
727 }
728 if(/^\s*MIDAS_LIB\s*(.*?)\s*$/) {
729 fatal "MIDAS_LIB directive outside any section at line=$srcline, ".
730 "file=$srcfile\n", M_DIRECTIVESYNTAX unless defined $current_section;
731 $current_section->parse_midas_lib_line($1, $srcline, $srcfile);
732 $_= "\n";
733 }
734
735 }
736
737 chat "Performing sanity check on arguments.\n";
738
739 my @errors;
740 foreach my $section (@sections) {
741 # Do error checking
742 push @errors, $section->sanity_check();
743 }
744
745 if(@errors) {
746 my $errorcode = $errors[0]{code};
747 my $message = join "\n", map { $_->{message} } @errors;
748 fatal $message, $errorcode;
749 }
750
751 foreach my $appname (keys %{$STATE->{apps}}) {
752 delete $STATE->{apps}{$appname} if $STATE->{apps}{$appname}->is_blank();
753 }
754
755 foreach my $s (@sections) {
756 $s->print_debug();
757 }
758
759
760
761}
762
763##############################################################################
764
765sub write_linker_scripts {
766 my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
767
768 # mmu must exist or we never would have been able to create sections
769 foreach my $app (keys %{$STATE->{apps}}) {
770
771 next if $STATE->{apps}{$app}->is_linked();
772 my @sec_list = $STATE->{apps}{$app}->get_sec_list();
773
774 my $script_name = $STATE->{apps}{$app}->ldscr_name();
775 my $script = path_to_build_file($script_name, $STATE);
776
777 chat "Writing linker script $script.\n";
778
779 my $ofh = IO::File->new(">$script") or die "Can't open $script: $!\n";
780
781 $ofh->print("SECTIONS {\n");
782
783 foreach my $sec (@sec_list) {
784
785 my $link_attrs = [$sec->get_link_attrs()]->[0];
786
787 my @olist = map { basename $_ } $sec->get_object_list();
788 my @alist = map { basename $_ } $sec->get_library_list(); #libs after .o
789
790 push @olist, @alist;
791
792 foreach my $seg (Midas::Segment->all_names()) {
793 if ($link_attrs->has_segment($seg)) {
794 my $linkname = $sec->get_segment_link_name($seg);
795 my $elfname = Midas::Segment->name2elf_name($seg);
796
797 my $filespec = join " ", map { "$_ ($elfname)" } @olist;
798
799 my $addrspec = $link_attrs->get_segment_va($seg) . " :";
800 $ofh->print("$linkname $addrspec { $filespec }\n");
801 }
802 }
803
804 }
805 $ofh->print("}\n");
806
807 undef $ofh;
808 }
809}
810
811##############################################################################
812
813sub assemble_sections {
814 banner "ASSEMBLY PHASE";
815
816 foreach my $app_name (keys %{$STATE->{apps}}) {
817 my $app = $STATE->{apps}{$app_name};
818
819 my @sections = $app->get_sec_list();
820 build_sections(\@sections) if @sections;
821 }
822
823}
824
825##############################################################################
826
827sub build_sections {
828 my $seclist = shift;
829
830 my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
831
832 my $num_threads = $CONFIG{build_threads};
833 $num_threads = 1 if $num_threads < 1;
834 my $num_sections = @$seclist;
835 return unless $num_sections;
836 $num_threads = $num_sections if $num_sections < $num_threads;
837
838 my $sec_pl = ($num_sections > 1) ? 's' : '';
839 my $thd_pl = ($num_threads > 1) ? 's' : '';
840 chat "Building $num_sections section$sec_pl using $num_threads ".
841 "build thread$thd_pl.\n";
842
843 if($num_threads == 1) {
844 foreach my $section (@$seclist) {
845 $section->build();
846 }
847 } else {
848 my @thread_sections;
849 my $num_section = -1;
850 foreach my $section (@$seclist) {
851 $num_section++;
852 my $thread = $num_section % $num_threads;
853 $thread_sections[$thread] = [] unless defined $thread_sections[$thread];
854 push @{$thread_sections[$thread]}, $section;
855 }
856
857 my $parent_thread = 0;
858 my $my_thread = 0;
859
860 my @child_pids;
861 my $threads_to_spawn = $num_threads - 1;
862 my $next_thread = $my_thread + 1;
863
864 while($threads_to_spawn) {
865 my $pid;
866 if($pid = fork()) {
867 $next_thread++;
868 $threads_to_spawn--;
869 push @child_pids, $pid;
870 # parent
871 } elsif(defined $pid) {
872 $my_thread = $next_thread;
873 last;
874 } else {
875 fatal "Cannot fork thread $next_thread: $!\n", M_CODE;
876 }
877 }
878
879 chat "Build thread $my_thread is alive!\n", 3;
880
881 foreach my $section (@{$thread_sections[$my_thread]}) {
882 chat "Building section $section->{name} on thread $my_thread\n", 3;
883 $section->build();
884 }
885
886 if($my_thread != 0) {
887 exit(0);
888 }
889 if(@child_pids) {
890
891 foreach my $pid (@child_pids) {
892 my $waitval;
893 my $waitstatus;
894 while() {
895 $waitval = waitpid($pid, 0);
896 if($waitval == -1) {
897 $waitstatus = 0;
898 last;
899 } elsif($waitval == 0) {
900 $waitstatus = 0;
901 last;
902 } else {
903 $waitval = $pid;
904 $waitstatus = $?;
905 last;
906 }
907 };
908 my $status = $waitstatus >> 8;
909 # Child thread has died with nonzero status
910 if($status != 0) {
911 my $waitstatus_hex = sprintf "%x", $waitstatus;
912 fatal "Build thread with pid=$pid died with status $status ".
913 "(waitstauts=0x$waitstatus_hex).\n", $status;
914 }
915 }
916 }
917
918 }
919}
920
921##############################################################################
922
923sub link_diag {
924 my $pushd = Midas::Paths->pushd($STATE->get_build_dir);
925
926 banner "LINK PHASE";
927
928 write_linker_scripts();
929
930 foreach my $app (keys %{$STATE->{apps}}) {
931 my $appobj = $STATE->{apps}{$app};
932
933 next if $appobj->is_linked();
934
935 my $ldscript_name = $appobj->ldscr_name();
936 my $exe_name = $appobj->exe_name();
937
938 my $ldscript = path_to_build_file($ldscript_name, $STATE);
939 my $exe = path_to_build_file($exe_name, $STATE);
940
941 my $args = join ' ', @{$CONFIG{ld_opt}};
942 run_command("$CONFIG{ld_cmd} $args -T $ldscript -o $exe",
943 -errcode => M_LINKFAIL
944 );
945
946 if(-e $exe) {
947 chat "$exe successfully created.\n";
948 } else {
949 fatal "$exe could not be generated.\n", M_LINKFAIL;
950 }
951 }
952
953}
954
955##############################################################################
956
9571;
Full OpenSPARC design & verification tarball including full HDL.