1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2008, 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 oopen 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 for "/", otherwise call Name_Find
195 -- What is this about, explanation required ???
197 function Find_Unit_Name return Unit_Name_Type;
198 -- Return Error_Unit_Name for "/", otherwise call Name_Find
199 -- Even more mysterious??? function appeared when Find_Name was split
200 -- for the two types, but this routine is definitely called!
203 -- Get a line from the mapping file
205 procedure Report_Truncated;
206 -- Report a warning when the mapping file is truncated
207 -- (number of lines is not a multiple of 3).
213 procedure Empty_Tables is
215 Unit_Hash_Table.Reset;
216 File_Hash_Table.Reset;
217 Path_Mapping.Set_Last (0);
218 File_Mapping.Set_Last (0);
226 -- Why is only / illegal, why not \ on windows ???
228 function Find_File_Name return File_Name_Type is
230 if Name_Buffer (1 .. Name_Len) = "/" then
231 return Error_File_Name;
241 function Find_Unit_Name return Unit_Name_Type is
243 return Unit_Name_Type (Find_File_Name);
251 procedure Get_Line is
257 -- If not at the end of file, skip the end of line
259 while First < SP'Last
260 and then (SP (First) = CR
261 or else SP (First) = LF
262 or else SP (First) = EOF)
267 -- If not at the end of file, find the end of this new line
269 if First < SP'Last and then SP (First) /= EOF then
273 and then SP (Last + 1) /= CR
274 and then SP (Last + 1) /= LF
275 and then SP (Last + 1) /= EOF
283 ----------------------
284 -- Report_Truncated --
285 ----------------------
287 procedure Report_Truncated is
289 Write_Str ("warning: mapping file """);
290 Write_Str (File_Name);
291 Write_Line (""" is truncated");
292 end Report_Truncated;
294 -- Start of processing for Initialize
298 Name_Len := File_Name'Length;
299 Name_Buffer (1 .. Name_Len) := File_Name;
300 Read_Source_File (Name_Enter, 0, Hi, Src, Config);
303 Write_Str ("warning: could not read mapping file """);
304 Write_Str (File_Name);
306 No_Mapping_File := True;
309 BS := To_Big_String_Ptr (Src);
310 SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
317 -- Exit if end of file has been reached
319 exit when First > Last;
321 if (Last < First + 2) or else (SP (Last - 1) /= '%')
322 or else (SP (Last) /= 's' and then SP (Last) /= 'b')
324 Write_Str ("warning: mapping file """);
325 Write_Str (File_Name);
326 Write_Line (""" is incorrectly formatted");
331 Name_Len := Last - First + 1;
332 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
333 Uname := Find_Unit_Name;
339 -- If end of line has been reached, file is truncated
347 Name_Len := Last - First + 1;
348 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
349 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
350 Fname := Find_File_Name;
356 -- If end of line has been reached, file is truncated
364 Name_Len := Last - First + 1;
365 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
366 Pname := Find_File_Name;
368 -- Add the mappings for this unit name
370 Add_To_File_Map (Uname, Fname, Pname);
374 -- Record the length of the two mapping tables
376 Last_In_Table := File_Mapping.Last;
379 ----------------------
380 -- Mapped_File_Name --
381 ----------------------
383 function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
384 The_Index : constant Int := Unit_Hash_Table.Get (Unit);
387 if The_Index = No_Entry then
390 return File_Mapping.Table (The_Index).Fname;
392 end Mapped_File_Name;
394 ----------------------
395 -- Mapped_Path_Name --
396 ----------------------
398 function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
399 Index : Int := No_Entry;
402 if Forbidden_Names.Get (File) then
403 return Error_File_Name;
406 Index := File_Hash_Table.Get (File);
408 if Index = No_Entry then
411 return Path_Mapping.Table (Index).Fname;
413 end Mapped_Path_Name;
415 --------------------------------
416 -- Remove_Forbidden_File_Name --
417 --------------------------------
419 procedure Remove_Forbidden_File_Name (Name : File_Name_Type) is
421 Forbidden_Names.Set (Name, False);
422 end Remove_Forbidden_File_Name;
428 procedure Reset_Tables is
432 Unit_Hash_Table.Reset;
433 File_Hash_Table.Reset;
434 Forbidden_Names.Reset;
438 -------------------------
439 -- Update_Mapping_File --
440 -------------------------
442 procedure Update_Mapping_File (File_Name : String) is
443 File : File_Descriptor;
449 -- For the call to Close
451 procedure Put_Line (Name : Name_Id);
452 -- Put Name as a line in the Mapping File
458 procedure Put_Line (Name : Name_Id) is
460 Get_Name_String (Name);
462 -- If the Buffer is full, write it to the file
464 if Buffer_Last + Name_Len + 1 > Buffer'Last then
465 N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
467 if N_Bytes < Buffer_Last then
474 -- Add the line to the Buffer
476 Buffer (Buffer_Last + 1 .. Buffer_Last + Name_Len) :=
477 Name_Buffer (1 .. Name_Len);
478 Buffer_Last := Buffer_Last + Name_Len + 1;
479 Buffer (Buffer_Last) := ASCII.LF;
482 -- Start of Update_Mapping_File
485 -- If the mapping file could not be read, then it will not be possible
488 if No_Mapping_File then
491 -- Only Update if there are new entries in the mappings
493 if Last_In_Table < File_Mapping.Last then
495 File := Open_Read_Write (Name => File_Name, Fmode => Binary);
497 if File /= Invalid_FD then
498 if Last_In_Table > 0 then
499 Lseek (File, 0, Seek_End);
502 for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
503 Put_Line (Name_Id (File_Mapping.Table (Unit).Uname));
504 Put_Line (Name_Id (File_Mapping.Table (Unit).Fname));
506 File_Hash_Table.Get (File_Mapping.Table (Unit).Fname);
507 Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname));
510 -- Before closing the file, write the buffer to the file. It is
511 -- guaranteed that the Buffer is not empty, because Put_Line has
512 -- been called at least 3 times, and after a call to Put_Line, the
513 -- Buffer is not empty.
515 N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last);
517 if N_Bytes < Buffer_Last then
521 Close (File, Status);
527 elsif not Quiet_Output then
528 Write_Str ("warning: could not open mapping file """);
529 Write_Str (File_Name);
530 Write_Line (""" for update");
534 end Update_Mapping_File;