]>
Commit | Line | Data |
---|---|---|
6510f4c9 GB |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- F M A P -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 2001-2019, Free Software Foundation, Inc. -- |
6510f4c9 GB |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
6510f4c9 GB |
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 -- | |
b5c84c3c RD |
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. -- | |
6510f4c9 GB |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
6510f4c9 GB |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
39f4e199 VC |
26 | with Opt; use Opt; |
27 | with Osint; use Osint; | |
28 | with Output; use Output; | |
6510f4c9 | 29 | with Table; |
39f4e199 VC |
30 | with Types; use Types; |
31 | ||
9e9df9da AC |
32 | pragma Warnings (Off); |
33 | -- This package is used also by gnatcoll | |
39f4e199 | 34 | with System.OS_Lib; use System.OS_Lib; |
9e9df9da | 35 | pragma Warnings (On); |
6510f4c9 GB |
36 | |
37 | with Unchecked_Conversion; | |
38 | ||
17c5c8a5 GB |
39 | with GNAT.HTable; |
40 | ||
6510f4c9 GB |
41 | package body Fmap is |
42 | ||
a1e2130c RD |
43 | No_Mapping_File : Boolean := False; |
44 | -- Set to True when the specified mapping file cannot be read in | |
f3d0f304 | 45 | -- procedure Initialize, so that no attempt is made to open the mapping |
a1e2130c | 46 | -- file in procedure Update_Mapping_File. |
6510f4c9 | 47 | |
fbf5a39b AC |
48 | Max_Buffer : constant := 1_500; |
49 | Buffer : String (1 .. Max_Buffer); | |
d1915cb8 | 50 | -- Used to buffer output when writing to a new mapping file |
fbf5a39b AC |
51 | |
52 | Buffer_Last : Natural := 0; | |
53 | -- Index of last valid character in Buffer | |
54 | ||
07fc65c4 GB |
55 | type Mapping is record |
56 | Uname : Unit_Name_Type; | |
57 | Fname : File_Name_Type; | |
58 | end record; | |
59 | ||
6510f4c9 | 60 | package File_Mapping is new Table.Table ( |
07fc65c4 | 61 | Table_Component_Type => Mapping, |
6510f4c9 GB |
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"); | |
9de61fcb | 67 | -- Mapping table to map unit names to file names |
6510f4c9 GB |
68 | |
69 | package Path_Mapping is new Table.Table ( | |
07fc65c4 | 70 | Table_Component_Type => Mapping, |
6510f4c9 GB |
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; | |
17c5c8a5 | 81 | -- Function used to compute hash of unit name |
6510f4c9 GB |
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 | ||
39f4e199 VC |
96 | function Hash (F : File_Name_Type) return Header_Num; |
97 | -- Function used to compute hash of file name | |
98 | ||
6510f4c9 GB |
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 | ||
07fc65c4 GB |
109 | Last_In_Table : Int := 0; |
110 | ||
fbf5a39b AC |
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 | ||
39f4e199 | 123 | procedure Add_Forbidden_File_Name (Name : File_Name_Type) is |
fbf5a39b AC |
124 | begin |
125 | Forbidden_Names.Set (Name, True); | |
126 | end Add_Forbidden_File_Name; | |
127 | ||
17c5c8a5 GB |
128 | --------------------- |
129 | -- Add_To_File_Map -- | |
130 | --------------------- | |
6510f4c9 | 131 | |
17c5c8a5 | 132 | procedure Add_To_File_Map |
6510f4c9 GB |
133 | (Unit_Name : Unit_Name_Type; |
134 | File_Name : File_Name_Type; | |
17c5c8a5 GB |
135 | Path_Name : File_Name_Type) |
136 | is | |
2cd44f5a VC |
137 | Unit_Entry : constant Int := Unit_Hash_Table.Get (Unit_Name); |
138 | File_Entry : constant Int := File_Hash_Table.Get (File_Name); | |
6510f4c9 | 139 | begin |
2cd44f5a VC |
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; | |
17c5c8a5 | 157 | end Add_To_File_Map; |
6510f4c9 GB |
158 | |
159 | ---------- | |
160 | -- Hash -- | |
161 | ---------- | |
162 | ||
39f4e199 VC |
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 | ||
6510f4c9 GB |
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 | |
cd644ae2 | 178 | FD : File_Descriptor; |
6510f4c9 GB |
179 | Src : Source_Buffer_Ptr; |
180 | Hi : Source_Ptr; | |
6510f4c9 | 181 | |
211e7410 AC |
182 | First : Source_Ptr := 1; |
183 | Last : Source_Ptr := 0; | |
6510f4c9 GB |
184 | |
185 | Uname : Unit_Name_Type; | |
39f4e199 VC |
186 | Fname : File_Name_Type; |
187 | Pname : File_Name_Type; | |
07fc65c4 | 188 | |
39f4e199 | 189 | procedure Empty_Tables; |
6510f4c9 GB |
190 | -- Remove all entries in case of incorrect mapping file |
191 | ||
39f4e199 | 192 | function Find_File_Name return File_Name_Type; |
5b900a45 AC |
193 | -- Return Error_File_Name if the name buffer contains "/", otherwise |
194 | -- call Name_Find. "/" is the path name in the mapping file to indicate | |
195 | -- that a source has been suppressed, and thus should not be found by | |
196 | -- the compiler. | |
39f4e199 VC |
197 | |
198 | function Find_Unit_Name return Unit_Name_Type; | |
5b900a45 AC |
199 | -- Return the unit name in the name buffer. Return Error_Unit_Name if |
200 | -- the name buffer contains "/". | |
fbf5a39b | 201 | |
6510f4c9 | 202 | procedure Get_Line; |
211e7410 | 203 | -- Get a line from the mapping file, where a line is Src (First .. Last) |
6510f4c9 GB |
204 | |
205 | procedure Report_Truncated; | |
206 | -- Report a warning when the mapping file is truncated | |
207 | -- (number of lines is not a multiple of 3). | |
208 | ||
209 | ------------------ | |
210 | -- Empty_Tables -- | |
211 | ------------------ | |
212 | ||
39f4e199 | 213 | procedure Empty_Tables is |
6510f4c9 GB |
214 | begin |
215 | Unit_Hash_Table.Reset; | |
216 | File_Hash_Table.Reset; | |
217 | Path_Mapping.Set_Last (0); | |
218 | File_Mapping.Set_Last (0); | |
07fc65c4 | 219 | Last_In_Table := 0; |
6510f4c9 GB |
220 | end Empty_Tables; |
221 | ||
39f4e199 VC |
222 | -------------------- |
223 | -- Find_File_Name -- | |
224 | -------------------- | |
225 | ||
39f4e199 | 226 | function Find_File_Name return File_Name_Type is |
bfc8aa81 RD |
227 | begin |
228 | if Name_Buffer (1 .. Name_Len) = "/" then | |
5b900a45 AC |
229 | |
230 | -- A path name of "/" is the indication that the source has been | |
231 | -- "suppressed". Return Error_File_Name so that the compiler does | |
232 | -- not find the source, even if it is in the include path. | |
233 | ||
39f4e199 | 234 | return Error_File_Name; |
5b900a45 | 235 | |
bfc8aa81 RD |
236 | else |
237 | return Name_Find; | |
238 | end if; | |
39f4e199 VC |
239 | end Find_File_Name; |
240 | ||
241 | -------------------- | |
242 | -- Find_Unit_Name -- | |
243 | -------------------- | |
244 | ||
245 | function Find_Unit_Name return Unit_Name_Type is | |
246 | begin | |
247 | return Unit_Name_Type (Find_File_Name); | |
39f4e199 | 248 | end Find_Unit_Name; |
bfc8aa81 | 249 | |
6510f4c9 GB |
250 | -------------- |
251 | -- Get_Line -- | |
252 | -------------- | |
253 | ||
254 | procedure Get_Line is | |
255 | use ASCII; | |
17c5c8a5 | 256 | |
6510f4c9 | 257 | begin |
07fc65c4 | 258 | First := Last + 1; |
6510f4c9 GB |
259 | |
260 | -- If not at the end of file, skip the end of line | |
17c5c8a5 | 261 | |
211e7410 AC |
262 | while First < Src'Last |
263 | and then (Src (First) = CR | |
264 | or else Src (First) = LF | |
265 | or else Src (First) = EOF) | |
6510f4c9 | 266 | loop |
07fc65c4 | 267 | First := First + 1; |
6510f4c9 GB |
268 | end loop; |
269 | ||
07fc65c4 | 270 | -- If not at the end of file, find the end of this new line |
6510f4c9 | 271 | |
211e7410 | 272 | if First < Src'Last and then Src (First) /= EOF then |
07fc65c4 | 273 | Last := First; |
6510f4c9 | 274 | |
211e7410 AC |
275 | while Last < Src'Last |
276 | and then Src (Last + 1) /= CR | |
277 | and then Src (Last + 1) /= LF | |
278 | and then Src (Last + 1) /= EOF | |
6510f4c9 | 279 | loop |
07fc65c4 | 280 | Last := Last + 1; |
6510f4c9 GB |
281 | end loop; |
282 | ||
283 | end if; | |
284 | end Get_Line; | |
285 | ||
286 | ---------------------- | |
287 | -- Report_Truncated -- | |
288 | ---------------------- | |
289 | ||
290 | procedure Report_Truncated is | |
291 | begin | |
fbf5a39b AC |
292 | Write_Str ("warning: mapping file """); |
293 | Write_Str (File_Name); | |
294 | Write_Line (""" is truncated"); | |
6510f4c9 GB |
295 | end Report_Truncated; |
296 | ||
39f4e199 | 297 | -- Start of processing for Initialize |
6510f4c9 GB |
298 | |
299 | begin | |
39f4e199 | 300 | Empty_Tables; |
cd644ae2 | 301 | Read_Source_File (Name_Enter (File_Name), 1, Hi, Src, FD, Config); |
6510f4c9 | 302 | |
0f96fd14 | 303 | if Null_Source_Buffer_Ptr (Src) then |
cd644ae2 PMR |
304 | if FD = Null_FD then |
305 | Write_Str ("warning: could not locate mapping file """); | |
306 | else | |
307 | Write_Str ("warning: no read access for mapping file """); | |
308 | end if; | |
7f5e671b | 309 | |
fbf5a39b AC |
310 | Write_Str (File_Name); |
311 | Write_Line (""""); | |
a1e2130c | 312 | No_Mapping_File := True; |
6510f4c9 GB |
313 | |
314 | else | |
6510f4c9 | 315 | loop |
6510f4c9 GB |
316 | -- Get the unit name |
317 | ||
318 | Get_Line; | |
319 | ||
320 | -- Exit if end of file has been reached | |
321 | ||
07fc65c4 | 322 | exit when First > Last; |
6510f4c9 | 323 | |
211e7410 AC |
324 | if (Last < First + 2) or else (Src (Last - 1) /= '%') |
325 | or else (Src (Last) /= 's' and then Src (Last) /= 'b') | |
fbf5a39b | 326 | then |
b4763f5c AC |
327 | Write_Line |
328 | ("warning: mapping file """ & File_Name & | |
329 | """ is incorrectly formatted"); | |
211e7410 | 330 | Write_Line ("Line = """ & String (Src (First .. Last)) & '"'); |
fbf5a39b AC |
331 | Empty_Tables; |
332 | return; | |
333 | end if; | |
334 | ||
211e7410 AC |
335 | Name_Len := Integer (Last - First + 1); |
336 | Name_Buffer (1 .. Name_Len) := String (Src (First .. Last)); | |
39f4e199 | 337 | Uname := Find_Unit_Name; |
6510f4c9 GB |
338 | |
339 | -- Get the file name | |
340 | ||
341 | Get_Line; | |
342 | ||
343 | -- If end of line has been reached, file is truncated | |
344 | ||
07fc65c4 | 345 | if First > Last then |
6510f4c9 GB |
346 | Report_Truncated; |
347 | Empty_Tables; | |
348 | return; | |
349 | end if; | |
350 | ||
211e7410 AC |
351 | Name_Len := Integer (Last - First + 1); |
352 | Name_Buffer (1 .. Name_Len) := String (Src (First .. Last)); | |
fbf5a39b | 353 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
39f4e199 | 354 | Fname := Find_File_Name; |
6510f4c9 GB |
355 | |
356 | -- Get the path name | |
357 | ||
358 | Get_Line; | |
359 | ||
360 | -- If end of line has been reached, file is truncated | |
361 | ||
07fc65c4 | 362 | if First > Last then |
6510f4c9 GB |
363 | Report_Truncated; |
364 | Empty_Tables; | |
365 | return; | |
366 | end if; | |
367 | ||
211e7410 AC |
368 | Name_Len := Integer (Last - First + 1); |
369 | Name_Buffer (1 .. Name_Len) := String (Src (First .. Last)); | |
39f4e199 | 370 | Pname := Find_File_Name; |
6510f4c9 | 371 | |
6510f4c9 GB |
372 | -- Add the mappings for this unit name |
373 | ||
17c5c8a5 | 374 | Add_To_File_Map (Uname, Fname, Pname); |
6510f4c9 | 375 | end loop; |
6510f4c9 | 376 | end if; |
07fc65c4 GB |
377 | |
378 | -- Record the length of the two mapping tables | |
379 | ||
380 | Last_In_Table := File_Mapping.Last; | |
6510f4c9 GB |
381 | end Initialize; |
382 | ||
17c5c8a5 GB |
383 | ---------------------- |
384 | -- Mapped_File_Name -- | |
385 | ---------------------- | |
386 | ||
387 | function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is | |
388 | The_Index : constant Int := Unit_Hash_Table.Get (Unit); | |
389 | ||
390 | begin | |
391 | if The_Index = No_Entry then | |
392 | return No_File; | |
393 | else | |
07fc65c4 | 394 | return File_Mapping.Table (The_Index).Fname; |
17c5c8a5 GB |
395 | end if; |
396 | end Mapped_File_Name; | |
397 | ||
398 | ---------------------- | |
399 | -- Mapped_Path_Name -- | |
400 | ---------------------- | |
6510f4c9 | 401 | |
17c5c8a5 | 402 | function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is |
6510f4c9 | 403 | Index : Int := No_Entry; |
17c5c8a5 | 404 | |
6510f4c9 | 405 | begin |
fbf5a39b | 406 | if Forbidden_Names.Get (File) then |
39f4e199 | 407 | return Error_File_Name; |
fbf5a39b AC |
408 | end if; |
409 | ||
6510f4c9 GB |
410 | Index := File_Hash_Table.Get (File); |
411 | ||
412 | if Index = No_Entry then | |
413 | return No_File; | |
6510f4c9 | 414 | else |
07fc65c4 | 415 | return Path_Mapping.Table (Index).Fname; |
6510f4c9 | 416 | end if; |
17c5c8a5 | 417 | end Mapped_Path_Name; |
6510f4c9 | 418 | |
fbf5a39b AC |
419 | ------------------ |
420 | -- Reset_Tables -- | |
421 | ------------------ | |
422 | ||
423 | procedure Reset_Tables is | |
424 | begin | |
425 | File_Mapping.Init; | |
426 | Path_Mapping.Init; | |
427 | Unit_Hash_Table.Reset; | |
428 | File_Hash_Table.Reset; | |
429 | Forbidden_Names.Reset; | |
430 | Last_In_Table := 0; | |
431 | end Reset_Tables; | |
432 | ||
07fc65c4 GB |
433 | ------------------------- |
434 | -- Update_Mapping_File -- | |
435 | ------------------------- | |
436 | ||
437 | procedure Update_Mapping_File (File_Name : String) is | |
fbf5a39b AC |
438 | File : File_Descriptor; |
439 | N_Bytes : Integer; | |
440 | ||
2cd44f5a VC |
441 | File_Entry : Int; |
442 | ||
fbf5a39b AC |
443 | Status : Boolean; |
444 | -- For the call to Close | |
07fc65c4 GB |
445 | |
446 | procedure Put_Line (Name : Name_Id); | |
447 | -- Put Name as a line in the Mapping File | |
448 | ||
449 | -------------- | |
450 | -- Put_Line -- | |
451 | -------------- | |
452 | ||
453 | procedure Put_Line (Name : Name_Id) is | |
07fc65c4 GB |
454 | begin |
455 | Get_Name_String (Name); | |
07fc65c4 | 456 | |
fbf5a39b AC |
457 | -- If the Buffer is full, write it to the file |
458 | ||
459 | if Buffer_Last + Name_Len + 1 > Buffer'Last then | |
460 | N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last); | |
461 | ||
462 | if N_Bytes < Buffer_Last then | |
463 | Fail ("disk full"); | |
464 | end if; | |
465 | ||
466 | Buffer_Last := 0; | |
07fc65c4 GB |
467 | end if; |
468 | ||
fbf5a39b AC |
469 | -- Add the line to the Buffer |
470 | ||
471 | Buffer (Buffer_Last + 1 .. Buffer_Last + Name_Len) := | |
472 | Name_Buffer (1 .. Name_Len); | |
473 | Buffer_Last := Buffer_Last + Name_Len + 1; | |
474 | Buffer (Buffer_Last) := ASCII.LF; | |
07fc65c4 GB |
475 | end Put_Line; |
476 | ||
704228bd | 477 | -- Start of processing for Update_Mapping_File |
07fc65c4 GB |
478 | |
479 | begin | |
a1e2130c RD |
480 | -- If the mapping file could not be read, then it will not be possible |
481 | -- to update it. | |
07fc65c4 | 482 | |
a1e2130c RD |
483 | if No_Mapping_File then |
484 | return; | |
485 | end if; | |
07fc65c4 GB |
486 | -- Only Update if there are new entries in the mappings |
487 | ||
488 | if Last_In_Table < File_Mapping.Last then | |
489 | ||
a1e2130c | 490 | File := Open_Read_Write (Name => File_Name, Fmode => Binary); |
07fc65c4 GB |
491 | |
492 | if File /= Invalid_FD then | |
493 | if Last_In_Table > 0 then | |
494 | Lseek (File, 0, Seek_End); | |
495 | end if; | |
496 | ||
497 | for Unit in Last_In_Table + 1 .. File_Mapping.Last loop | |
39f4e199 VC |
498 | Put_Line (Name_Id (File_Mapping.Table (Unit).Uname)); |
499 | Put_Line (Name_Id (File_Mapping.Table (Unit).Fname)); | |
2cd44f5a VC |
500 | File_Entry := |
501 | File_Hash_Table.Get (File_Mapping.Table (Unit).Fname); | |
502 | Put_Line (Name_Id (Path_Mapping.Table (File_Entry).Fname)); | |
07fc65c4 GB |
503 | end loop; |
504 | ||
2cd44f5a VC |
505 | -- Before closing the file, write the buffer to the file. It is |
506 | -- guaranteed that the Buffer is not empty, because Put_Line has | |
507 | -- been called at least 3 times, and after a call to Put_Line, the | |
508 | -- Buffer is not empty. | |
fbf5a39b AC |
509 | |
510 | N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last); | |
511 | ||
512 | if N_Bytes < Buffer_Last then | |
513 | Fail ("disk full"); | |
514 | end if; | |
515 | ||
516 | Close (File, Status); | |
517 | ||
518 | if not Status then | |
519 | Fail ("disk full"); | |
520 | end if; | |
07fc65c4 GB |
521 | |
522 | elsif not Quiet_Output then | |
523 | Write_Str ("warning: could not open mapping file """); | |
524 | Write_Str (File_Name); | |
525 | Write_Line (""" for update"); | |
526 | end if; | |
527 | ||
528 | end if; | |
529 | end Update_Mapping_File; | |
530 | ||
6510f4c9 | 531 | end Fmap; |