gcc/ada/gnatsym.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              G N A T S Y M                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2003-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This utility application creates symbol files in a format that is
  27 --  platform-dependent.
  28
  29 --  A symbol file is a text file that lists the symbols to be exported from
  30 --  a shared library. The format of a symbol file depends on the platform;
  31 --  it may be a simple enumeration of the symbol (one per line) or a more
  32 --  elaborate format (on VMS, for example). A symbol file may be used as an
  33 --  input to the platform linker when building a shared library.
  34
  35 --  This utility is not available on all platforms. It is currently supported
  36 --  only on OpenVMS.
  37
  38 --  gnatsym takes as parameters:
  39 --    - the name of the symbol file to create
  40 --    - (optional) the policy to create the symbol file
  41 --    - (optional) the name of the reference symbol file
  42 --    - the names of one or more object files where the symbols are found
  43
  44 with Gnatvsn; use Gnatvsn;
  45 with Osint;   use Osint;
  46 with Output;  use Output;
  47 with Symbols; use Symbols;
  48 with Table;
  49
  50 with Ada.Exceptions; use Ada.Exceptions;
  51 with Ada.Text_IO;    use Ada.Text_IO;
  52
  53 with GNAT.Command_Line;         use GNAT.Command_Line;
  54 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  55 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  56
  57 procedure Gnatsym is
  58
  59    Empty_String : aliased String := "";
  60    Empty        : constant String_Access := Empty_String'Unchecked_Access;
  61    --  To initialize variables Reference and Version_String
  62
  63    Copyright_Displayed : Boolean := False;
  64    --  A flag to prevent multiple display of the Copyright notice
  65
  66    Success : Boolean := True;
  67
  68    Symbol_Policy : Policy := Autonomous;
  69
  70    Verbose : Boolean := False;
  71    --  True when -v switch is used
  72
  73    Quiet : Boolean := False;
  74    --  True when -q switch is used
  75
  76    Symbol_File_Name : String_Access := null;
  77    --  The name of the symbol file
  78
  79    Reference_Symbol_File_Name : String_Access := Empty;
  80    --  The name of the reference symbol file
  81
  82    Version_String : String_Access := Empty;
  83    --  The version of the library (used on VMS)
  84
  85    type Object_File_Data is record
  86       Path : String_Access;
  87       Name : String_Access;
  88    end record;
  89
  90    package Object_Files is new Table.Table
  91      (Table_Component_Type => Object_File_Data,
  92       Table_Index_Type     => Natural,
  93       Table_Low_Bound      => 0,
  94       Table_Initial        => 10,
  95       Table_Increment      => 100,
  96       Table_Name           => "Gnatsymb.Object_Files");
  97    --  A table to store the object file names
  98
  99    Object_File : Natural := 0;
 100    --  An index to traverse the Object_Files table
 101
 102    procedure Display_Copyright;
 103    --  Display Copyright notice
 104
 105    procedure Parse_Cmd_Line;
 106    --  Parse the command line switches and file names
 107
 108    procedure Usage;
 109    --  Display the usage
 110
 111    -----------------------
 112    -- Display_Copyright --
 113    -----------------------
 114
 115    procedure Display_Copyright is
 116    begin
 117       if not Copyright_Displayed then
 118          Write_Eol;
 119          Write_Str ("GNATSYMB ");
 120          Write_Str (Gnat_Version_String);
 121          Write_Eol;
 122          Write_Str ("Copyright 2003-2004 Free Software Foundation, Inc");
 123          Write_Eol;
 124          Copyright_Displayed := True;
 125       end if;
 126    end Display_Copyright;
 127
 128    --------------------
 129    -- Parse_Cmd_Line --
 130    --------------------
 131
 132    procedure Parse_Cmd_Line is
 133    begin
 134       loop
 135          case GNAT.Command_Line.Getopt ("c C D q r: R s: v V:") is
 136             when ASCII.NUL =>
 137                exit;
 138
 139             when 'c' =>
 140                Symbol_Policy := Compliant;
 141
 142             when 'C' =>
 143                Symbol_Policy := Controlled;
 144
 145             when 'D' =>
 146                Symbol_Policy := Direct;
 147
 148             when 'q' =>
 149                Quiet := True;
 150
 151             when 'r' =>
 152                Reference_Symbol_File_Name :=
 153                  new String'(GNAT.Command_Line.Parameter);
 154
 155             when 'R' =>
 156                Symbol_Policy := Restricted;
 157
 158             when 's' =>
 159                Symbol_File_Name := new String'(GNAT.Command_Line.Parameter);
 160
 161             when 'v' =>
 162                Verbose := True;
 163
 164             when 'V' =>
 165                Version_String := new String'(GNAT.Command_Line.Parameter);
 166
 167             when others =>
 168                Fail ("invalid switch: " & Full_Switch);
 169          end case;
 170       end loop;
 171
 172       --  Get the object file names and put them in the table in alphabetical
 173       --  order of base names.
 174
 175       loop
 176          declare
 177             S : constant String_Access :=
 178                            new String'(GNAT.Command_Line.Get_Argument);
 179
 180          begin
 181             exit when S'Length = 0;
 182
 183             Object_Files.Increment_Last;
 184
 185             declare
 186                Base : constant String := Base_Name (S.all);
 187                Last : constant Positive := Object_Files.Last;
 188                J    : Positive;
 189
 190             begin
 191                J := 1;
 192                while J < Last loop
 193                   if Object_Files.Table (J).Name.all > Base then
 194                      Object_Files.Table (J + 1 .. Last) :=
 195                        Object_Files.Table (J .. Last - 1);
 196                      exit;
 197                   end if;
 198
 199                   J := J + 1;
 200                end loop;
 201
 202                Object_Files.Table (J) := (S, new String'(Base));
 203             end;
 204          end;
 205       end loop;
 206    exception
 207       when Invalid_Switch =>
 208          Usage;
 209          Fail ("invalid switch : " & Full_Switch);
 210    end Parse_Cmd_Line;
 211
 212    -----------
 213    -- Usage --
 214    -----------
 215
 216    procedure Usage is
 217    begin
 218       Write_Line ("gnatsym [options] object_file {object_file}");
 219       Write_Eol;
 220       Write_Line ("   -c       Compliant symbol policy");
 221       Write_Line ("   -C       Controlled symbol policy");
 222       Write_Line ("   -q       Quiet mode");
 223       Write_Line ("   -r<ref>  Reference symbol file name");
 224       Write_Line ("   -R       Restricted symbol policy");
 225       Write_Line ("   -s<sym>  Symbol file name");
 226       Write_Line ("   -v       Verbose mode");
 227       Write_Line ("   -V<ver>  Version");
 228       Write_Eol;
 229       Write_Line ("Specifying a symbol file with -s<sym> is compulsory");
 230       Write_Eol;
 231    end Usage;
 232
 233 --  Start of processing of Gnatsym
 234
 235 begin
 236    --  Initialize Object_Files table
 237
 238    Object_Files.Set_Last (0);
 239
 240    --  Parse the command line
 241
 242    Parse_Cmd_Line;
 243
 244    if Verbose then
 245       Display_Copyright;
 246    end if;
 247
 248    --  If there is no symbol file or no object files on the command line,
 249    --  display the usage and exit with an error status.
 250
 251    if Symbol_File_Name = null or else Object_Files.Last = 0 then
 252       Usage;
 253       OS_Exit (1);
 254
 255    --  When symbol policy is direct, simply copy the reference symbol file to
 256    --  the symbol file.
 257
 258    elsif Symbol_Policy = Direct then
 259       declare
 260          File_In  : Ada.Text_IO.File_Type;
 261          File_Out : Ada.Text_IO.File_Type;
 262          Line     : String (1 .. 1_000);
 263          Last     : Natural;
 264
 265       begin
 266          begin
 267             Open (File_In, In_File, Reference_Symbol_File_Name.all);
 268
 269          exception
 270             when X : others =>
 271                if not Quiet then
 272                   Put_Line
 273                     ("could not open """ &
 274                      Reference_Symbol_File_Name.all
 275                      & """");
 276                   Put_Line (Exception_Message (X));
 277                end if;
 278
 279                OS_Exit (1);
 280          end;
 281
 282          begin
 283             Create (File_Out, Out_File, Symbol_File_Name.all);
 284
 285          exception
 286             when X : others =>
 287                if not Quiet then
 288                   Put_Line
 289                     ("could not create """ & Symbol_File_Name.all & """");
 290                   Put_Line (Exception_Message (X));
 291                end if;
 292
 293                OS_Exit (1);
 294          end;
 295
 296          while not End_Of_File (File_In) loop
 297             Get_Line (File_In, Line, Last);
 298             Put_Line (File_Out, Line (1 .. Last));
 299          end loop;
 300
 301          Close (File_In);
 302          Close (File_Out);
 303       end;
 304
 305    else
 306       if Verbose then
 307          Write_Str ("Initializing symbol file """);
 308          Write_Str (Symbol_File_Name.all);
 309          Write_Line ("""");
 310       end if;
 311
 312       --  Initialize symbol file and, if specified, read reference file
 313
 314       Symbols.Initialize
 315         (Symbol_File   => Symbol_File_Name.all,
 316          Reference     => Reference_Symbol_File_Name.all,
 317          Symbol_Policy => Symbol_Policy,
 318          Quiet         => Quiet,
 319          Version       => Version_String.all,
 320          Success       => Success);
 321
 322       --  Process the object files in order. Stop as soon as there is
 323       --  something wrong.
 324
 325       Object_File := 0;
 326
 327       while Success and then Object_File < Object_Files.Last loop
 328          Object_File := Object_File + 1;
 329
 330          if Verbose then
 331             Write_Str ("Processing object file """);
 332             Write_Str (Object_Files.Table (Object_File).Path.all);
 333             Write_Line ("""");
 334          end if;
 335
 336          Processing.Process
 337            (Object_Files.Table (Object_File).Path.all,
 338             Success);
 339       end loop;
 340
 341       --  Finalize the symbol file
 342
 343       if Success then
 344          if Verbose then
 345             Write_Str ("Finalizing """);
 346             Write_Str (Symbol_File_Name.all);
 347             Write_Line ("""");
 348          end if;
 349
 350          Finalize (Quiet, Success);
 351       end if;
 352
 353       --  Fail if there was anything wrong
 354
 355       if not Success then
 356          Fail ("unable to build symbol file");
 357       end if;
 358    end if;
 359 end Gnatsym;