]>
Commit | Line | Data |
---|---|---|
6510f4c9 GB |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- F M A P -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 2001-2003, 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- -- | |
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, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
6510f4c9 GB |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
07fc65c4 GB |
27 | with GNAT.OS_Lib; use GNAT.OS_Lib; |
28 | with Namet; use Namet; | |
29 | with Opt; use Opt; | |
30 | with Osint; use Osint; | |
31 | with Output; use Output; | |
6510f4c9 GB |
32 | with Table; |
33 | ||
34 | with Unchecked_Conversion; | |
35 | ||
17c5c8a5 GB |
36 | with GNAT.HTable; |
37 | ||
6510f4c9 GB |
38 | package body Fmap is |
39 | ||
40 | subtype Big_String is String (Positive); | |
41 | type Big_String_Ptr is access all Big_String; | |
42 | ||
43 | function To_Big_String_Ptr is new Unchecked_Conversion | |
44 | (Source_Buffer_Ptr, Big_String_Ptr); | |
45 | ||
fbf5a39b AC |
46 | Max_Buffer : constant := 1_500; |
47 | Buffer : String (1 .. Max_Buffer); | |
48 | -- Used to bufferize output when writing to a new mapping file | |
49 | ||
50 | Buffer_Last : Natural := 0; | |
51 | -- Index of last valid character in Buffer | |
52 | ||
07fc65c4 GB |
53 | type Mapping is record |
54 | Uname : Unit_Name_Type; | |
55 | Fname : File_Name_Type; | |
56 | end record; | |
57 | ||
6510f4c9 | 58 | package File_Mapping is new Table.Table ( |
07fc65c4 | 59 | Table_Component_Type => Mapping, |
6510f4c9 GB |
60 | Table_Index_Type => Int, |
61 | Table_Low_Bound => 0, | |
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. | |
66 | ||
67 | package Path_Mapping is new Table.Table ( | |
07fc65c4 | 68 | Table_Component_Type => Mapping, |
6510f4c9 GB |
69 | Table_Index_Type => Int, |
70 | Table_Low_Bound => 0, | |
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 | |
75 | ||
76 | type Header_Num is range 0 .. 1_000; | |
77 | ||
78 | function Hash (F : Unit_Name_Type) return Header_Num; | |
17c5c8a5 | 79 | -- Function used to compute hash of unit name |
6510f4c9 GB |
80 | |
81 | No_Entry : constant Int := -1; | |
82 | -- Signals no entry in following table | |
83 | ||
84 | package Unit_Hash_Table is new GNAT.HTable.Simple_HTable ( | |
85 | Header_Num => Header_Num, | |
86 | Element => Int, | |
87 | No_Element => No_Entry, | |
88 | Key => Unit_Name_Type, | |
89 | Hash => Hash, | |
90 | Equal => "="); | |
91 | -- Hash table to map unit names to file names. Used in conjunction with | |
92 | -- table File_Mapping above. | |
93 | ||
94 | package File_Hash_Table is new GNAT.HTable.Simple_HTable ( | |
95 | Header_Num => Header_Num, | |
96 | Element => Int, | |
97 | No_Element => No_Entry, | |
98 | Key => File_Name_Type, | |
99 | Hash => Hash, | |
100 | Equal => "="); | |
101 | -- Hash table to map file names to path names. Used in conjunction with | |
102 | -- table Path_Mapping above. | |
103 | ||
07fc65c4 GB |
104 | Last_In_Table : Int := 0; |
105 | ||
fbf5a39b AC |
106 | package Forbidden_Names is new GNAT.HTable.Simple_HTable ( |
107 | Header_Num => Header_Num, | |
108 | Element => Boolean, | |
109 | No_Element => False, | |
110 | Key => File_Name_Type, | |
111 | Hash => Hash, | |
112 | Equal => "="); | |
113 | ||
114 | ----------------------------- | |
115 | -- Add_Forbidden_File_Name -- | |
116 | ----------------------------- | |
117 | ||
118 | procedure Add_Forbidden_File_Name (Name : Name_Id) is | |
119 | begin | |
120 | Forbidden_Names.Set (Name, True); | |
121 | end Add_Forbidden_File_Name; | |
122 | ||
17c5c8a5 GB |
123 | --------------------- |
124 | -- Add_To_File_Map -- | |
125 | --------------------- | |
6510f4c9 | 126 | |
17c5c8a5 | 127 | procedure Add_To_File_Map |
6510f4c9 GB |
128 | (Unit_Name : Unit_Name_Type; |
129 | File_Name : File_Name_Type; | |
17c5c8a5 GB |
130 | Path_Name : File_Name_Type) |
131 | is | |
6510f4c9 GB |
132 | begin |
133 | File_Mapping.Increment_Last; | |
134 | Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last); | |
07fc65c4 GB |
135 | File_Mapping.Table (File_Mapping.Last) := |
136 | (Uname => Unit_Name, Fname => File_Name); | |
6510f4c9 GB |
137 | Path_Mapping.Increment_Last; |
138 | File_Hash_Table.Set (File_Name, Path_Mapping.Last); | |
07fc65c4 GB |
139 | Path_Mapping.Table (Path_Mapping.Last) := |
140 | (Uname => Unit_Name, Fname => Path_Name); | |
17c5c8a5 | 141 | end Add_To_File_Map; |
6510f4c9 GB |
142 | |
143 | ---------- | |
144 | -- Hash -- | |
145 | ---------- | |
146 | ||
147 | function Hash (F : Unit_Name_Type) return Header_Num is | |
148 | begin | |
149 | return Header_Num (Int (F) rem Header_Num'Range_Length); | |
150 | end Hash; | |
151 | ||
152 | ---------------- | |
153 | -- Initialize -- | |
154 | ---------------- | |
155 | ||
156 | procedure Initialize (File_Name : String) is | |
157 | Src : Source_Buffer_Ptr; | |
158 | Hi : Source_Ptr; | |
159 | BS : Big_String_Ptr; | |
160 | SP : String_Ptr; | |
161 | ||
07fc65c4 GB |
162 | First : Positive := 1; |
163 | Last : Natural := 0; | |
6510f4c9 GB |
164 | |
165 | Uname : Unit_Name_Type; | |
166 | Fname : Name_Id; | |
167 | Pname : Name_Id; | |
168 | ||
07fc65c4 GB |
169 | The_Mapping : Mapping; |
170 | ||
fbf5a39b | 171 | procedure Empty_Tables (Warning : Boolean := True); |
6510f4c9 GB |
172 | -- Remove all entries in case of incorrect mapping file |
173 | ||
fbf5a39b AC |
174 | function Find_Name return Name_Id; |
175 | -- Return Error_Name for "/", otherwise call Name_Find | |
176 | ||
6510f4c9 GB |
177 | procedure Get_Line; |
178 | -- Get a line from the mapping file | |
179 | ||
180 | procedure Report_Truncated; | |
181 | -- Report a warning when the mapping file is truncated | |
182 | -- (number of lines is not a multiple of 3). | |
183 | ||
184 | ------------------ | |
185 | -- Empty_Tables -- | |
186 | ------------------ | |
187 | ||
fbf5a39b | 188 | procedure Empty_Tables (Warning : Boolean := True) is |
6510f4c9 | 189 | begin |
fbf5a39b AC |
190 | if Warning then |
191 | Write_Str ("mapping file """); | |
192 | Write_Str (File_Name); | |
193 | Write_Line (""" is not taken into account"); | |
194 | end if; | |
195 | ||
6510f4c9 GB |
196 | Unit_Hash_Table.Reset; |
197 | File_Hash_Table.Reset; | |
198 | Path_Mapping.Set_Last (0); | |
199 | File_Mapping.Set_Last (0); | |
07fc65c4 | 200 | Last_In_Table := 0; |
6510f4c9 GB |
201 | end Empty_Tables; |
202 | ||
203 | -------------- | |
204 | -- Get_Line -- | |
205 | -------------- | |
206 | ||
207 | procedure Get_Line is | |
208 | use ASCII; | |
17c5c8a5 | 209 | |
6510f4c9 | 210 | begin |
07fc65c4 | 211 | First := Last + 1; |
6510f4c9 GB |
212 | |
213 | -- If not at the end of file, skip the end of line | |
17c5c8a5 | 214 | |
07fc65c4 GB |
215 | while First < SP'Last |
216 | and then (SP (First) = CR | |
217 | or else SP (First) = LF | |
218 | or else SP (First) = EOF) | |
6510f4c9 | 219 | loop |
07fc65c4 | 220 | First := First + 1; |
6510f4c9 GB |
221 | end loop; |
222 | ||
07fc65c4 | 223 | -- If not at the end of file, find the end of this new line |
6510f4c9 | 224 | |
07fc65c4 GB |
225 | if First < SP'Last and then SP (First) /= EOF then |
226 | Last := First; | |
6510f4c9 | 227 | |
07fc65c4 GB |
228 | while Last < SP'Last |
229 | and then SP (Last + 1) /= CR | |
230 | and then SP (Last + 1) /= LF | |
231 | and then SP (Last + 1) /= EOF | |
6510f4c9 | 232 | loop |
07fc65c4 | 233 | Last := Last + 1; |
6510f4c9 GB |
234 | end loop; |
235 | ||
236 | end if; | |
237 | end Get_Line; | |
238 | ||
fbf5a39b AC |
239 | --------------- |
240 | -- Find_Name -- | |
241 | --------------- | |
242 | ||
243 | function Find_Name return Name_Id is | |
244 | begin | |
245 | if Name_Buffer (1 .. Name_Len) = "/" then | |
246 | return Error_Name; | |
247 | ||
248 | else | |
249 | return Name_Find; | |
250 | end if; | |
251 | end Find_Name; | |
252 | ||
6510f4c9 GB |
253 | ---------------------- |
254 | -- Report_Truncated -- | |
255 | ---------------------- | |
256 | ||
257 | procedure Report_Truncated is | |
258 | begin | |
fbf5a39b AC |
259 | Write_Str ("warning: mapping file """); |
260 | Write_Str (File_Name); | |
261 | Write_Line (""" is truncated"); | |
6510f4c9 GB |
262 | end Report_Truncated; |
263 | ||
17c5c8a5 | 264 | -- Start of procedure Initialize |
6510f4c9 GB |
265 | |
266 | begin | |
fbf5a39b | 267 | Empty_Tables (Warning => False); |
6510f4c9 GB |
268 | Name_Len := File_Name'Length; |
269 | Name_Buffer (1 .. Name_Len) := File_Name; | |
270 | Read_Source_File (Name_Enter, 0, Hi, Src, Config); | |
271 | ||
272 | if Src = null then | |
fbf5a39b AC |
273 | Write_Str ("warning: could not read mapping file """); |
274 | Write_Str (File_Name); | |
275 | Write_Line (""""); | |
6510f4c9 GB |
276 | |
277 | else | |
278 | BS := To_Big_String_Ptr (Src); | |
279 | SP := BS (1 .. Natural (Hi))'Unrestricted_Access; | |
280 | ||
281 | loop | |
6510f4c9 GB |
282 | -- Get the unit name |
283 | ||
284 | Get_Line; | |
285 | ||
286 | -- Exit if end of file has been reached | |
287 | ||
07fc65c4 | 288 | exit when First > Last; |
6510f4c9 | 289 | |
fbf5a39b AC |
290 | if (Last < First + 2) or else (SP (Last - 1) /= '%') |
291 | or else (SP (Last) /= 's' and then SP (Last) /= 'b') | |
292 | then | |
293 | Write_Str ("warning: mapping file """); | |
294 | Write_Str (File_Name); | |
295 | Write_Line (""" is incorrectly formated"); | |
296 | Empty_Tables; | |
297 | return; | |
298 | end if; | |
299 | ||
6510f4c9 | 300 | |
07fc65c4 GB |
301 | Name_Len := Last - First + 1; |
302 | Name_Buffer (1 .. Name_Len) := SP (First .. Last); | |
fbf5a39b | 303 | Uname := Find_Name; |
6510f4c9 GB |
304 | |
305 | -- Get the file name | |
306 | ||
307 | Get_Line; | |
308 | ||
309 | -- If end of line has been reached, file is truncated | |
310 | ||
07fc65c4 | 311 | if First > Last then |
6510f4c9 GB |
312 | Report_Truncated; |
313 | Empty_Tables; | |
314 | return; | |
315 | end if; | |
316 | ||
07fc65c4 GB |
317 | Name_Len := Last - First + 1; |
318 | Name_Buffer (1 .. Name_Len) := SP (First .. Last); | |
fbf5a39b AC |
319 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
320 | Fname := Find_Name; | |
6510f4c9 GB |
321 | |
322 | -- Get the path name | |
323 | ||
324 | Get_Line; | |
325 | ||
326 | -- If end of line has been reached, file is truncated | |
327 | ||
07fc65c4 | 328 | if First > Last then |
6510f4c9 GB |
329 | Report_Truncated; |
330 | Empty_Tables; | |
331 | return; | |
332 | end if; | |
333 | ||
07fc65c4 GB |
334 | Name_Len := Last - First + 1; |
335 | Name_Buffer (1 .. Name_Len) := SP (First .. Last); | |
fbf5a39b | 336 | Pname := Find_Name; |
6510f4c9 GB |
337 | |
338 | -- Check for duplicate entries | |
339 | ||
340 | if Unit_Hash_Table.Get (Uname) /= No_Entry then | |
fbf5a39b AC |
341 | Write_Str ("warning: duplicate entry """); |
342 | Write_Str (Get_Name_String (Uname)); | |
343 | Write_Str (""" in mapping file """); | |
344 | Write_Str (File_Name); | |
345 | Write_Line (""""); | |
346 | The_Mapping := File_Mapping.Table (Unit_Hash_Table.Get (Uname)); | |
347 | Write_Line (Get_Name_String (The_Mapping.Uname)); | |
348 | Write_Line (Get_Name_String (The_Mapping.Fname)); | |
6510f4c9 GB |
349 | Empty_Tables; |
350 | return; | |
351 | end if; | |
352 | ||
353 | if File_Hash_Table.Get (Fname) /= No_Entry then | |
fbf5a39b AC |
354 | Write_Str ("warning: duplicate entry """); |
355 | Write_Str (Get_Name_String (Fname)); | |
356 | Write_Str (""" in mapping file """); | |
357 | Write_Str (File_Name); | |
358 | Write_Line (""""); | |
359 | The_Mapping := Path_Mapping.Table (File_Hash_Table.Get (Fname)); | |
360 | Write_Line (Get_Name_String (The_Mapping.Uname)); | |
361 | Write_Line (Get_Name_String (The_Mapping.Fname)); | |
6510f4c9 GB |
362 | Empty_Tables; |
363 | return; | |
364 | end if; | |
365 | ||
366 | -- Add the mappings for this unit name | |
367 | ||
17c5c8a5 | 368 | Add_To_File_Map (Uname, Fname, Pname); |
6510f4c9 | 369 | end loop; |
6510f4c9 | 370 | end if; |
07fc65c4 GB |
371 | |
372 | -- Record the length of the two mapping tables | |
373 | ||
374 | Last_In_Table := File_Mapping.Last; | |
375 | ||
6510f4c9 GB |
376 | end Initialize; |
377 | ||
17c5c8a5 GB |
378 | ---------------------- |
379 | -- Mapped_File_Name -- | |
380 | ---------------------- | |
381 | ||
382 | function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is | |
383 | The_Index : constant Int := Unit_Hash_Table.Get (Unit); | |
384 | ||
385 | begin | |
386 | if The_Index = No_Entry then | |
387 | return No_File; | |
388 | else | |
07fc65c4 | 389 | return File_Mapping.Table (The_Index).Fname; |
17c5c8a5 GB |
390 | end if; |
391 | end Mapped_File_Name; | |
392 | ||
393 | ---------------------- | |
394 | -- Mapped_Path_Name -- | |
395 | ---------------------- | |
6510f4c9 | 396 | |
17c5c8a5 | 397 | function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is |
6510f4c9 | 398 | Index : Int := No_Entry; |
17c5c8a5 | 399 | |
6510f4c9 | 400 | begin |
fbf5a39b AC |
401 | if Forbidden_Names.Get (File) then |
402 | return Error_Name; | |
403 | end if; | |
404 | ||
6510f4c9 GB |
405 | Index := File_Hash_Table.Get (File); |
406 | ||
407 | if Index = No_Entry then | |
408 | return No_File; | |
6510f4c9 | 409 | else |
07fc65c4 | 410 | return Path_Mapping.Table (Index).Fname; |
6510f4c9 | 411 | end if; |
17c5c8a5 | 412 | end Mapped_Path_Name; |
6510f4c9 | 413 | |
fbf5a39b AC |
414 | -------------------------------- |
415 | -- Remove_Forbidden_File_Name -- | |
416 | -------------------------------- | |
417 | ||
418 | procedure Remove_Forbidden_File_Name (Name : Name_Id) is | |
419 | begin | |
420 | Forbidden_Names.Set (Name, False); | |
421 | end Remove_Forbidden_File_Name; | |
422 | ||
423 | ------------------ | |
424 | -- Reset_Tables -- | |
425 | ------------------ | |
426 | ||
427 | procedure Reset_Tables is | |
428 | begin | |
429 | File_Mapping.Init; | |
430 | Path_Mapping.Init; | |
431 | Unit_Hash_Table.Reset; | |
432 | File_Hash_Table.Reset; | |
433 | Forbidden_Names.Reset; | |
434 | Last_In_Table := 0; | |
435 | end Reset_Tables; | |
436 | ||
07fc65c4 GB |
437 | ------------------------- |
438 | -- Update_Mapping_File -- | |
439 | ------------------------- | |
440 | ||
441 | procedure Update_Mapping_File (File_Name : String) is | |
fbf5a39b AC |
442 | File : File_Descriptor; |
443 | N_Bytes : Integer; | |
444 | ||
445 | Status : Boolean; | |
446 | -- For the call to Close | |
07fc65c4 GB |
447 | |
448 | procedure Put_Line (Name : Name_Id); | |
449 | -- Put Name as a line in the Mapping File | |
450 | ||
451 | -------------- | |
452 | -- Put_Line -- | |
453 | -------------- | |
454 | ||
455 | procedure Put_Line (Name : Name_Id) is | |
07fc65c4 GB |
456 | begin |
457 | Get_Name_String (Name); | |
07fc65c4 | 458 | |
fbf5a39b AC |
459 | -- If the Buffer is full, write it to the file |
460 | ||
461 | if Buffer_Last + Name_Len + 1 > Buffer'Last then | |
462 | N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last); | |
463 | ||
464 | if N_Bytes < Buffer_Last then | |
465 | Fail ("disk full"); | |
466 | end if; | |
467 | ||
468 | Buffer_Last := 0; | |
07fc65c4 GB |
469 | end if; |
470 | ||
fbf5a39b AC |
471 | -- Add the line to the Buffer |
472 | ||
473 | Buffer (Buffer_Last + 1 .. Buffer_Last + Name_Len) := | |
474 | Name_Buffer (1 .. Name_Len); | |
475 | Buffer_Last := Buffer_Last + Name_Len + 1; | |
476 | Buffer (Buffer_Last) := ASCII.LF; | |
07fc65c4 GB |
477 | end Put_Line; |
478 | ||
479 | -- Start of Update_Mapping_File | |
480 | ||
481 | begin | |
482 | ||
483 | -- Only Update if there are new entries in the mappings | |
484 | ||
485 | if Last_In_Table < File_Mapping.Last then | |
486 | ||
487 | -- If the tables have been emptied, recreate the file. | |
488 | -- Otherwise, append to it. | |
489 | ||
490 | if Last_In_Table = 0 then | |
491 | declare | |
492 | Discard : Boolean; | |
493 | ||
494 | begin | |
495 | Delete_File (File_Name, Discard); | |
496 | end; | |
497 | ||
498 | File := Create_File (File_Name, Binary); | |
499 | ||
500 | else | |
501 | File := Open_Read_Write (Name => File_Name, Fmode => Binary); | |
502 | end if; | |
503 | ||
504 | if File /= Invalid_FD then | |
505 | if Last_In_Table > 0 then | |
506 | Lseek (File, 0, Seek_End); | |
507 | end if; | |
508 | ||
509 | for Unit in Last_In_Table + 1 .. File_Mapping.Last loop | |
510 | Put_Line (File_Mapping.Table (Unit).Uname); | |
511 | Put_Line (File_Mapping.Table (Unit).Fname); | |
512 | Put_Line (Path_Mapping.Table (Unit).Fname); | |
513 | end loop; | |
514 | ||
fbf5a39b AC |
515 | -- Before closing the file, write the buffer to the file. |
516 | -- It is guaranteed that the Buffer is not empty, because | |
517 | -- Put_Line has been called at least 3 times, and after | |
518 | -- a call to Put_Line, the Buffer is not empty. | |
519 | ||
520 | N_Bytes := Write (File, Buffer (1)'Address, Buffer_Last); | |
521 | ||
522 | if N_Bytes < Buffer_Last then | |
523 | Fail ("disk full"); | |
524 | end if; | |
525 | ||
526 | Close (File, Status); | |
527 | ||
528 | if not Status then | |
529 | Fail ("disk full"); | |
530 | end if; | |
07fc65c4 GB |
531 | |
532 | elsif not Quiet_Output then | |
533 | Write_Str ("warning: could not open mapping file """); | |
534 | Write_Str (File_Name); | |
535 | Write_Line (""" for update"); | |
536 | end if; | |
537 | ||
538 | end if; | |
539 | end Update_Mapping_File; | |
540 | ||
6510f4c9 | 541 | end Fmap; |