1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2001, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with GNAT.OS_Lib; use GNAT.OS_Lib;
29 with Namet; use Namet;
31 with Osint; use Osint;
32 with Output; use Output;
35 with Unchecked_Conversion;
41 subtype Big_String is String (Positive);
42 type Big_String_Ptr is access all Big_String;
44 function To_Big_String_Ptr is new Unchecked_Conversion
45 (Source_Buffer_Ptr, Big_String_Ptr);
47 type Mapping is record
48 Uname : Unit_Name_Type;
49 Fname : File_Name_Type;
52 package File_Mapping is new Table.Table (
53 Table_Component_Type => Mapping,
54 Table_Index_Type => Int,
56 Table_Initial => 1_000,
57 Table_Increment => 1_000,
58 Table_Name => "Fmap.File_Mapping");
59 -- Mapping table to map unit names to file names.
61 package Path_Mapping is new Table.Table (
62 Table_Component_Type => Mapping,
63 Table_Index_Type => Int,
65 Table_Initial => 1_000,
66 Table_Increment => 1_000,
67 Table_Name => "Fmap.Path_Mapping");
68 -- Mapping table to map file names to path names
70 type Header_Num is range 0 .. 1_000;
72 function Hash (F : Unit_Name_Type) return Header_Num;
73 -- Function used to compute hash of unit name
75 No_Entry : constant Int := -1;
76 -- Signals no entry in following table
78 package Unit_Hash_Table is new GNAT.HTable.Simple_HTable (
79 Header_Num => Header_Num,
81 No_Element => No_Entry,
82 Key => Unit_Name_Type,
85 -- Hash table to map unit names to file names. Used in conjunction with
86 -- table File_Mapping above.
88 package File_Hash_Table is new GNAT.HTable.Simple_HTable (
89 Header_Num => Header_Num,
91 No_Element => No_Entry,
92 Key => File_Name_Type,
95 -- Hash table to map file names to path names. Used in conjunction with
96 -- table Path_Mapping above.
98 Last_In_Table : Int := 0;
100 ---------------------
101 -- Add_To_File_Map --
102 ---------------------
104 procedure Add_To_File_Map
105 (Unit_Name : Unit_Name_Type;
106 File_Name : File_Name_Type;
107 Path_Name : File_Name_Type)
110 File_Mapping.Increment_Last;
111 Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
112 File_Mapping.Table (File_Mapping.Last) :=
113 (Uname => Unit_Name, Fname => File_Name);
114 Path_Mapping.Increment_Last;
115 File_Hash_Table.Set (File_Name, Path_Mapping.Last);
116 Path_Mapping.Table (Path_Mapping.Last) :=
117 (Uname => Unit_Name, Fname => Path_Name);
124 function Hash (F : Unit_Name_Type) return Header_Num is
126 return Header_Num (Int (F) rem Header_Num'Range_Length);
133 procedure Initialize (File_Name : String) is
134 Src : Source_Buffer_Ptr;
139 First : Positive := 1;
142 Uname : Unit_Name_Type;
146 The_Mapping : Mapping;
148 procedure Empty_Tables;
149 -- Remove all entries in case of incorrect mapping file
152 -- Get a line from the mapping file
154 procedure Report_Truncated;
155 -- Report a warning when the mapping file is truncated
156 -- (number of lines is not a multiple of 3).
162 procedure Empty_Tables is
164 Unit_Hash_Table.Reset;
165 File_Hash_Table.Reset;
166 Path_Mapping.Set_Last (0);
167 File_Mapping.Set_Last (0);
175 procedure Get_Line is
181 -- If not at the end of file, skip the end of line
183 while First < SP'Last
184 and then (SP (First) = CR
185 or else SP (First) = LF
186 or else SP (First) = EOF)
191 -- If not at the end of file, find the end of this new line
193 if First < SP'Last and then SP (First) /= EOF then
197 and then SP (Last + 1) /= CR
198 and then SP (Last + 1) /= LF
199 and then SP (Last + 1) /= EOF
207 ----------------------
208 -- Report_Truncated --
209 ----------------------
211 procedure Report_Truncated is
213 if not Quiet_Output then
214 Write_Str ("warning: mapping file """);
215 Write_Str (File_Name);
216 Write_Line (""" is truncated");
218 end Report_Truncated;
220 -- Start of procedure Initialize
224 Name_Len := File_Name'Length;
225 Name_Buffer (1 .. Name_Len) := File_Name;
226 Read_Source_File (Name_Enter, 0, Hi, Src, Config);
229 if not Quiet_Output then
230 Write_Str ("warning: could not read mapping file """);
231 Write_Str (File_Name);
236 BS := To_Big_String_Ptr (Src);
237 SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
244 -- Exit if end of file has been reached
246 exit when First > Last;
248 pragma Assert (Last >= First + 2);
249 pragma Assert (SP (Last - 1) = '%');
250 pragma Assert (SP (Last) = 's' or else SP (Last) = 'b');
252 Name_Len := Last - First + 1;
253 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
260 -- If end of line has been reached, file is truncated
268 Name_Len := Last - First + 1;
269 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
276 -- If end of line has been reached, file is truncated
284 Name_Len := Last - First + 1;
285 Name_Buffer (1 .. Name_Len) := SP (First .. Last);
288 -- Check for duplicate entries
290 if Unit_Hash_Table.Get (Uname) /= No_Entry then
291 if not Quiet_Output then
292 Write_Str ("warning: duplicate entry """);
293 Write_Str (Get_Name_String (Uname));
294 Write_Str (""" in mapping file """);
295 Write_Str (File_Name);
298 File_Mapping.Table (Unit_Hash_Table.Get (Uname));
299 Write_Line (Get_Name_String (The_Mapping.Uname));
300 Write_Line (Get_Name_String (The_Mapping.Fname));
307 if File_Hash_Table.Get (Fname) /= No_Entry then
308 if not Quiet_Output then
309 Write_Str ("warning: duplicate entry """);
310 Write_Str (Get_Name_String (Fname));
311 Write_Str (""" in mapping file """);
312 Write_Str (File_Name);
315 Path_Mapping.Table (File_Hash_Table.Get (Fname));
316 Write_Line (Get_Name_String (The_Mapping.Uname));
317 Write_Line (Get_Name_String (The_Mapping.Fname));
324 -- Add the mappings for this unit name
326 Add_To_File_Map (Uname, Fname, Pname);
330 -- Record the length of the two mapping tables
332 Last_In_Table := File_Mapping.Last;
336 ----------------------
337 -- Mapped_File_Name --
338 ----------------------
340 function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
341 The_Index : constant Int := Unit_Hash_Table.Get (Unit);
344 if The_Index = No_Entry then
347 return File_Mapping.Table (The_Index).Fname;
349 end Mapped_File_Name;
351 ----------------------
352 -- Mapped_Path_Name --
353 ----------------------
355 function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
356 Index : Int := No_Entry;
359 Index := File_Hash_Table.Get (File);
361 if Index = No_Entry then
364 return Path_Mapping.Table (Index).Fname;
366 end Mapped_Path_Name;
368 -------------------------
369 -- Update_Mapping_File --
370 -------------------------
372 procedure Update_Mapping_File (File_Name : String) is
373 File : File_Descriptor;
375 procedure Put_Line (Name : Name_Id);
376 -- Put Name as a line in the Mapping File
382 procedure Put_Line (Name : Name_Id) is
385 Get_Name_String (Name);
386 Name_Len := Name_Len + 1;
387 Name_Buffer (Name_Len) := ASCII.LF;
388 N_Bytes := Write (File, Name_Buffer (1)'Address, Name_Len);
390 if N_Bytes < Name_Len then
396 -- Start of Update_Mapping_File
400 -- Only Update if there are new entries in the mappings
402 if Last_In_Table < File_Mapping.Last then
404 -- If the tables have been emptied, recreate the file.
405 -- Otherwise, append to it.
407 if Last_In_Table = 0 then
412 Delete_File (File_Name, Discard);
415 File := Create_File (File_Name, Binary);
418 File := Open_Read_Write (Name => File_Name, Fmode => Binary);
421 if File /= Invalid_FD then
422 if Last_In_Table > 0 then
423 Lseek (File, 0, Seek_End);
426 for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
427 Put_Line (File_Mapping.Table (Unit).Uname);
428 Put_Line (File_Mapping.Table (Unit).Fname);
429 Put_Line (Path_Mapping.Table (Unit).Fname);
434 elsif not Quiet_Output then
435 Write_Str ("warning: could not open mapping file """);
436 Write_Str (File_Name);
437 Write_Line (""" for update");
441 end Update_Mapping_File;