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/] [fmap.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
--                                 F M A P                                  --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2001-2009, 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
with Opt;    use Opt;
27
with Osint;  use Osint;
28
with Output; use Output;
29
with Table;
30
with Types;  use Types;
31
 
32
with System.OS_Lib; use System.OS_Lib;
33
 
34
with Unchecked_Conversion;
35
 
36
with GNAT.HTable;
37
 
38
package body Fmap is
39
 
40
   No_Mapping_File : Boolean := False;
41
   --  Set to True when the specified mapping file cannot be read in
42
   --  procedure Initialize, so that no attempt is made to open the mapping
43
   --  file in procedure Update_Mapping_File.
44
 
45
   function To_Big_String_Ptr is new Unchecked_Conversion
46
     (Source_Buffer_Ptr, Big_String_Ptr);
47
 
48
   Max_Buffer : constant := 1_500;
49
   Buffer : String (1 .. Max_Buffer);
50
   --  Used to bufferize output when writing to a new mapping file
51
 
52
   Buffer_Last : Natural := 0;
53
   --  Index of last valid character in Buffer
54
 
55
   type Mapping is record
56
      Uname : Unit_Name_Type;
57
      Fname : File_Name_Type;
58
   end record;
59
 
60
   package File_Mapping is new Table.Table (
61
     Table_Component_Type => Mapping,
62
     Table_Index_Type     => Int,
63
     Table_Low_Bound      => 0,
64
     Table_Initial        => 1_000,
65
     Table_Increment      => 1_000,
66
     Table_Name           => "Fmap.File_Mapping");
67
   --  Mapping table to map unit names to file names
68
 
69
   package Path_Mapping is new Table.Table (
70
     Table_Component_Type => Mapping,
71
     Table_Index_Type     => Int,
72
     Table_Low_Bound      => 0,
73
     Table_Initial        => 1_000,
74
     Table_Increment      => 1_000,
75
     Table_Name           => "Fmap.Path_Mapping");
76
   --  Mapping table to map file names to path names
77
 
78
   type Header_Num is range 0 .. 1_000;
79
 
80
   function Hash (F : Unit_Name_Type) return Header_Num;
81
   --  Function used to compute hash of unit name
82
 
83
   No_Entry : constant Int := -1;
84
   --  Signals no entry in following table
85
 
86
   package Unit_Hash_Table is new GNAT.HTable.Simple_HTable (
87
     Header_Num => Header_Num,
88
     Element    => Int,
89
     No_Element => No_Entry,
90
     Key        => Unit_Name_Type,
91
     Hash       => Hash,
92
     Equal      => "=");
93
   --  Hash table to map unit names to file names. Used in conjunction with
94
   --  table File_Mapping above.
95
 
96
   function Hash (F : File_Name_Type) return Header_Num;
97
   --  Function used to compute hash of file name
98
 
99
   package File_Hash_Table is new GNAT.HTable.Simple_HTable (
100
     Header_Num => Header_Num,
101
     Element    => Int,
102
     No_Element => No_Entry,
103
     Key        => File_Name_Type,
104
     Hash       => Hash,
105
     Equal      => "=");
106
   --  Hash table to map file names to path names. Used in conjunction with
107
   --  table Path_Mapping above.
108
 
109
   Last_In_Table : Int := 0;
110
 
111
   package Forbidden_Names is new GNAT.HTable.Simple_HTable (
112
     Header_Num => Header_Num,
113
     Element    => Boolean,
114
     No_Element => False,
115
     Key        => File_Name_Type,
116
     Hash       => Hash,
117
     Equal      => "=");
118
 
119
   -----------------------------
120
   -- Add_Forbidden_File_Name --
121
   -----------------------------
122
 
123
   procedure Add_Forbidden_File_Name (Name : File_Name_Type) is
124
   begin
125
      Forbidden_Names.Set (Name, True);
126
   end Add_Forbidden_File_Name;
127
 
128
   ---------------------
129
   -- Add_To_File_Map --
130
   ---------------------
131
 
132
   procedure Add_To_File_Map
133
     (Unit_Name : Unit_Name_Type;
134
      File_Name : File_Name_Type;
135
      Path_Name : File_Name_Type)
136
   is
137
      Unit_Entry : constant Int := Unit_Hash_Table.Get (Unit_Name);
138
      File_Entry : constant Int := File_Hash_Table.Get (File_Name);
139
   begin
140
      if Unit_Entry = No_Entry or else
141
        File_Mapping.Table (Unit_Entry).Fname /= File_Name
142
      then
143
         File_Mapping.Increment_Last;
144
         Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
145
         File_Mapping.Table (File_Mapping.Last) :=
146
           (Uname => Unit_Name, Fname => File_Name);
147
      end if;
148
 
149
      if File_Entry = No_Entry or else
150
        Path_Mapping.Table (File_Entry).Fname /= Path_Name
151
      then
152
         Path_Mapping.Increment_Last;
153
         File_Hash_Table.Set (File_Name, Path_Mapping.Last);
154
         Path_Mapping.Table (Path_Mapping.Last) :=
155
           (Uname => Unit_Name, Fname => Path_Name);
156
      end if;
157
   end Add_To_File_Map;
158
 
159
   ----------
160
   -- Hash --
161
   ----------
162
 
163
   function Hash (F : File_Name_Type) return Header_Num is
164
   begin
165
      return Header_Num (Int (F) rem Header_Num'Range_Length);
166
   end Hash;
167
 
168
   function Hash (F : Unit_Name_Type) return Header_Num is
169
   begin
170
      return Header_Num (Int (F) rem Header_Num'Range_Length);
171
   end Hash;
172
 
173
   ----------------
174
   -- Initialize --
175
   ----------------
176
 
177
   procedure Initialize (File_Name : String) is
178
      Src : Source_Buffer_Ptr;
179
      Hi  : Source_Ptr;
180
      BS  : Big_String_Ptr;
181
      SP  : String_Ptr;
182
 
183
      First : Positive := 1;
184
      Last  : Natural  := 0;
185
 
186
      Uname : Unit_Name_Type;
187
      Fname : File_Name_Type;
188
      Pname : File_Name_Type;
189
 
190
      procedure Empty_Tables;
191
      --  Remove all entries in case of incorrect mapping file
192
 
193
      function Find_File_Name return File_Name_Type;
194
      --  Return Error_File_Name if the name buffer contains "/", otherwise
195
      --  call Name_Find. "/" is the path name in the mapping file to indicate
196
      --  that a source has been suppressed, and thus should not be found by
197
      --  the compiler.
198
 
199
      function Find_Unit_Name return Unit_Name_Type;
200
      --  Return the unit name in the name buffer. Return Error_Unit_Name if
201
      --  the name buffer contains "/".
202
 
203
      procedure Get_Line;
204
      --  Get a line from the mapping file, where a line is SP (First .. Last)
205
 
206
      procedure Report_Truncated;
207
      --  Report a warning when the mapping file is truncated
208
      --  (number of lines is not a multiple of 3).
209
 
210
      ------------------
211
      -- Empty_Tables --
212
      ------------------
213
 
214
      procedure Empty_Tables is
215
      begin
216
         Unit_Hash_Table.Reset;
217
         File_Hash_Table.Reset;
218
         Path_Mapping.Set_Last (0);
219
         File_Mapping.Set_Last (0);
220
         Last_In_Table := 0;
221
      end Empty_Tables;
222
 
223
      --------------------
224
      -- Find_File_Name --
225
      --------------------
226
 
227
      function Find_File_Name return File_Name_Type is
228
      begin
229
         if Name_Buffer (1 .. Name_Len) = "/" then
230
 
231
            --  A path name of "/" is the indication that the source has been
232
            --  "suppressed". Return Error_File_Name so that the compiler does
233
            --  not find the source, even if it is in the include path.
234
 
235
            return Error_File_Name;
236
 
237
         else
238
            return Name_Find;
239
         end if;
240
      end Find_File_Name;
241
 
242
      --------------------
243
      -- Find_Unit_Name --
244
      --------------------
245
 
246
      function Find_Unit_Name return Unit_Name_Type is
247
      begin
248
         return Unit_Name_Type (Find_File_Name);
249
      end Find_Unit_Name;
250
 
251
      --------------
252
      -- Get_Line --
253
      --------------
254
 
255
      procedure Get_Line is
256
         use ASCII;
257
 
258
      begin
259
         First := Last + 1;
260
 
261
         --  If not at the end of file, skip the end of line
262
 
263
         while First < SP'Last
264
           and then (SP (First) = CR
265
                      or else SP (First) = LF
266
                      or else SP (First) = EOF)
267
         loop
268
            First := First + 1;
269
         end loop;
270
 
271
         --  If not at the end of file, find the end of this new line
272
 
273
         if First < SP'Last and then SP (First) /= EOF then
274
            Last := First;
275
 
276
            while Last < SP'Last
277
              and then SP (Last + 1) /= CR
278
              and then SP (Last + 1) /= LF
279
              and then SP (Last + 1) /= EOF
280
            loop
281
               Last := Last + 1;
282
            end loop;
283
 
284
         end if;
285
      end Get_Line;
286
 
287
      ----------------------
288
      -- Report_Truncated --
289
      ----------------------
290
 
291
      procedure Report_Truncated is
292
      begin
293
         Write_Str ("warning: mapping file """);
294
         Write_Str (File_Name);
295
         Write_Line (""" is truncated");
296
      end Report_Truncated;
297
 
298
   --  Start of processing for Initialize
299
 
300
   begin
301
      Empty_Tables;
302
      Name_Len := File_Name'Length;
303
      Name_Buffer (1 .. Name_Len) := File_Name;
304
      Read_Source_File (Name_Enter, 0, Hi, Src, Config);
305
 
306
      if Src = null then
307
         Write_Str ("warning: could not read mapping file """);
308
         Write_Str (File_Name);
309
         Write_Line ("""");
310
         No_Mapping_File := True;
311
 
312
      else
313
         BS := To_Big_String_Ptr (Src);
314
         SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
315
 
316
         loop
317
            --  Get the unit name
318
 
319
            Get_Line;
320
 
321
            --  Exit if end of file has been reached
322
 
323
            exit when First > Last;
324
 
325
            if (Last < First + 2) or else (SP (Last - 1) /= '%')
326
              or else (SP (Last) /= 's' and then SP (Last) /= 'b')
327
            then
328
               Write_Line
329
                 ("warning: mapping file """ & File_Name &
330
                  """ is incorrectly formatted");
331
               Write_Line ("Line = """ & SP (First .. Last) & '"');
332
               Empty_Tables;
333
               return;
334
            end if;
335
 
336
            Name_Len := Last - First + 1;
337
            Name_Buffer (1 .. Name_Len) := SP (First .. Last);
338
            Uname := Find_Unit_Name;
339
 
340
            --  Get the file name
341
 
342
            Get_Line;
343
 
344
            --  If end of line has been reached, file is truncated
345
 
346
            if First > Last then
347
               Report_Truncated;
348
               Empty_Tables;
349
               return;
350
            end if;
351
 
352
            Name_Len := Last - First + 1;
353
            Name_Buffer (1 .. Name_Len) := SP (First .. Last);
354
            Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
355
            Fname := Find_File_Name;
356
 
357
            --  Get the path name
358
 
359
            Get_Line;
360
 
361
            --  If end of line has been reached, file is truncated
362
 
363
            if First > Last then
364
               Report_Truncated;
365
               Empty_Tables;
366
               return;
367
            end if;
368
 
369
            Name_Len := Last - First + 1;
370
            Name_Buffer (1 .. Name_Len) := SP (First .. Last);
371
            Pname := Find_File_Name;
372
 
373
            --  Add the mappings for this unit name
374
 
375
            Add_To_File_Map (Uname, Fname, Pname);
376
         end loop;
377
      end if;
378
 
379
      --  Record the length of the two mapping tables
380
 
381
      Last_In_Table := File_Mapping.Last;
382
   end Initialize;
383
 
384
   ----------------------
385
   -- Mapped_File_Name --
386
   ----------------------
387
 
388
   function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
389
      The_Index : constant Int := Unit_Hash_Table.Get (Unit);
390
 
391
   begin
392
      if The_Index = No_Entry then
393
         return No_File;
394
      else
395
         return File_Mapping.Table (The_Index).Fname;
396
      end if;
397
   end Mapped_File_Name;
398
 
399
   ----------------------
400
   -- Mapped_Path_Name --
401
   ----------------------
402
 
403
   function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
404
      Index : Int := No_Entry;
405
 
406
   begin
407
      if Forbidden_Names.Get (File) then
408
         return Error_File_Name;
409
      end if;
410
 
411
      Index := File_Hash_Table.Get (File);
412
 
413
      if Index = No_Entry then
414
         return No_File;
415
      else
416
         return Path_Mapping.Table (Index).Fname;
417
      end if;
418
   end Mapped_Path_Name;
419
 
420
   ------------------
421
   -- Reset_Tables --
422
   ------------------
423
 
424
   procedure Reset_Tables is
425
   begin
426
      File_Mapping.Init;
427
      Path_Mapping.Init;
428
      Unit_Hash_Table.Reset;
429
      File_Hash_Table.Reset;
430
      Forbidden_Names.Reset;
431
      Last_In_Table := 0;
432
   end Reset_Tables;
433
 
434
   -------------------------
435
   -- Update_Mapping_File --
436
   -------------------------
437
 
438
   procedure Update_Mapping_File (File_Name : String) is
439
      File    : File_Descriptor;
440
      N_Bytes : Integer;
441
 
442
      File_Entry : Int;
443
 
444
      Status : Boolean;
445
      --  For the call to Close
446
 
447
      procedure Put_Line (Name : Name_Id);
448
      --  Put Name as a line in the Mapping File
449
 
450
      --------------
451
      -- Put_Line --
452
      --------------
453
 
454
      procedure Put_Line (Name : Name_Id) is
455
      begin
456
         Get_Name_String (Name);
457
 
458
         --  If the Buffer is full, write it to the file
459
 
460
         if Buffer_Last + Name_Len + 1 > Buffer'Last then
461
            N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
462
 
463
            if N_Bytes < Buffer_Last then
464
               Fail ("disk full");
465
            end if;
466
 
467
            Buffer_Last := 0;
468
         end if;
469
 
470
         --  Add the line to the Buffer
471
 
472
         Buffer (Buffer_Last + 1 .. Buffer_Last + Name_Len) :=
473
           Name_Buffer (1 .. Name_Len);
474
         Buffer_Last := Buffer_Last + Name_Len + 1;
475
         Buffer (Buffer_Last) := ASCII.LF;
476
      end Put_Line;
477
 
478
   --  Start of Update_Mapping_File
479
 
480
   begin
481
      --  If the mapping file could not be read, then it will not be possible
482
      --  to update it.
483
 
484
      if No_Mapping_File then
485
         return;
486
      end if;
487
      --  Only Update if there are new entries in the mappings
488
 
489
      if Last_In_Table < File_Mapping.Last then
490
 
491
         File := Open_Read_Write (Name => File_Name, Fmode => Binary);
492
 
493
         if File /= Invalid_FD then
494
            if Last_In_Table > 0 then
495
               Lseek (File, 0, Seek_End);
496
            end if;
497
 
498
            for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
499
               Put_Line (Name_Id (File_Mapping.Table (Unit).Uname));
500
               Put_Line (Name_Id (File_Mapping.Table (Unit).Fname));
501
               File_Entry :=
502
                 File_Hash_Table.Get (File_Mapping.Table (Unit).Fname);
503
               Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname));
504
            end loop;
505
 
506
            --  Before closing the file, write the buffer to the file. It is
507
            --  guaranteed that the Buffer is not empty, because Put_Line has
508
            --  been called at least 3 times, and after a call to Put_Line, the
509
            --  Buffer is not empty.
510
 
511
            N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
512
 
513
            if N_Bytes < Buffer_Last then
514
               Fail ("disk full");
515
            end if;
516
 
517
            Close (File, Status);
518
 
519
            if not Status then
520
               Fail ("disk full");
521
            end if;
522
 
523
         elsif not Quiet_Output then
524
            Write_Str ("warning: could not open mapping file """);
525
            Write_Str (File_Name);
526
            Write_Line (""" for update");
527
         end if;
528
 
529
      end if;
530
   end Update_Mapping_File;
531
 
532
end Fmap;

powered by: WebSVN 2.1.0

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