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
44with Gnatvsn; use Gnatvsn;
45with Osint;   use Osint;
46with Output;  use Output;
47with Symbols; use Symbols;
48with Table;
49
50with Ada.Exceptions; use Ada.Exceptions;
51with Ada.Text_IO;    use Ada.Text_IO;
52
53with GNAT.Command_Line;         use GNAT.Command_Line;
54with GNAT.Directory_Operations; use GNAT.Directory_Operations;
55with GNAT.OS_Lib;               use GNAT.OS_Lib;
56
57procedure 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
235begin
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;
359end Gnatsym;
360