| 1 | # ========== Copyright Header Begin ========================================== |
| 2 | # |
| 3 | # OpenSPARC T2 Processor File: Setup.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 | |
| 37 | package Midas::Setup; |
| 38 | use strict; |
| 39 | use warnings; |
| 40 | |
| 41 | use IO::File; |
| 42 | |
| 43 | use Midas::Command; |
| 44 | use Midas::Paths; |
| 45 | use Midas::Section; |
| 46 | use Midas::MMU; |
| 47 | use Midas::Configure; |
| 48 | use Midas::State; |
| 49 | use Midas::Globals; |
| 50 | use Midas::Error; |
| 51 | |
| 52 | require Exporter; |
| 53 | |
| 54 | our @ISA = qw(Exporter); |
| 55 | our @EXPORT = qw(setup_files); |
| 56 | our @EXPORT_OK = qw(); |
| 57 | our %EXPORT_TAGS = ( |
| 58 | all => [qw( |
| 59 | setup_files |
| 60 | bring_local |
| 61 | split_perl_assembly |
| 62 | ), |
| 63 | ], |
| 64 | internals => [qw( |
| 65 | ), |
| 66 | ], |
| 67 | ); |
| 68 | |
| 69 | Exporter::export_ok_tags('all'); |
| 70 | |
| 71 | ############################################################################## |
| 72 | |
| 73 | # SETUP SECTION |
| 74 | # |
| 75 | # These functions prepare a diag for further processing. The external |
| 76 | # interface is the setup_files) function. |
| 77 | |
| 78 | ############################################################################## |
| 79 | |
| 80 | # setup_files($diag) - Exported function |
| 81 | |
| 82 | # Prepares a diag for processing: |
| 83 | # |
| 84 | # 1. If $STATE is undefined, create a new Midas::State object |
| 85 | # 2. Create build directory if it doesn't already exist |
| 86 | # 3. cd into build directory |
| 87 | # 4. Copy diag from specified path to build directory (default name |
| 88 | # is diag.src). |
| 89 | # 5. Split diag.src into perl and assembly parts |
| 90 | # |
| 91 | # Return value is the Midas::State object used. The function also has |
| 92 | # the side effect of changing the working directory to the build directory. |
| 93 | |
| 94 | |
| 95 | ############################################################################## |
| 96 | |
| 97 | sub setup_files { |
| 98 | my $diag_path = shift; |
| 99 | |
| 100 | banner "SETUP PHASE"; |
| 101 | |
| 102 | chat "### Will build in directory \"" . |
| 103 | $STATE->get_build_dir('-abs') . |
| 104 | "\"\n"; |
| 105 | |
| 106 | bring_local($diag_path); |
| 107 | |
| 108 | cd $STATE->get_build_dir(); |
| 109 | |
| 110 | my $pushd = Midas::Paths->pushd($STATE->get_build_dir()); |
| 111 | |
| 112 | split_perl_assembly(); |
| 113 | |
| 114 | } |
| 115 | |
| 116 | ############################################################################## |
| 117 | |
| 118 | # build_local($diag) |
| 119 | # |
| 120 | # Creates build_directory if it doesn't already exist. |
| 121 | # Copies $diag into build_directory. |
| 122 | # If the diag is a .pal diag, it runs PAL to convert it. |
| 123 | |
| 124 | ############################################################################## |
| 125 | |
| 126 | sub bring_local { |
| 127 | my $diag_path = shift; |
| 128 | |
| 129 | my $build_dir = $STATE->get_build_dir('-abs'); |
| 130 | |
| 131 | my $src = path_to_build_file($CONFIG{local_src}, $STATE); |
| 132 | if(not -d $build_dir) { |
| 133 | run_command("mkdir $build_dir", -errcode => M_DIR); |
| 134 | $STATE->set_created_build_dir(1); |
| 135 | } else { |
| 136 | my @intermed_files = map { path_to_build_file(exists $CONFIG{$_} ? |
| 137 | $CONFIG{$_} : $_, $STATE) } |
| 138 | @{$CONFIG{intermed_files}}; |
| 139 | |
| 140 | my $files_str = join ' ', @intermed_files; |
| 141 | run_command("rm -f $files_str", -errcode => M_FILE) if @intermed_files; |
| 142 | } |
| 143 | |
| 144 | if($diag_path =~ /\.pal$/) { |
| 145 | my $pal_opt = join ' ', @{$CONFIG{pal_opt}}; |
| 146 | $pal_opt .= ' ' if length $pal_opt; |
| 147 | my $pal_diag_args = join ' ', @{$CONFIG{pal_diag_args}}; |
| 148 | run_command("$CONFIG{pal_cmd} $pal_opt$diag_path $pal_diag_args > $src"); |
| 149 | } else { |
| 150 | run_command("cp $diag_path $src", -errcode => M_FILE); |
| 151 | } |
| 152 | run_command("chmod ug+w $src", -verbose => 3, -errcode => M_FILE); |
| 153 | } |
| 154 | |
| 155 | ############################################################################## |
| 156 | |
| 157 | # split_perl_assembly() |
| 158 | # |
| 159 | # Splits the diag.src into diag.s and diag.pl (of course, default names |
| 160 | # can be changed in Configure). Everything in diag.src before __PERL__ goes |
| 161 | # in diag.s. Everything after goes in diag.pl |
| 162 | |
| 163 | ############################################################################## |
| 164 | |
| 165 | sub split_perl_assembly { |
| 166 | my $src = path_to_build_file($CONFIG{local_src}, $STATE); |
| 167 | my $s = path_to_build_file($CONFIG{local_s}, $STATE); |
| 168 | my $pl = path_to_build_file($CONFIG{local_pl}, $STATE); |
| 169 | |
| 170 | my $src_fh = IO::File->new("<$src") or fatal "Can't open $src: $!\n", M_FILE; |
| 171 | my $s_fh = IO::File->new(">$s") or fatal "Can't open $s: $!\n", M_FILE; |
| 172 | my $pl_fh; |
| 173 | |
| 174 | chat "Splitting $src into $s and $pl (if necessary).\n"; |
| 175 | |
| 176 | while(<$src_fh>) { |
| 177 | |
| 178 | if(defined $pl_fh) { |
| 179 | $pl_fh->print($_); |
| 180 | } elsif(/^\s*__PERL__/) { |
| 181 | chat "$src conitains perl code, so creating $pl\n", 2; |
| 182 | $pl_fh = IO::File->new(">$pl") or fatal "Can't open $pl: $!\n", M_FILE; |
| 183 | } else { |
| 184 | $s_fh->print($_); |
| 185 | } |
| 186 | |
| 187 | } |
| 188 | # just in case the user didn't end with a newline |
| 189 | $s_fh->print("\n"); |
| 190 | $pl_fh->print("\n") if defined $pl_fh; |
| 191 | |
| 192 | undef $src_fh; |
| 193 | undef $s_fh; |
| 194 | undef $pl_fh; |
| 195 | } |
| 196 | |
| 197 | ############################################################################## |
| 198 | 1; |