1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2009, 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 ------------------------------------------------------------------------------
27 with Osint; use Osint;
28 with Output; use Output;
30 with Types; use Types;
32 with System.OS_Lib; use System.OS_Lib;
34 with Unchecked_Conversion;
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.
45 function To_Big_String_Ptr is new Unchecked_Conversion
46 (Source_Buffer_Ptr, Big_String_Ptr);
48 Max_Buffer : constant := 1_500;
49 Buffer : String (1 .. Max_Buffer);
50 -- Used to bufferize output when writing to a new mapping file
52 Buffer_Last : Natural := 0;
53 -- Index of last valid character in Buffer
55 type Mapping is record
56 Uname : Unit_Name_Type;
57 Fname : File_Name_Type;
60 package File_Mapping is new Table.Table (
61 Table_Component_Type => Mapping,
62 Table_Index_Type => Int,
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
69 package Path_Mapping is new Table.Table (
70 Table_Component_Type => Mapping,
71 Table_Index_Type => Int,
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
78 type Header_Num is range 0 .. 1_000;
80 function Hash (F : Unit_Name_Type) return Header_Num;
81 -- Function used to compute hash of unit name
83 No_Entry : constant Int := -1;
84 -- Signals no entry in following table
86 package Unit_Hash_Table is new GNAT.HTable.Simple_HTable (
87 Header_Num => Header_Num,
89 No_Element => No_Entry,
90 Key => Unit_Name_Type,
93 -- Hash table to map unit names to file names. Used in conjunction with
94 -- table File_Mapping above.
96 function Hash (F : File_Name_Type) return Header_Num;
97 -- Function used to compute hash of file name
99 package File_Hash_Table is new GNAT.HTable.Simple_HTable (
100 Header_Num => Header_Num,
102 No_Element => No_Entry,
103 Key => File_Name_Type,
106 -- Hash table to map file names to path names. Used in conjunction with
107 -- table Path_Mapping above.
109 Last_In_Table : Int := 0;
111 package Forbidden_Names is new GNAT.HTable.Simple_HTable (
112 Header_Num => Header_Num,
115 Key => File_Name_Type,
119 -----------------------------
120 -- Add_Forbidden_File_Name --
121 -----------------------------
123 procedure Add_Forbidden_File_Name (Name : File_Name_Type) is
125 Forbidden_Names.Set (Name, True);
126 end Add_Forbidden_File_Name;
128 ---------------------
129 -- Add_To_File_Map --
130 ---------------------
132 procedure Add_To_File_Map
133 (Unit_Name : Unit_Name_Type;
134 File_Name : File_Name_Type;
135 Path_Name : File_Name_Type)
137 Unit_Entry : constant Int := Unit_Hash_Table.Get (Unit_Name);
138 File_Entry : constant Int := File_Hash_Table.Get (File_Name);
140 if Unit_Entry = No_Entry or else
141 File_Mapping.Table (Unit_Entry).Fname /= File_Name
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);
149 if File_Entry = No_Entry or else
150 Path_Mapping.Table (File_Entry).Fname /= Path_Name
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);
163 function Hash (F : File_Name_Type) return Header_Num is
165 return Header_Num (Int (F) rem Header_Num'Range_Length);
168 function Hash (F : Unit_Name_Type) return Header_Num is
170 return Header_Num (Int (F) rem Header_Num'Range_Length);
177 procedure Initialize (File_Name : String) is
178 Src : Source_Buffer_Ptr;
183 First : Positive := 1;
186 Uname : Unit_Name_Type;
187 Fname : File_Name_Type;
188 Pname : File_Name_Type;
190 procedure Empty_Tables;
191 -- Remove all entries in case of incorrect mapping file
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
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 "/".
204 -- Get a line from the mapping file, where a line is SP (First .. Last)
206 procedure Report_Truncated;
207 -- Report a warning when the mapping file is truncated
208 -- (number of lines is not a multiple of 3).
214 procedure Empty_Tables is
216 Unit_Hash_Table.Reset;
217 File_Hash_Table.Reset;
218 Path_Mapping.Set_Last (0);
219 File_Mapping.Set_Last (0);
227 function Find_File_Name return File_Name_Type is
229 if Name_Buffer (1 .. Name_Len) = "/" then
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.
235 return Error_File_Name;
246 function Find_Unit_Name return Unit_Name_Type is
248 return Unit_Name_Type (Find_File_Name);
255 procedure Get_Line is
261 -- If not at the end of file, skip the end of line
263 while First < SP'Last
264 and then (SP (First) = CR
265 or else SP (First) = LF
266 or else SP (First) = EOF)
271 -- If not at the end of file, find the end of this new line
273 if First < SP'Last and then SP (First) /= EOF then
277 and then SP (Last + 1) /= CR
278 and then SP (Last + 1) /= LF
279 and then SP (Last + 1) /= EOF
287 ----------------------
288 -- Report_Truncated --
289 ----------------------
291 procedure Report_Truncated is
293 Write_Str ("warning: mapping file """);
294 Write_Str (File_Name);
295 Write_Line (""" is truncated");
296 end Report_Truncated;
298 -- Start of processing for Initialize
302 Name_Len := File_Name'Length;
303 Name_Buffer (1 .. Name_Len) := File_Name;
304 Read_Source_File (Name_Enter, 0, Hi, Src, Config);
307 Write_Str ("warning: could not read mapping file """);
308 Write_Str (File_Name);
310 No_Mapping_File := True;
313 BS := To_Big_String_Ptr (Src);
314 SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
321 -- Exit if end of file has been reached
323 exit when First > Last;
325 if (Last < First + 2) or else (SP (Last - 1) /= '%')
326 or else (SP (Last) /= 's' and then SP (Last) /= 'b')
329 ("warning: mapping file """ & File_Name &
330 """ is incorrectly formatted");
331 Write_Line ("Line = """ & SP (First .. Last) & '"');
336 Name_Len := Last - First + 1;
337 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
338 Uname := Find_Unit_Name;
344 -- If end of line has been reached, file is truncated
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;
361 -- If end of line has been reached, file is truncated
369 Name_Len := Last - First + 1;
370 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
371 Pname := Find_File_Name;
373 -- Add the mappings for this unit name
375 Add_To_File_Map (Uname, Fname, Pname);
379 -- Record the length of the two mapping tables
381 Last_In_Table := File_Mapping.Last;
384 ----------------------
385 -- Mapped_File_Name --
386 ----------------------
388 function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
389 The_Index : constant Int := Unit_Hash_Table.Get (Unit);
392 if The_Index = No_Entry then
395 return File_Mapping.Table (The_Index).Fname;
397 end Mapped_File_Name;
399 ----------------------
400 -- Mapped_Path_Name --
401 ----------------------
403 function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
404 Index : Int := No_Entry;
407 if Forbidden_Names.Get (File) then
408 return Error_File_Name;
411 Index := File_Hash_Table.Get (File);
413 if Index = No_Entry then
416 return Path_Mapping.Table (Index).Fname;
418 end Mapped_Path_Name;
424 procedure Reset_Tables is
428 Unit_Hash_Table.Reset;
429 File_Hash_Table.Reset;
430 Forbidden_Names.Reset;
434 -------------------------
435 -- Update_Mapping_File --
436 -------------------------
438 procedure Update_Mapping_File (File_Name : String) is
439 File : File_Descriptor;
445 -- For the call to Close
447 procedure Put_Line (Name : Name_Id);
448 -- Put Name as a line in the Mapping File
454 procedure Put_Line (Name : Name_Id) is
456 Get_Name_String (Name);
458 -- If the Buffer is full, write it to the file
460 if Buffer_Last + Name_Len + 1 > Buffer'Last then
461 N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
463 if N_Bytes < Buffer_Last then
470 -- Add the line to the Buffer
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;
478 -- Start of Update_Mapping_File
481 -- If the mapping file could not be read, then it will not be possible
484 if No_Mapping_File then
487 -- Only Update if there are new entries in the mappings
489 if Last_In_Table < File_Mapping.Last then
491 File := Open_Read_Write (Name => File_Name, Fmode => Binary);
493 if File /= Invalid_FD then
494 if Last_In_Table > 0 then
495 Lseek (File, 0, Seek_End);
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));
502 File_Hash_Table.Get (File_Mapping.Table (Unit).Fname);
503 Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname));
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.
511 N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
513 if N_Bytes < Buffer_Last then
517 Close (File, Status);
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");
530 end Update_Mapping_File;