Daily bump.
[official-gcc.git] / gcc / ada / gnatsym.adb
blobdec5257f45c7b09fd6bf9ed707e73c0bee19c45f
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-2008, 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 ------------------------------------------------------------------------------
26 -- This utility application creates symbol files in a format that is
27 -- platform-dependent.
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.
35 -- This utility is not available on all platforms. It is currently supported
36 -- only on OpenVMS.
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
44 with Ada.Exceptions; use Ada.Exceptions;
45 with Ada.Text_IO; use Ada.Text_IO;
47 with GNAT.Command_Line; use GNAT.Command_Line;
48 with GNAT.OS_Lib; use GNAT.OS_Lib;
50 with Gnatvsn; use Gnatvsn;
51 with Osint; use Osint;
52 with Output; use Output;
54 with Symbols; use Symbols;
55 with Table;
57 procedure Gnatsym is
59 Empty_String : aliased String := "";
60 Empty : constant String_Access := Empty_String'Unchecked_Access;
61 -- To initialize variables Reference and Version_String
63 Copyright_Displayed : Boolean := False;
64 -- A flag to prevent multiple display of the Copyright notice
66 Success : Boolean := True;
68 Symbol_Policy : Policy := Autonomous;
70 Verbose : Boolean := False;
71 -- True when -v switch is used
73 Quiet : Boolean := False;
74 -- True when -q switch is used
76 Symbol_File_Name : String_Access := null;
77 -- The name of the symbol file
79 Reference_Symbol_File_Name : String_Access := Empty;
80 -- The name of the reference symbol file
82 Version_String : String_Access := Empty;
83 -- The version of the library (used on VMS)
85 package Object_Files is new Table.Table
86 (Table_Component_Type => String_Access,
87 Table_Index_Type => Natural,
88 Table_Low_Bound => 0,
89 Table_Initial => 10,
90 Table_Increment => 100,
91 Table_Name => "Gnatsymb.Object_Files");
92 -- A table to store the object file names
94 Object_File : Natural := 0;
95 -- An index to traverse the Object_Files table
97 procedure Display_Copyright;
98 -- Display Copyright notice
100 procedure Parse_Cmd_Line;
101 -- Parse the command line switches and file names
103 procedure Usage;
104 -- Display the usage
106 -----------------------
107 -- Display_Copyright --
108 -----------------------
110 procedure Display_Copyright is
111 begin
112 if not Copyright_Displayed then
113 Write_Eol;
114 Write_Str ("GNATSYMB ");
115 Write_Str (Gnat_Version_String);
116 Write_Eol;
117 Write_Str ("Copyright 2003-2004 Free Software Foundation, Inc");
118 Write_Eol;
119 Copyright_Displayed := True;
120 end if;
121 end Display_Copyright;
123 --------------------
124 -- Parse_Cmd_Line --
125 --------------------
127 procedure Parse_Cmd_Line is
128 begin
129 loop
130 case GNAT.Command_Line.Getopt ("c C D q r: R s: v V:") is
131 when ASCII.NUL =>
132 exit;
134 when 'c' =>
135 Symbol_Policy := Compliant;
137 when 'C' =>
138 Symbol_Policy := Controlled;
140 when 'D' =>
141 Symbol_Policy := Direct;
143 when 'q' =>
144 Quiet := True;
146 when 'r' =>
147 Reference_Symbol_File_Name :=
148 new String'(GNAT.Command_Line.Parameter);
150 when 'R' =>
151 Symbol_Policy := Restricted;
153 when 's' =>
154 Symbol_File_Name := new String'(GNAT.Command_Line.Parameter);
156 when 'v' =>
157 Verbose := True;
159 when 'V' =>
160 Version_String := new String'(GNAT.Command_Line.Parameter);
162 when others =>
163 Fail ("invalid switch: " & Full_Switch);
164 end case;
165 end loop;
167 -- Get the file names
169 loop
170 declare
171 S : constant String_Access :=
172 new String'(GNAT.Command_Line.Get_Argument);
174 begin
175 exit when S'Length = 0;
177 Object_Files.Increment_Last;
178 Object_Files.Table (Object_Files.Last) := S;
179 end;
180 end loop;
181 exception
182 when Invalid_Switch =>
183 Usage;
184 Fail ("invalid switch : " & Full_Switch);
185 end Parse_Cmd_Line;
187 -----------
188 -- Usage --
189 -----------
191 procedure Usage is
192 begin
193 Write_Line ("gnatsym [options] object_file {object_file}");
194 Write_Eol;
195 Write_Line (" -c Compliant symbol policy");
196 Write_Line (" -C Controlled symbol policy");
197 Write_Line (" -q Quiet mode");
198 Write_Line (" -r<ref> Reference symbol file name");
199 Write_Line (" -R Restricted symbol policy");
200 Write_Line (" -s<sym> Symbol file name");
201 Write_Line (" -v Verbose mode");
202 Write_Line (" -V<ver> Version");
203 Write_Eol;
204 Write_Line ("Specifying a symbol file with -s<sym> is compulsory");
205 Write_Eol;
206 end Usage;
208 -- Start of processing of Gnatsym
210 begin
211 -- Initialize Object_Files table
213 Object_Files.Set_Last (0);
215 -- Parse the command line
217 Parse_Cmd_Line;
219 if Verbose then
220 Display_Copyright;
221 end if;
223 -- If there is no symbol file or no object files on the command line,
224 -- display the usage and exit with an error status.
226 if Symbol_File_Name = null or else Object_Files.Last = 0 then
227 Usage;
228 OS_Exit (1);
230 -- When symbol policy is direct, simply copy the reference symbol file to
231 -- the symbol file.
233 elsif Symbol_Policy = Direct then
234 declare
235 File_In : Ada.Text_IO.File_Type;
236 File_Out : Ada.Text_IO.File_Type;
237 Line : String (1 .. 1_000);
238 Last : Natural;
240 begin
241 begin
242 Open (File_In, In_File, Reference_Symbol_File_Name.all);
244 exception
245 when X : others =>
246 if not Quiet then
247 Put_Line
248 ("could not open """ &
249 Reference_Symbol_File_Name.all
250 & """");
251 Put_Line (Exception_Message (X));
252 end if;
254 OS_Exit (1);
255 end;
257 begin
258 Create (File_Out, Out_File, Symbol_File_Name.all);
260 exception
261 when X : others =>
262 if not Quiet then
263 Put_Line
264 ("could not create """ & Symbol_File_Name.all & """");
265 Put_Line (Exception_Message (X));
266 end if;
268 OS_Exit (1);
269 end;
271 while not End_Of_File (File_In) loop
272 Get_Line (File_In, Line, Last);
273 Put_Line (File_Out, Line (1 .. Last));
274 end loop;
276 Close (File_In);
277 Close (File_Out);
278 end;
280 else
281 if Verbose then
282 Write_Str ("Initializing symbol file """);
283 Write_Str (Symbol_File_Name.all);
284 Write_Line ("""");
285 end if;
287 -- Initialize symbol file and, if specified, read reference file
289 Symbols.Initialize
290 (Symbol_File => Symbol_File_Name.all,
291 Reference => Reference_Symbol_File_Name.all,
292 Symbol_Policy => Symbol_Policy,
293 Quiet => Quiet,
294 Version => Version_String.all,
295 Success => Success);
297 -- Process the object files in order. Stop as soon as there is
298 -- something wrong.
300 Object_File := 0;
302 while Success and then Object_File < Object_Files.Last loop
303 Object_File := Object_File + 1;
305 if Verbose then
306 Write_Str ("Processing object file """);
307 Write_Str (Object_Files.Table (Object_File).all);
308 Write_Line ("""");
309 end if;
311 Processing.Process (Object_Files.Table (Object_File).all, Success);
312 end loop;
314 -- Finalize the object file
316 if Success then
317 if Verbose then
318 Write_Str ("Finalizing """);
319 Write_Str (Symbol_File_Name.all);
320 Write_Line ("""");
321 end if;
323 Finalize (Quiet, Success);
324 end if;
326 -- Fail if there was anything wrong
328 if not Success then
329 Fail ("unable to build symbol file");
330 end if;
331 end if;
332 end Gnatsym;