1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2003-2007, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This is the VMS version of this package
28 with Ada
.Exceptions
; use Ada
.Exceptions
;
29 with Ada
.Sequential_IO
;
30 with Ada
.Text_IO
; use Ada
.Text_IO
;
32 package body Symbols
is
34 Case_Sensitive
: constant String := "case_sensitive=";
35 Symbol_Vector
: constant String := "SYMBOL_VECTOR=(";
36 Equal_Data
: constant String := "=DATA)";
37 Equal_Procedure
: constant String := "=PROCEDURE)";
38 Gsmatch
: constant String := "gsmatch=";
39 Gsmatch_Lequal
: constant String := "gsmatch=lequal,";
41 Symbol_File_Name
: String_Access
:= null;
42 -- Name of the symbol file
44 Long_Symbol_Length
: constant := 100;
45 -- Magic length of symbols, over which the lines are split
47 Sym_Policy
: Policy
:= Autonomous
;
48 -- The symbol policy. Set by Initialize
50 Major_ID
: Integer := 1;
51 -- The Major ID. May be modified by Initialize if Library_Version is
52 -- specified or if it is read from the reference symbol file.
54 Soft_Major_ID
: Boolean := True;
55 -- False if library version is specified in procedure Initialize.
56 -- When True, Major_ID may be modified if found in the reference symbol
59 Minor_ID
: Natural := 0;
60 -- The Minor ID. May be modified if read from the reference symbol file
62 Soft_Minor_ID
: Boolean := True;
63 -- False if symbol policy is Autonomous, if library version is specified
64 -- in procedure Initialize and is not the same as the major ID read from
65 -- the reference symbol file. When True, Minor_ID may be increased in
66 -- Compliant symbol policy.
68 subtype Byte
is Character;
69 -- Object files are stream of bytes, but some of these bytes, those for
70 -- the names of the symbols, are ASCII characters.
72 package Byte_IO
is new Ada
.Sequential_IO
(Byte
);
75 File
: Byte_IO
.File_Type
;
76 -- Each object file is read as a stream of bytes (characters)
78 function Equal
(Left
, Right
: Symbol_Data
) return Boolean;
79 -- Test for equality of symbols
81 function Image
(N
: Integer) return String;
82 -- Returns the image of N, without the initial space
88 function Equal
(Left
, Right
: Symbol_Data
) return Boolean is
90 return Left
.Name
/= null and then
91 Right
.Name
/= null and then
92 Left
.Name
.all = Right
.Name
.all and then
93 Left
.Kind
= Right
.Kind
and then
94 Left
.Present
= Right
.Present
;
101 function Image
(N
: Integer) return String is
102 Result
: constant String := N
'Img;
104 if Result
(Result
'First) = ' ' then
105 return Result
(Result
'First + 1 .. Result
'Last);
116 (Symbol_File
: String;
118 Symbol_Policy
: Policy
;
121 Success
: out Boolean)
123 File
: Ada
.Text_IO
.File_Type
;
124 Line
: String (1 .. 2_000
);
130 -- Record the symbol file name
132 Symbol_File_Name
:= new String'(Symbol_File);
136 Sym_Policy := Symbol_Policy;
138 -- Record the version (Major ID)
142 Soft_Major_ID := True;
146 Major_ID := Integer'Value (Version);
147 Soft_Major_ID := False;
149 if Major_ID <= 0 then
150 raise Constraint_Error;
154 when Constraint_Error =>
156 Put_Line ("Version """ & Version & """ is illegal.");
157 Put_Line ("On VMS, version must be a positive number");
166 Soft_Minor_ID := Sym_Policy /= Autonomous;
168 -- Empty the symbol tables
170 Symbol_Table.Set_Last (Original_Symbols, 0);
171 Symbol_Table.Set_Last (Complete_Symbols, 0);
173 -- Assume that everything will be fine
177 -- If policy is Compliant or Controlled, attempt to read the reference
178 -- file. If policy is Restricted, attempt to read the symbol file.
180 if Sym_Policy /= Autonomous then
182 when Autonomous | Direct =>
185 when Compliant | Controlled =>
187 Open (File, In_File, Reference);
190 when Ada.Text_IO.Name_Error =>
196 Put_Line ("could not open """ & Reference & """");
197 Put_Line (Exception_Message (X));
206 Open (File, In_File, Symbol_File);
209 when Ada.Text_IO.Name_Error =>
215 Put_Line ("could not open """ & Symbol_File & """");
216 Put_Line (Exception_Message (X));
226 while not End_Of_File (File) loop
229 Get_Line (File, Line (Offset + 1 .. Line'Last), Last);
230 exit when Line (Last) /= '-';
232 if End_Of_File (File) then
234 Put_Line ("symbol file """ & Reference &
235 """ is incorrectly formatted:");
236 Put_Line ("""" & Line (1 .. Last) & """");
248 -- Ignore empty lines
253 -- Ignore lines starting with "case_sensitive="
255 elsif Last > Case_Sensitive'Length
256 and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
260 -- Line starting with "SYMBOL_VECTOR=("
262 elsif Last > Symbol_Vector'Length
263 and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
266 -- SYMBOL_VECTOR=(<symbol>=DATA)
268 if Last > Symbol_Vector'Length + Equal_Data'Length and then
269 Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
271 Symbol_Table.Append (Original_Symbols,
273 new String'(Line
(Symbol_Vector
'Length + 1 ..
274 Last
- Equal_Data
'Length)),
278 -- SYMBOL_VECTOR=(<symbol>=PROCEDURE)
280 elsif Last
> Symbol_Vector
'Length + Equal_Procedure
'Length
282 Line
(Last
- Equal_Procedure
'Length + 1 .. Last
) =
285 Symbol_Table
.Append
(Original_Symbols
,
287 new String'(Line (Symbol_Vector'Length + 1 ..
288 Last - Equal_Procedure'Length)),
292 -- Anything else is incorrectly formatted
296 Put_Line ("symbol file """ & Reference &
297 """ is incorrectly formatted:");
298 Put_Line ("""" & Line (1 .. Last) & """");
306 -- Lines with "gsmatch=lequal," or "gsmatch=equal,"
308 elsif Last > Gsmatch'Length
309 and then Line (1 .. Gsmatch'Length) = Gsmatch
312 Start : Positive := Gsmatch'Length + 1;
313 Finish : Positive := Start;
314 OK : Boolean := True;
318 -- First, look for the first coma
321 if Start >= Last - 1 then
325 elsif Line (Start) = ',' then
336 -- If the comma is found, get the Major and the Minor IDs
340 if Line (Finish) not in '0' .. '9'
341 or else Finish >= Last - 1
347 exit when Line (Finish + 1) = ',';
349 Finish := Finish + 1;
354 ID := Integer'Value (Line (Start .. Finish));
357 -- If Soft_Major_ID is True, it means that
358 -- Library_Version was not specified.
360 if Soft_Major_ID then
363 -- If the Major ID in the reference file is different
364 -- from the Library_Version, then the Minor ID will be 0
365 -- because there is no point in taking the Minor ID in
366 -- the reference file, or incrementing it. So, we set
367 -- Soft_Minor_ID to False, so that we don't modify
368 -- the Minor_ID later.
370 elsif Major_ID /= ID then
371 Soft_Minor_ID := False;
378 if Line (Finish) not in '0' .. '9' then
383 exit when Finish = Last;
385 Finish := Finish + 1;
388 -- Only set Minor_ID if Soft_Minor_ID is True (see above)
390 if OK and then Soft_Minor_ID then
391 Minor_ID := Integer'Value (Line (Start .. Finish));
395 -- If OK is not True, that means the line is not correctly
400 Put_Line ("symbol file """ & Reference &
401 """ is incorrectly formatted");
402 Put_Line ("""" & Line (1 .. Last) & """");
411 -- Anything else is incorrectly formatted
415 Put_Line ("unexpected line in symbol file """ &
417 Put_Line ("""" & Line (1 .. Last) & """");
434 package body Processing is separate;
442 Success : out Boolean)
444 File : Ada.Text_IO.File_Type;
447 S_Data : Symbol_Data;
451 -- Most probable index in the Complete_Symbols of the current symbol
452 -- in Original_Symbol.
457 -- Nothing to be done if Initialize has never been called
459 if Symbol_File_Name = null then
464 -- First find if the symbols in the reference symbol file are also
465 -- in the object files. Note that this is not done if the policy is
466 -- Autonomous, because no reference symbol file has been read.
468 -- Expect the first symbol in the symbol file to also be the first
469 -- in Complete_Symbols.
473 for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
474 S_Data := Original_Symbols.Table (Index_1);
478 for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
479 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
481 Complete_Symbols.Table (Index_2).Present := False;
483 exit First_Object_Loop;
485 end loop First_Object_Loop;
487 -- If the symbol could not be found between Cur and Last, try
492 for Index_2 in 1 .. Cur - 1 loop
493 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
495 Complete_Symbols.Table (Index_2).Present := False;
497 exit Second_Object_Loop;
499 end loop Second_Object_Loop;
502 -- If the symbol is not found, mark it as such in the table
505 if (not Quiet) or else Sym_Policy = Controlled then
506 Put_Line ("symbol """ & S_Data.Name.all &
507 """ is no longer present in the object files");
510 if Sym_Policy = Controlled or else Sym_Policy = Restricted then
514 -- Any symbol that is undefined in the reference symbol file
515 -- triggers an increase of the Major ID, because the new
516 -- version of the library is no longer compatible with
517 -- existing executables.
519 elsif Soft_Major_ID then
520 Major_ID := Major_ID + 1;
522 Soft_Major_ID := False;
523 Soft_Minor_ID := False;
526 Original_Symbols.Table (Index_1).Present := False;
527 Free (Original_Symbols.Table (Index_1).Name);
529 if Soft_Minor_ID then
530 Minor_ID := Minor_ID + 1;
531 Soft_Minor_ID := False;
536 if Sym_Policy /= Restricted then
538 -- Append additional symbols, if any, to the Original_Symbols
541 for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
542 S_Data := Complete_Symbols.Table (Index);
544 if S_Data.Present then
546 if Sym_Policy = Controlled then
547 Put_Line ("symbol """ & S_Data.Name.all &
548 """ is not in the reference symbol file");
552 elsif Soft_Minor_ID then
553 Minor_ID := Minor_ID + 1;
554 Soft_Minor_ID := False;
557 Symbol_Table.Append (Original_Symbols, S_Data);
558 Complete_Symbols.Table (Index).Present := False;
562 -- Create the symbol file
564 Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
566 Put (File, Case_Sensitive);
567 Put_Line (File, "yes");
569 -- Put a line in the symbol file for each symbol in symbol table
571 for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
572 if Original_Symbols.Table (Index).Present then
573 Put (File, Symbol_Vector);
575 -- Split the line if symbol name length is too large
577 if Original_Symbols.Table (Index).Name'Length >
580 Put_Line (File, "-");
583 Put (File, Original_Symbols.Table (Index).Name.all);
585 if Original_Symbols.Table (Index).Name'Length >
588 Put_Line (File, "-");
591 if Original_Symbols.Table (Index).Kind = Data then
592 Put_Line (File, Equal_Data);
595 Put_Line (File, Equal_Procedure);
598 Free (Original_Symbols.Table (Index).Name);
602 Put (File, Case_Sensitive);
603 Put_Line (File, "NO");
605 -- Put the version IDs
607 Put (File, Gsmatch_Lequal);
608 Put (File, Image (Major_ID));
610 Put_Line (File, Image (Minor_ID));
618 Symbol_Table.Set_Last (Original_Symbols, 0);
619 Symbol_Table.Set_Last (Complete_Symbols, 0);
621 -- Clear the symbol file name
623 Free (Symbol_File_Name);
631 Put_Line ("unexpected exception raised while finalizing """
632 & Symbol_File_Name.all & """");
633 Put_Line (Exception_Information (X));