?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* gnu/regexp/CharIndexedReader.java: Removed.
[official-gcc.git] / gcc / ada / symbols-vms.adb
blobc623e42b383a7a1dfff1a5384752791e0e007805
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S Y M B O L S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2003 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
26
27 -- This is the VMS version of this package
28
29 with Ada.Exceptions; use Ada.Exceptions;
30 with Ada.Sequential_IO;
31 with Ada.Text_IO; use Ada.Text_IO;
32
33 package body Symbols is
34
35 Case_Sensitive : constant String := "case_sensitive=";
36 Symbol_Vector : constant String := "SYMBOL_VECTOR=(";
37 Equal_Data : constant String := "=DATA)";
38 Equal_Procedure : constant String := "=PROCEDURE)";
39 Gsmatch : constant String := "gsmatch=equal,";
40
41 Symbol_File_Name : String_Access := null;
42 -- Name of the symbol file
43
44 Sym_Policy : Policy := Autonomous;
45 -- The symbol policy. Set by Initialize
46
47 Major_ID : Integer := 1;
48 -- The Major ID. May be modified by Initialize if Library_Version is
49 -- specified or if it is read from the reference symbol file.
50
51 Soft_Major_ID : Boolean := True;
52 -- False if library version is specified in procedure Initialize.
53 -- When True, Major_ID may be modified if found in the reference symbol
54 -- file.
55
56 Minor_ID : Natural := 0;
57 -- The Minor ID. May be modified if read from the reference symbol file
58
59 Soft_Minor_ID : Boolean := True;
60 -- False if symbol policy is Autonomous, if library version is specified
61 -- in procedure Initialize and is not the same as the major ID read from
62 -- the reference symbol file. When True, Minor_ID may be increased in
63 -- Compliant symbol policy.
64
65 subtype Byte is Character;
66 -- Object files are stream of bytes, but some of these bytes, those for
67 -- the names of the symbols, are ASCII characters.
68
69 package Byte_IO is new Ada.Sequential_IO (Byte);
70 use Byte_IO;
71
72 type Number is mod 2**16;
73 -- 16 bits unsigned number for number of characters
74
75 GSD : constant Number := 10;
76 -- Code for the Global Symbol Definition section
77
78 C_SYM : constant Number := 1;
79 -- Code for a Symbol subsection
80
81 V_DEF_Mask : constant Number := 2**1;
82 V_NORM_Mask : constant Number := 2**6;
83
84 File : Byte_IO.File_Type;
85 -- Each object file is read as a stream of bytes (characters)
86
87 B : Byte;
88
89 Number_Of_Characters : Natural := 0;
90 -- The number of characters of each section
91
92 -- The following variables are used by procedure Process when reading an
93 -- object file.
94
95 Code : Number := 0;
96 Length : Natural := 0;
97
98 Dummy : Number;
99
100 Nchars : Natural := 0;
101 Flags : Number := 0;
102
103 Symbol : String (1 .. 255);
104 LSymb : Natural;
105
106 function Equal (Left, Right : Symbol_Data) return Boolean;
107 -- Test for equality of symbols
108
109 procedure Get (N : out Number);
110 -- Read two bytes from the object file LSB first as unsigned 16 bit number
111
112 procedure Get (N : out Natural);
113 -- Read two bytes from the object file, LSByte first, as a Natural
114
115
116 function Image (N : Integer) return String;
117 -- Returns the image of N, without the initial space
118
119 -----------
120 -- Equal --
121 -----------
122
123 function Equal (Left, Right : Symbol_Data) return Boolean is
124 begin
125 return Left.Name /= null and then
126 Right.Name /= null and then
127 Left.Name.all = Right.Name.all and then
128 Left.Kind = Right.Kind and then
129 Left.Present = Right.Present;
130 end Equal;
131
132 ---------
133 -- Get --
134 ---------
135
136 procedure Get (N : out Number) is
137 C : Byte;
138 LSByte : Number;
139 begin
140 Read (File, C);
141 LSByte := Byte'Pos (C);
142 Read (File, C);
143 N := LSByte + (256 * Byte'Pos (C));
144 end Get;
145
146 procedure Get (N : out Natural) is
147 Result : Number;
148 begin
149 Get (Result);
150 N := Natural (Result);
151 end Get;
152
153 -----------
154 -- Image --
155 -----------
156
157 function Image (N : Integer) return String is
158 Result : constant String := N'Img;
159 begin
160 if Result (Result'First) = ' ' then
161 return Result (Result'First + 1 .. Result'Last);
162
163 else
164 return Result;
165 end if;
166 end Image;
167
168 ----------------
169 -- Initialize --
170 ----------------
171
172 procedure Initialize
173 (Symbol_File : String;
174 Reference : String;
175 Symbol_Policy : Policy;
176 Quiet : Boolean;
177 Version : String;
178 Success : out Boolean)
179 is
180 File : Ada.Text_IO.File_Type;
181 Line : String (1 .. 1_000);
182 Last : Natural;
183
184 begin
185 -- Record the symbol file name
186
187 Symbol_File_Name := new String'(Symbol_File);
188
189 -- Record the policy
190
191 Sym_Policy := Symbol_Policy;
192
193 -- Record the version (Major ID)
194
195 if Version = "" then
196 Major_ID := 1;
197 Soft_Major_ID := True;
198
199 else
200 begin
201 Major_ID := Integer'Value (Version);
202 Soft_Major_ID := False;
203
204 if Major_ID <= 0 then
205 raise Constraint_Error;
206 end if;
207
208 exception
209 when Constraint_Error =>
210 if not Quiet then
211 Put_Line ("Version """ & Version & """ is illegal.");
212 Put_Line ("On VMS, version must be a positive number");
213 end if;
214
215 Success := False;
216 return;
217 end;
218 end if;
219
220 Minor_ID := 0;
221 Soft_Minor_ID := Sym_Policy /= Autonomous;
222
223 -- Empty the symbol tables
224
225 Symbol_Table.Set_Last (Original_Symbols, 0);
226 Symbol_Table.Set_Last (Complete_Symbols, 0);
227
228 -- Assume that everything will be fine
229
230 Success := True;
231
232 -- If policy is not autonomous, attempt to read the reference file
233
234 if Sym_Policy /= Autonomous then
235 begin
236 Open (File, In_File, Reference);
237
238 exception
239 when Ada.Text_IO.Name_Error =>
240 return;
241
242 when X : others =>
243 if not Quiet then
244 Put_Line ("could not open """ & Reference & """");
245 Put_Line (Exception_Message (X));
246 end if;
247
248 Success := False;
249 return;
250 end;
251
252 -- Read line by line
253
254 while not End_Of_File (File) loop
255 Get_Line (File, Line, Last);
256
257 -- Ignore empty lines
258
259 if Last = 0 then
260 null;
261
262 -- Ignore lines starting with "case_sensitive="
263
264 elsif Last > Case_Sensitive'Length
265 and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
266 then
267 null;
268
269 -- Line starting with "SYMBOL_VECTOR=("
270
271 elsif Last > Symbol_Vector'Length
272 and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
273 then
274
275 -- SYMBOL_VECTOR=(<symbol>=DATA)
276
277 if Last > Symbol_Vector'Length + Equal_Data'Length and then
278 Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
279 then
280 Symbol_Table.Increment_Last (Original_Symbols);
281 Original_Symbols.Table
282 (Symbol_Table.Last (Original_Symbols)) :=
283 (Name =>
284 new String'(Line (Symbol_Vector'Length + 1 ..
285 Last - Equal_Data'Length)),
286 Kind => Data,
287 Present => True);
288
289 -- SYMBOL_VECTOR=(<symbol>=PROCEDURE)
290
291 elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
292 and then
293 Line (Last - Equal_Procedure'Length + 1 .. Last) =
294 Equal_Procedure
295 then
296 Symbol_Table.Increment_Last (Original_Symbols);
297 Original_Symbols.Table
298 (Symbol_Table.Last (Original_Symbols)) :=
299 (Name =>
300 new String'(Line (Symbol_Vector'Length + 1 ..
301 Last - Equal_Procedure'Length)),
302 Kind => Proc,
303 Present => True);
304
305 -- Anything else is incorrectly formatted
306
307 else
308 if not Quiet then
309 Put_Line ("symbol file """ & Reference &
310 """ is incorrectly formatted:");
311 Put_Line ("""" & Line (1 .. Last) & """");
312 end if;
313
314 Close (File);
315 Success := False;
316 return;
317 end if;
318
319 -- Lines with "gsmatch=equal,<Major_ID>,<Minor_Id>
320
321 elsif Last > Gsmatch'Length
322 and then Line (1 .. Gsmatch'Length) = Gsmatch
323 then
324 declare
325 Start : Positive := Gsmatch'Length + 1;
326 Finish : Positive := Start;
327 OK : Boolean := True;
328 ID : Integer;
329
330 begin
331 loop
332 if Line (Finish) not in '0' .. '9'
333 or else Finish >= Last - 1
334 then
335 OK := False;
336 exit;
337 end if;
338
339 exit when Line (Finish + 1) = ',';
340
341 Finish := Finish + 1;
342 end loop;
343
344 if OK then
345 ID := Integer'Value (Line (Start .. Finish));
346 OK := ID /= 0;
347
348 -- If Soft_Major_ID is True, it means that
349 -- Library_Version was not specified.
350
351 if Soft_Major_ID then
352 Major_ID := ID;
353
354 -- If the Major ID in the reference file is different
355 -- from the Library_Version, then the Minor ID will be 0
356 -- because there is no point in taking the Minor ID in
357 -- the reference file, or incrementing it. So, we set
358 -- Soft_Minor_ID to False, so that we don't modify
359 -- the Minor_ID later.
360
361 elsif Major_ID /= ID then
362 Soft_Minor_ID := False;
363 end if;
364
365 Start := Finish + 2;
366 Finish := Start;
367
368 loop
369 if Line (Finish) not in '0' .. '9' then
370 OK := False;
371 exit;
372 end if;
373
374 exit when Finish = Last;
375
376 Finish := Finish + 1;
377 end loop;
378
379 -- Only set Minor_ID if Soft_Minor_ID is True (see above)
380
381 if OK and then Soft_Minor_ID then
382 Minor_ID := Integer'Value (Line (Start .. Finish));
383 end if;
384 end if;
385
386 -- If OK is not True, that means the line is not correctly
387 -- formatted.
388
389 if not OK then
390 if not Quiet then
391 Put_Line ("symbol file """ & Reference &
392 """ is incorrectly formatted");
393 Put_Line ("""" & Line (1 .. Last) & """");
394 end if;
395
396 Close (File);
397 Success := False;
398 return;
399 end if;
400 end;
401
402 -- Anything else is incorrectly formatted
403
404 else
405 if not Quiet then
406 Put_Line ("unexpected line in symbol file """ &
407 Reference & """");
408 Put_Line ("""" & Line (1 .. Last) & """");
409 end if;
410
411 Close (File);
412 Success := False;
413 return;
414 end if;
415 end loop;
416
417 Close (File);
418 end if;
419 end Initialize;
420
421 -------------
422 -- Process --
423 -------------
424
425 procedure Process
426 (Object_File : String;
427 Success : out Boolean)
428 is
429 begin
430 -- Open the object file with Byte_IO. Return with Success = False if
431 -- this fails.
432
433 begin
434 Open (File, In_File, Object_File);
435 exception
436 when others =>
437 Put_Line
438 ("*** Unable to open object file """ & Object_File & """");
439 Success := False;
440 return;
441 end;
442
443 -- Assume that the object file has a correct format
444
445 Success := True;
446
447 -- Get the different sections one by one from the object file
448
449 while not End_Of_File (File) loop
450
451 Get (Code);
452 Get (Number_Of_Characters);
453 Number_Of_Characters := Number_Of_Characters - 4;
454
455 -- If this is not a Global Symbol Definition section, skip to the
456 -- next section.
457
458 if Code /= GSD then
459
460 for J in 1 .. Number_Of_Characters loop
461 Read (File, B);
462 end loop;
463
464 else
465
466 -- Skip over the next 4 bytes
467
468 Get (Dummy);
469 Get (Dummy);
470 Number_Of_Characters := Number_Of_Characters - 4;
471
472 -- Get each subsection in turn
473
474 loop
475 Get (Code);
476 Get (Nchars);
477 Get (Dummy);
478 Get (Flags);
479 Number_Of_Characters := Number_Of_Characters - 8;
480 Nchars := Nchars - 8;
481
482 -- If this is a symbol and the V_DEF flag is set, get the
483 -- symbol.
484
485 if Code = C_SYM and then ((Flags and V_DEF_Mask) /= 0) then
486 -- First, reach the symbol length
487
488 for J in 1 .. 25 loop
489 Read (File, B);
490 Nchars := Nchars - 1;
491 Number_Of_Characters := Number_Of_Characters - 1;
492 end loop;
493
494 Length := Byte'Pos (B);
495 LSymb := 0;
496
497 -- Get the symbol characters
498
499 for J in 1 .. Nchars loop
500 Read (File, B);
501 Number_Of_Characters := Number_Of_Characters - 1;
502 if Length > 0 then
503 LSymb := LSymb + 1;
504 Symbol (LSymb) := B;
505 Length := Length - 1;
506 end if;
507 end loop;
508
509 -- Create the new Symbol
510
511 declare
512 S_Data : Symbol_Data;
513 begin
514 S_Data.Name := new String'(Symbol (1 .. LSymb));
515
516 -- The symbol kind (Data or Procedure) depends on the
517 -- V_NORM flag.
518
519 if (Flags and V_NORM_Mask) = 0 then
520 S_Data.Kind := Data;
521
522 else
523 S_Data.Kind := Proc;
524 end if;
525
526 -- Put the new symbol in the table
527
528 Symbol_Table.Increment_Last (Complete_Symbols);
529 Complete_Symbols.Table
530 (Symbol_Table.Last (Complete_Symbols)) := S_Data;
531 end;
532
533 else
534 -- As it is not a symbol subsection, skip to the next
535 -- subsection.
536
537 for J in 1 .. Nchars loop
538 Read (File, B);
539 Number_Of_Characters := Number_Of_Characters - 1;
540 end loop;
541 end if;
542
543 -- Exit the GSD section when number of characters reaches 0
544
545 exit when Number_Of_Characters = 0;
546 end loop;
547 end if;
548 end loop;
549
550 -- The object file has been processed, close it
551
552 Close (File);
553
554 exception
555 -- For any exception, output an error message, close the object file
556 -- and return with Success = False.
557
558 when X : others =>
559 Put_Line ("unexpected exception raised while processing """
560 & Object_File & """");
561 Put_Line (Exception_Information (X));
562 Close (File);
563 Success := False;
564 end Process;
565
566 --------------
567 -- Finalize --
568 --------------
569
570 procedure Finalize
571 (Quiet : Boolean;
572 Success : out Boolean)
573 is
574 File : Ada.Text_IO.File_Type;
575 -- The symbol file
576
577 S_Data : Symbol_Data;
578 -- A symbol
579
580 Cur : Positive := 1;
581 -- Most probable index in the Complete_Symbols of the current symbol
582 -- in Original_Symbol.
583
584 Found : Boolean;
585
586 begin
587 -- Nothing to be done if Initialize has never been called
588
589 if Symbol_File_Name = null then
590 Success := False;
591
592 else
593
594 -- First find if the symbols in the reference symbol file are also
595 -- in the object files. Note that this is not done if the policy is
596 -- Autonomous, because no reference symbol file has been read.
597
598 -- Expect the first symbol in the symbol file to also be the first
599 -- in Complete_Symbols.
600
601 Cur := 1;
602
603 for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
604 S_Data := Original_Symbols.Table (Index_1);
605 Found := False;
606
607 First_Object_Loop :
608 for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
609 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
610 Cur := Index_2 + 1;
611 Complete_Symbols.Table (Index_2).Present := False;
612 Found := True;
613 exit First_Object_Loop;
614 end if;
615 end loop First_Object_Loop;
616
617 -- If the symbol could not be found between Cur and Last, try
618 -- before Cur.
619
620 if not Found then
621 Second_Object_Loop :
622 for Index_2 in 1 .. Cur - 1 loop
623 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
624 Cur := Index_2 + 1;
625 Complete_Symbols.Table (Index_2).Present := False;
626 Found := True;
627 exit Second_Object_Loop;
628 end if;
629 end loop Second_Object_Loop;
630 end if;
631
632 -- If the symbol is not found, mark it as such in the table
633
634 if not Found then
635 if (not Quiet) or else Sym_Policy = Controlled then
636 Put_Line ("symbol """ & S_Data.Name.all &
637 """ is no longer present in the object files");
638 end if;
639
640 if Sym_Policy = Controlled then
641 Success := False;
642 return;
643
644 elsif Soft_Minor_ID then
645 Minor_ID := Minor_ID + 1;
646 Soft_Minor_ID := False;
647 end if;
648
649 Original_Symbols.Table (Index_1).Present := False;
650 Free (Original_Symbols.Table (Index_1).Name);
651
652 if Soft_Minor_ID then
653 Minor_ID := Minor_ID + 1;
654 Soft_Minor_ID := False;
655 end if;
656 end if;
657 end loop;
658
659 -- Append additional symbols, if any, to the Original_Symbols table
660
661 for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
662 S_Data := Complete_Symbols.Table (Index);
663
664 if S_Data.Present then
665
666 if Sym_Policy = Controlled then
667 Put_Line ("symbol """ & S_Data.Name.all &
668 """ is not in the reference symbol file");
669 Success := False;
670 return;
671
672 elsif Soft_Minor_ID then
673 Minor_ID := Minor_ID + 1;
674 Soft_Minor_ID := False;
675 end if;
676
677 Symbol_Table.Increment_Last (Original_Symbols);
678 Original_Symbols.Table (Symbol_Table.Last (Original_Symbols)) :=
679 S_Data;
680 Complete_Symbols.Table (Index).Present := False;
681 end if;
682 end loop;
683
684 -- Create the symbol file
685
686 Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
687
688 Put (File, Case_Sensitive);
689 Put_Line (File, "yes");
690
691 -- Put a line in the symbol file for each symbol in the symbol table
692
693 for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
694 if Original_Symbols.Table (Index).Present then
695 Put (File, Symbol_Vector);
696 Put (File, Original_Symbols.Table (Index).Name.all);
697
698 if Original_Symbols.Table (Index).Kind = Data then
699 Put_Line (File, Equal_Data);
700
701 else
702 Put_Line (File, Equal_Procedure);
703 end if;
704
705 Free (Original_Symbols.Table (Index).Name);
706 end if;
707 end loop;
708
709 Put (File, Case_Sensitive);
710 Put_Line (File, "NO");
711
712 -- Put the version IDs
713
714 Put (File, Gsmatch);
715 Put (File, Image (Major_ID));
716 Put (File, ',');
717 Put_Line (File, Image (Minor_ID));
718
719 -- And we are done
720
721 Close (File);
722
723 -- Reset both tables
724
725 Symbol_Table.Set_Last (Original_Symbols, 0);
726 Symbol_Table.Set_Last (Complete_Symbols, 0);
727
728 -- Clear the symbol file name
729
730 Free (Symbol_File_Name);
731
732 Success := True;
733 end if;
734
735 exception
736 when X : others =>
737 Put_Line ("unexpected exception raised while finalizing """
738 & Symbol_File_Name.all & """");
739 Put_Line (Exception_Information (X));
740 Success := False;
741 end Finalize;
742
743 end Symbols;
Mirror of the offical gcc git repository hosted at gcc.gnu.org