OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [symbols-vms.adb] - Blame information for rev 414

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.