1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2005, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
28 with Namet
; use Namet
;
30 with Osint
; use Osint
;
31 with Output
; use Output
;
34 with Unchecked_Conversion
;
40 subtype Big_String
is String (Positive);
41 type Big_String_Ptr
is access all Big_String
;
43 function To_Big_String_Ptr
is new Unchecked_Conversion
44 (Source_Buffer_Ptr
, Big_String_Ptr
);
46 Max_Buffer
: constant := 1_500
;
47 Buffer
: String (1 .. Max_Buffer
);
48 -- Used to bufferize output when writing to a new mapping file
50 Buffer_Last
: Natural := 0;
51 -- Index of last valid character in Buffer
53 type Mapping
is record
54 Uname
: Unit_Name_Type
;
55 Fname
: File_Name_Type
;
58 package File_Mapping
is new Table
.Table
(
59 Table_Component_Type
=> Mapping
,
60 Table_Index_Type
=> Int
,
62 Table_Initial
=> 1_000
,
63 Table_Increment
=> 1_000
,
64 Table_Name
=> "Fmap.File_Mapping");
65 -- Mapping table to map unit names to file names.
67 package Path_Mapping
is new Table
.Table
(
68 Table_Component_Type
=> Mapping
,
69 Table_Index_Type
=> Int
,
71 Table_Initial
=> 1_000
,
72 Table_Increment
=> 1_000
,
73 Table_Name
=> "Fmap.Path_Mapping");
74 -- Mapping table to map file names to path names
76 type Header_Num
is range 0 .. 1_000
;
78 function Hash
(F
: Unit_Name_Type
) return Header_Num
;
79 -- Function used to compute hash of unit name
81 No_Entry
: constant Int
:= -1;
82 -- Signals no entry in following table
84 package Unit_Hash_Table
is new GNAT
.HTable
.Simple_HTable
(
85 Header_Num
=> Header_Num
,
87 No_Element
=> No_Entry
,
88 Key
=> Unit_Name_Type
,
91 -- Hash table to map unit names to file names. Used in conjunction with
92 -- table File_Mapping above.
94 package File_Hash_Table
is new GNAT
.HTable
.Simple_HTable
(
95 Header_Num
=> Header_Num
,
97 No_Element
=> No_Entry
,
98 Key
=> File_Name_Type
,
101 -- Hash table to map file names to path names. Used in conjunction with
102 -- table Path_Mapping above.
104 Last_In_Table
: Int
:= 0;
106 package Forbidden_Names
is new GNAT
.HTable
.Simple_HTable
(
107 Header_Num
=> Header_Num
,
110 Key
=> File_Name_Type
,
114 -----------------------------
115 -- Add_Forbidden_File_Name --
116 -----------------------------
118 procedure Add_Forbidden_File_Name
(Name
: Name_Id
) is
120 Forbidden_Names
.Set
(Name
, True);
121 end Add_Forbidden_File_Name
;
123 ---------------------
124 -- Add_To_File_Map --
125 ---------------------
127 procedure Add_To_File_Map
128 (Unit_Name
: Unit_Name_Type
;
129 File_Name
: File_Name_Type
;
130 Path_Name
: File_Name_Type
)
133 File_Mapping
.Increment_Last
;
134 Unit_Hash_Table
.Set
(Unit_Name
, File_Mapping
.Last
);
135 File_Mapping
.Table
(File_Mapping
.Last
) :=
136 (Uname
=> Unit_Name
, Fname
=> File_Name
);
137 Path_Mapping
.Increment_Last
;
138 File_Hash_Table
.Set
(File_Name
, Path_Mapping
.Last
);
139 Path_Mapping
.Table
(Path_Mapping
.Last
) :=
140 (Uname
=> Unit_Name
, Fname
=> Path_Name
);
147 function Hash
(F
: Unit_Name_Type
) return Header_Num
is
149 return Header_Num
(Int
(F
) rem Header_Num
'Range_Length);
156 procedure Initialize
(File_Name
: String) is
157 Src
: Source_Buffer_Ptr
;
162 First
: Positive := 1;
165 Uname
: Unit_Name_Type
;
169 The_Mapping
: Mapping
;
171 procedure Empty_Tables
(Warning
: Boolean := True);
172 -- Remove all entries in case of incorrect mapping file
174 function Find_Name
return Name_Id
;
175 -- Return Error_Name for "/", otherwise call Name_Find
178 -- Get a line from the mapping file
180 procedure Report_Truncated
;
181 -- Report a warning when the mapping file is truncated
182 -- (number of lines is not a multiple of 3).
188 procedure Empty_Tables
(Warning
: Boolean := True) is
191 Write_Str
("mapping file """);
192 Write_Str
(File_Name
);
193 Write_Line
(""" is not taken into account");
196 Unit_Hash_Table
.Reset
;
197 File_Hash_Table
.Reset
;
198 Path_Mapping
.Set_Last
(0);
199 File_Mapping
.Set_Last
(0);
207 procedure Get_Line
is
213 -- If not at the end of file, skip the end of line
215 while First
< SP
'Last
216 and then (SP
(First
) = CR
217 or else SP
(First
) = LF
218 or else SP
(First
) = EOF
)
223 -- If not at the end of file, find the end of this new line
225 if First
< SP
'Last and then SP
(First
) /= EOF
then
229 and then SP
(Last
+ 1) /= CR
230 and then SP
(Last
+ 1) /= LF
231 and then SP
(Last
+ 1) /= EOF
243 function Find_Name
return Name_Id
is
245 if Name_Buffer
(1 .. Name_Len
) = "/" then
253 ----------------------
254 -- Report_Truncated --
255 ----------------------
257 procedure Report_Truncated
is
259 Write_Str
("warning: mapping file """);
260 Write_Str
(File_Name
);
261 Write_Line
(""" is truncated");
262 end Report_Truncated
;
264 -- Start of procedure Initialize
267 Empty_Tables
(Warning
=> False);
268 Name_Len
:= File_Name
'Length;
269 Name_Buffer
(1 .. Name_Len
) := File_Name
;
270 Read_Source_File
(Name_Enter
, 0, Hi
, Src
, Config
);
273 Write_Str
("warning: could not read mapping file """);
274 Write_Str
(File_Name
);
278 BS
:= To_Big_String_Ptr
(Src
);
279 SP
:= BS
(1 .. Natural (Hi
))'Unrestricted_Access;
286 -- Exit if end of file has been reached
288 exit when First
> Last
;
290 if (Last
< First
+ 2) or else (SP
(Last
- 1) /= '%')
291 or else (SP
(Last
) /= 's' and then SP
(Last
) /= 'b')
293 Write_Str
("warning: mapping file """);
294 Write_Str
(File_Name
);
295 Write_Line
(""" is incorrectly formatted");
300 Name_Len
:= Last
- First
+ 1;
301 Name_Buffer
(1 .. Name_Len
) := SP
(First
.. Last
);
308 -- If end of line has been reached, file is truncated
316 Name_Len
:= Last
- First
+ 1;
317 Name_Buffer
(1 .. Name_Len
) := SP
(First
.. Last
);
318 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
325 -- If end of line has been reached, file is truncated
333 Name_Len
:= Last
- First
+ 1;
334 Name_Buffer
(1 .. Name_Len
) := SP
(First
.. Last
);
337 -- Check for duplicate entries
339 if Unit_Hash_Table
.Get
(Uname
) /= No_Entry
then
340 Write_Str
("warning: duplicate entry """);
341 Write_Str
(Get_Name_String
(Uname
));
342 Write_Str
(""" in mapping file """);
343 Write_Str
(File_Name
);
345 The_Mapping
:= File_Mapping
.Table
(Unit_Hash_Table
.Get
(Uname
));
346 Write_Line
(Get_Name_String
(The_Mapping
.Uname
));
347 Write_Line
(Get_Name_String
(The_Mapping
.Fname
));
352 if File_Hash_Table
.Get
(Fname
) /= No_Entry
then
353 Write_Str
("warning: duplicate entry """);
354 Write_Str
(Get_Name_String
(Fname
));
355 Write_Str
(""" in mapping file """);
356 Write_Str
(File_Name
);
358 The_Mapping
:= Path_Mapping
.Table
(File_Hash_Table
.Get
(Fname
));
359 Write_Line
(Get_Name_String
(The_Mapping
.Uname
));
360 Write_Line
(Get_Name_String
(The_Mapping
.Fname
));
365 -- Add the mappings for this unit name
367 Add_To_File_Map
(Uname
, Fname
, Pname
);
371 -- Record the length of the two mapping tables
373 Last_In_Table
:= File_Mapping
.Last
;
377 ----------------------
378 -- Mapped_File_Name --
379 ----------------------
381 function Mapped_File_Name
(Unit
: Unit_Name_Type
) return File_Name_Type
is
382 The_Index
: constant Int
:= Unit_Hash_Table
.Get
(Unit
);
385 if The_Index
= No_Entry
then
388 return File_Mapping
.Table
(The_Index
).Fname
;
390 end Mapped_File_Name
;
392 ----------------------
393 -- Mapped_Path_Name --
394 ----------------------
396 function Mapped_Path_Name
(File
: File_Name_Type
) return File_Name_Type
is
397 Index
: Int
:= No_Entry
;
400 if Forbidden_Names
.Get
(File
) then
404 Index
:= File_Hash_Table
.Get
(File
);
406 if Index
= No_Entry
then
409 return Path_Mapping
.Table
(Index
).Fname
;
411 end Mapped_Path_Name
;
413 --------------------------------
414 -- Remove_Forbidden_File_Name --
415 --------------------------------
417 procedure Remove_Forbidden_File_Name
(Name
: Name_Id
) is
419 Forbidden_Names
.Set
(Name
, False);
420 end Remove_Forbidden_File_Name
;
426 procedure Reset_Tables
is
430 Unit_Hash_Table
.Reset
;
431 File_Hash_Table
.Reset
;
432 Forbidden_Names
.Reset
;
436 -------------------------
437 -- Update_Mapping_File --
438 -------------------------
440 procedure Update_Mapping_File
(File_Name
: String) is
441 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
482 -- Only Update if there are new entries in the mappings
484 if Last_In_Table
< File_Mapping
.Last
then
486 -- If the tables have been emptied, recreate the file.
487 -- Otherwise, append to it.
489 if Last_In_Table
= 0 then
494 Delete_File
(File_Name
, Discard
);
497 File
:= Create_File
(File_Name
, Binary
);
500 File
:= Open_Read_Write
(Name
=> File_Name
, Fmode
=> Binary
);
503 if File
/= Invalid_FD
then
504 if Last_In_Table
> 0 then
505 Lseek
(File
, 0, Seek_End
);
508 for Unit
in Last_In_Table
+ 1 .. File_Mapping
.Last
loop
509 Put_Line
(File_Mapping
.Table
(Unit
).Uname
);
510 Put_Line
(File_Mapping
.Table
(Unit
).Fname
);
511 Put_Line
(Path_Mapping
.Table
(Unit
).Fname
);
514 -- Before closing the file, write the buffer to the file.
515 -- It is guaranteed that the Buffer is not empty, because
516 -- Put_Line has been called at least 3 times, and after
517 -- a call to Put_Line, the Buffer is not empty.
519 N_Bytes
:= Write
(File
, Buffer
(1)'Address, Buffer_Last
);
521 if N_Bytes
< Buffer_Last
then
525 Close
(File
, Status
);
531 elsif not Quiet_Output
then
532 Write_Str
("warning: could not open mapping file """);
533 Write_Str
(File_Name
);
534 Write_Line
(""" for update");
538 end Update_Mapping_File
;