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