?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Fix DealII type problems.
[official-gcc/Ramakrishna.git] / gcc / ada / symbols-vms.adb
blob39c9beb3202b07265995a85ab936ce9744d81b62
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-2007, 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 is the VMS version of this package
27
28 with Ada.Exceptions; use Ada.Exceptions;
29 with Ada.Sequential_IO;
30 with Ada.Text_IO; use Ada.Text_IO;
31
32 package body Symbols is
33
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,";
40
41 Symbol_File_Name : String_Access := null;
42 -- Name of the symbol file
43
44 Long_Symbol_Length : constant := 100;
45 -- Magic length of symbols, over which the lines are split
46
47 Sym_Policy : Policy := Autonomous;
48 -- The symbol policy. Set by Initialize
49
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.
53
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
57 -- file.
58
59 Minor_ID : Natural := 0;
60 -- The Minor ID. May be modified if read from the reference symbol file
61
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.
67
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.
71
72 package Byte_IO is new Ada.Sequential_IO (Byte);
73 use Byte_IO;
74
75 File : Byte_IO.File_Type;
76 -- Each object file is read as a stream of bytes (characters)
77
78 function Equal (Left, Right : Symbol_Data) return Boolean;
79 -- Test for equality of symbols
80
81 function Image (N : Integer) return String;
82 -- Returns the image of N, without the initial space
83
84 -----------
85 -- Equal --
86 -----------
87
88 function Equal (Left, Right : Symbol_Data) return Boolean is
89 begin
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;
95 end Equal;
96
97 -----------
98 -- Image --
99 -----------
100
101 function Image (N : Integer) return String is
102 Result : constant String := N'Img;
103 begin
104 if Result (Result'First) = ' ' then
105 return Result (Result'First + 1 .. Result'Last);
106 else
107 return Result;
108 end if;
109 end Image;
110
111 ----------------
112 -- Initialize --
113 ----------------
114
115 procedure Initialize
116 (Symbol_File : String;
117 Reference : String;
118 Symbol_Policy : Policy;
119 Quiet : Boolean;
120 Version : String;
121 Success : out Boolean)
122 is
123 File : Ada.Text_IO.File_Type;
124 Line : String (1 .. 2_000);
125 Last : Natural;
126
127 Offset : Natural;
128
129 begin
130 -- Record the symbol file name
131
132 Symbol_File_Name := new String'(Symbol_File);
133
134 -- Record the policy
135
136 Sym_Policy := Symbol_Policy;
137
138 -- Record the version (Major ID)
139
140 if Version = "" then
141 Major_ID := 1;
142 Soft_Major_ID := True;
143
144 else
145 begin
146 Major_ID := Integer'Value (Version);
147 Soft_Major_ID := False;
148
149 if Major_ID <= 0 then
150 raise Constraint_Error;
151 end if;
152
153 exception
154 when Constraint_Error =>
155 if not Quiet then
156 Put_Line ("Version """ & Version & """ is illegal.");
157 Put_Line ("On VMS, version must be a positive number");
158 end if;
159
160 Success := False;
161 return;
162 end;
163 end if;
164
165 Minor_ID := 0;
166 Soft_Minor_ID := Sym_Policy /= Autonomous;
167
168 -- Empty the symbol tables
169
170 Symbol_Table.Set_Last (Original_Symbols, 0);
171 Symbol_Table.Set_Last (Complete_Symbols, 0);
172
173 -- Assume that everything will be fine
174
175 Success := True;
176
177 -- If policy is Compliant or Controlled, attempt to read the reference
178 -- file. If policy is Restricted, attempt to read the symbol file.
179
180 if Sym_Policy /= Autonomous then
181 case Sym_Policy is
182 when Autonomous | Direct =>
183 null;
184
185 when Compliant | Controlled =>
186 begin
187 Open (File, In_File, Reference);
188
189 exception
190 when Ada.Text_IO.Name_Error =>
191 Success := False;
192 return;
193
194 when X : others =>
195 if not Quiet then
196 Put_Line ("could not open """ & Reference & """");
197 Put_Line (Exception_Message (X));
198 end if;
199
200 Success := False;
201 return;
202 end;
203
204 when Restricted =>
205 begin
206 Open (File, In_File, Symbol_File);
207
208 exception
209 when Ada.Text_IO.Name_Error =>
210 Success := False;
211 return;
212
213 when X : others =>
214 if not Quiet then
215 Put_Line ("could not open """ & Symbol_File & """");
216 Put_Line (Exception_Message (X));
217 end if;
218
219 Success := False;
220 return;
221 end;
222 end case;
223
224 -- Read line by line
225
226 while not End_Of_File (File) loop
227 Offset := 0;
228 loop
229 Get_Line (File, Line (Offset + 1 .. Line'Last), Last);
230 exit when Line (Last) /= '-';
231
232 if End_Of_File (File) then
233 if not Quiet then
234 Put_Line ("symbol file """ & Reference &
235 """ is incorrectly formatted:");
236 Put_Line ("""" & Line (1 .. Last) & """");
237 end if;
238
239 Close (File);
240 Success := False;
241 return;
242
243 else
244 Offset := Last - 1;
245 end if;
246 end loop;
247
248 -- Ignore empty lines
249
250 if Last = 0 then
251 null;
252
253 -- Ignore lines starting with "case_sensitive="
254
255 elsif Last > Case_Sensitive'Length
256 and then Line (1 .. Case_Sensitive'Length) = Case_Sensitive
257 then
258 null;
259
260 -- Line starting with "SYMBOL_VECTOR=("
261
262 elsif Last > Symbol_Vector'Length
263 and then Line (1 .. Symbol_Vector'Length) = Symbol_Vector
264 then
265
266 -- SYMBOL_VECTOR=(<symbol>=DATA)
267
268 if Last > Symbol_Vector'Length + Equal_Data'Length and then
269 Line (Last - Equal_Data'Length + 1 .. Last) = Equal_Data
270 then
271 Symbol_Table.Append (Original_Symbols,
272 (Name =>
273 new String'(Line (Symbol_Vector'Length + 1 ..
274 Last - Equal_Data'Length)),
275 Kind => Data,
276 Present => True));
277
278 -- SYMBOL_VECTOR=(<symbol>=PROCEDURE)
279
280 elsif Last > Symbol_Vector'Length + Equal_Procedure'Length
281 and then
282 Line (Last - Equal_Procedure'Length + 1 .. Last) =
283 Equal_Procedure
284 then
285 Symbol_Table.Append (Original_Symbols,
286 (Name =>
287 new String'(Line (Symbol_Vector'Length + 1 ..
288 Last - Equal_Procedure'Length)),
289 Kind => Proc,
290 Present => True));
291
292 -- Anything else is incorrectly formatted
293
294 else
295 if not Quiet then
296 Put_Line ("symbol file """ & Reference &
297 """ is incorrectly formatted:");
298 Put_Line ("""" & Line (1 .. Last) & """");
299 end if;
300
301 Close (File);
302 Success := False;
303 return;
304 end if;
305
306 -- Lines with "gsmatch=lequal," or "gsmatch=equal,"
307
308 elsif Last > Gsmatch'Length
309 and then Line (1 .. Gsmatch'Length) = Gsmatch
310 then
311 declare
312 Start : Positive := Gsmatch'Length + 1;
313 Finish : Positive := Start;
314 OK : Boolean := True;
315 ID : Integer;
316
317 begin
318 -- First, look for the first coma
319
320 loop
321 if Start >= Last - 1 then
322 OK := False;
323 exit;
324
325 elsif Line (Start) = ',' then
326 Start := Start + 1;
327 exit;
328
329 else
330 Start := Start + 1;
331 end if;
332 end loop;
333
334 Finish := Start;
335
336 -- If the comma is found, get the Major and the Minor IDs
337
338 if OK then
339 loop
340 if Line (Finish) not in '0' .. '9'
341 or else Finish >= Last - 1
342 then
343 OK := False;
344 exit;
345 end if;
346
347 exit when Line (Finish + 1) = ',';
348
349 Finish := Finish + 1;
350 end loop;
351 end if;
352
353 if OK then
354 ID := Integer'Value (Line (Start .. Finish));
355 OK := ID /= 0;
356
357 -- If Soft_Major_ID is True, it means that
358 -- Library_Version was not specified.
359
360 if Soft_Major_ID then
361 Major_ID := ID;
362
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.
369
370 elsif Major_ID /= ID then
371 Soft_Minor_ID := False;
372 end if;
373
374 Start := Finish + 2;
375 Finish := Start;
376
377 loop
378 if Line (Finish) not in '0' .. '9' then
379 OK := False;
380 exit;
381 end if;
382
383 exit when Finish = Last;
384
385 Finish := Finish + 1;
386 end loop;
387
388 -- Only set Minor_ID if Soft_Minor_ID is True (see above)
389
390 if OK and then Soft_Minor_ID then
391 Minor_ID := Integer'Value (Line (Start .. Finish));
392 end if;
393 end if;
394
395 -- If OK is not True, that means the line is not correctly
396 -- formatted.
397
398 if not OK then
399 if not Quiet then
400 Put_Line ("symbol file """ & Reference &
401 """ is incorrectly formatted");
402 Put_Line ("""" & Line (1 .. Last) & """");
403 end if;
404
405 Close (File);
406 Success := False;
407 return;
408 end if;
409 end;
410
411 -- Anything else is incorrectly formatted
412
413 else
414 if not Quiet then
415 Put_Line ("unexpected line in symbol file """ &
416 Reference & """");
417 Put_Line ("""" & Line (1 .. Last) & """");
418 end if;
419
420 Close (File);
421 Success := False;
422 return;
423 end if;
424 end loop;
425
426 Close (File);
427 end if;
428 end Initialize;
429
430 ----------------
431 -- Processing --
432 ----------------
433
434 package body Processing is separate;
435
436 --------------
437 -- Finalize --
438 --------------
439
440 procedure Finalize
441 (Quiet : Boolean;
442 Success : out Boolean)
443 is
444 File : Ada.Text_IO.File_Type;
445 -- The symbol file
446
447 S_Data : Symbol_Data;
448 -- A symbol
449
450 Cur : Positive := 1;
451 -- Most probable index in the Complete_Symbols of the current symbol
452 -- in Original_Symbol.
453
454 Found : Boolean;
455
456 begin
457 -- Nothing to be done if Initialize has never been called
458
459 if Symbol_File_Name = null then
460 Success := False;
461
462 else
463
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.
467
468 -- Expect the first symbol in the symbol file to also be the first
469 -- in Complete_Symbols.
470
471 Cur := 1;
472
473 for Index_1 in 1 .. Symbol_Table.Last (Original_Symbols) loop
474 S_Data := Original_Symbols.Table (Index_1);
475 Found := False;
476
477 First_Object_Loop :
478 for Index_2 in Cur .. Symbol_Table.Last (Complete_Symbols) loop
479 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
480 Cur := Index_2 + 1;
481 Complete_Symbols.Table (Index_2).Present := False;
482 Found := True;
483 exit First_Object_Loop;
484 end if;
485 end loop First_Object_Loop;
486
487 -- If the symbol could not be found between Cur and Last, try
488 -- before Cur.
489
490 if not Found then
491 Second_Object_Loop :
492 for Index_2 in 1 .. Cur - 1 loop
493 if Equal (S_Data, Complete_Symbols.Table (Index_2)) then
494 Cur := Index_2 + 1;
495 Complete_Symbols.Table (Index_2).Present := False;
496 Found := True;
497 exit Second_Object_Loop;
498 end if;
499 end loop Second_Object_Loop;
500 end if;
501
502 -- If the symbol is not found, mark it as such in the table
503
504 if not Found then
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");
508 end if;
509
510 if Sym_Policy = Controlled or else Sym_Policy = Restricted then
511 Success := False;
512 return;
513
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.
518
519 elsif Soft_Major_ID then
520 Major_ID := Major_ID + 1;
521 Minor_ID := 0;
522 Soft_Major_ID := False;
523 Soft_Minor_ID := False;
524 end if;
525
526 Original_Symbols.Table (Index_1).Present := False;
527 Free (Original_Symbols.Table (Index_1).Name);
528
529 if Soft_Minor_ID then
530 Minor_ID := Minor_ID + 1;
531 Soft_Minor_ID := False;
532 end if;
533 end if;
534 end loop;
535
536 if Sym_Policy /= Restricted then
537
538 -- Append additional symbols, if any, to the Original_Symbols
539 -- table.
540
541 for Index in 1 .. Symbol_Table.Last (Complete_Symbols) loop
542 S_Data := Complete_Symbols.Table (Index);
543
544 if S_Data.Present then
545
546 if Sym_Policy = Controlled then
547 Put_Line ("symbol """ & S_Data.Name.all &
548 """ is not in the reference symbol file");
549 Success := False;
550 return;
551
552 elsif Soft_Minor_ID then
553 Minor_ID := Minor_ID + 1;
554 Soft_Minor_ID := False;
555 end if;
556
557 Symbol_Table.Append (Original_Symbols, S_Data);
558 Complete_Symbols.Table (Index).Present := False;
559 end if;
560 end loop;
561
562 -- Create the symbol file
563
564 Create (File, Ada.Text_IO.Out_File, Symbol_File_Name.all);
565
566 Put (File, Case_Sensitive);
567 Put_Line (File, "yes");
568
569 -- Put a line in the symbol file for each symbol in symbol table
570
571 for Index in 1 .. Symbol_Table.Last (Original_Symbols) loop
572 if Original_Symbols.Table (Index).Present then
573 Put (File, Symbol_Vector);
574
575 -- Split the line if symbol name length is too large
576
577 if Original_Symbols.Table (Index).Name'Length >
578 Long_Symbol_Length
579 then
580 Put_Line (File, "-");
581 end if;
582
583 Put (File, Original_Symbols.Table (Index).Name.all);
584
585 if Original_Symbols.Table (Index).Name'Length >
586 Long_Symbol_Length
587 then
588 Put_Line (File, "-");
589 end if;
590
591 if Original_Symbols.Table (Index).Kind = Data then
592 Put_Line (File, Equal_Data);
593
594 else
595 Put_Line (File, Equal_Procedure);
596 end if;
597
598 Free (Original_Symbols.Table (Index).Name);
599 end if;
600 end loop;
601
602 Put (File, Case_Sensitive);
603 Put_Line (File, "NO");
604
605 -- Put the version IDs
606
607 Put (File, Gsmatch_Lequal);
608 Put (File, Image (Major_ID));
609 Put (File, ',');
610 Put_Line (File, Image (Minor_ID));
611
612 -- And we are done
613
614 Close (File);
615
616 -- Reset both tables
617
618 Symbol_Table.Set_Last (Original_Symbols, 0);
619 Symbol_Table.Set_Last (Complete_Symbols, 0);
620
621 -- Clear the symbol file name
622
623 Free (Symbol_File_Name);
624 end if;
625
626 Success := True;
627 end if;
628
629 exception
630 when X : others =>
631 Put_Line ("unexpected exception raised while finalizing """
632 & Symbol_File_Name.all & """");
633 Put_Line (Exception_Information (X));
634 Success := False;
635 end Finalize;
636
637 end Symbols;
Sandbox for GRAPHITE tests