]>
Commit | Line | Data |
---|---|---|
8f9df7d8 VC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- M A K E U T L -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
74744c7b | 9 | -- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- |
8f9df7d8 VC |
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- -- |
8f9df7d8 VC |
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. -- | |
8f9df7d8 VC |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
23 | -- -- | |
24 | ------------------------------------------------------------------------------ | |
25 | ||
38990220 | 26 | with ALI; use ALI; |
7d903840 | 27 | with Debug; |
fdfcc663 | 28 | with Fname; |
5950a3ac | 29 | with Osint; use Osint; |
2cd44f5a | 30 | with Output; use Output; |
f7e71125 | 31 | with Opt; use Opt; |
8f9df7d8 VC |
32 | with Prj.Ext; |
33 | with Prj.Util; | |
5950a3ac | 34 | with Snames; use Snames; |
8f9df7d8 | 35 | with Table; |
8f9df7d8 | 36 | |
7d903840 AC |
37 | with Ada.Command_Line; use Ada.Command_Line; |
38 | ||
39 | with GNAT.Directory_Operations; use GNAT.Directory_Operations; | |
40 | ||
958a816e | 41 | with System.Case_Util; use System.Case_Util; |
aa720a54 AC |
42 | with System.HTable; |
43 | ||
8f9df7d8 VC |
44 | package body Makeutl is |
45 | ||
aa720a54 AC |
46 | type Mark_Key is record |
47 | File : File_Name_Type; | |
48 | Index : Int; | |
49 | end record; | |
50 | -- Identify either a mono-unit source (when Index = 0) or a specific unit | |
7d903840 | 51 | -- (index = 1's origin index of unit) in a multi-unit source. |
aa720a54 | 52 | |
5950a3ac AC |
53 | -- There follow many global undocumented declarations, comments needed ??? |
54 | ||
aa720a54 AC |
55 | Max_Mask_Num : constant := 2048; |
56 | ||
57 | subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1; | |
58 | ||
59 | function Hash (Key : Mark_Key) return Mark_Num; | |
60 | ||
61 | package Marks is new System.HTable.Simple_HTable | |
62 | (Header_Num => Mark_Num, | |
63 | Element => Boolean, | |
64 | No_Element => False, | |
65 | Key => Mark_Key, | |
66 | Hash => Hash, | |
67 | Equal => "="); | |
9de61fcb | 68 | -- A hash table to keep tracks of the marked units |
aa720a54 | 69 | |
8f9df7d8 VC |
70 | type Linker_Options_Data is record |
71 | Project : Project_Id; | |
72 | Options : String_List_Id; | |
73 | end record; | |
74 | ||
75 | Linker_Option_Initial_Count : constant := 20; | |
76 | ||
77 | Linker_Options_Buffer : String_List_Access := | |
78 | new String_List (1 .. Linker_Option_Initial_Count); | |
79 | ||
80 | Last_Linker_Option : Natural := 0; | |
81 | ||
82 | package Linker_Opts is new Table.Table ( | |
83 | Table_Component_Type => Linker_Options_Data, | |
84 | Table_Index_Type => Integer, | |
85 | Table_Low_Bound => 1, | |
86 | Table_Initial => 10, | |
87 | Table_Increment => 100, | |
88 | Table_Name => "Make.Linker_Opts"); | |
89 | ||
90 | procedure Add_Linker_Option (Option : String); | |
91 | ||
2cd44f5a VC |
92 | --------- |
93 | -- Add -- | |
94 | --------- | |
95 | ||
96 | procedure Add | |
97 | (Option : String_Access; | |
98 | To : in out String_List_Access; | |
99 | Last : in out Natural) | |
100 | is | |
101 | begin | |
102 | if Last = To'Last then | |
103 | declare | |
104 | New_Options : constant String_List_Access := | |
105 | new String_List (1 .. To'Last * 2); | |
74744c7b | 106 | |
2cd44f5a VC |
107 | begin |
108 | New_Options (To'Range) := To.all; | |
109 | ||
110 | -- Set all elements of the original options to null to avoid | |
111 | -- deallocation of copies. | |
112 | ||
113 | To.all := (others => null); | |
114 | ||
115 | Free (To); | |
116 | To := New_Options; | |
117 | end; | |
118 | end if; | |
119 | ||
120 | Last := Last + 1; | |
121 | To (Last) := Option; | |
122 | end Add; | |
123 | ||
124 | procedure Add | |
125 | (Option : String; | |
126 | To : in out String_List_Access; | |
127 | Last : in out Natural) | |
128 | is | |
129 | begin | |
130 | Add (Option => new String'(Option), To => To, Last => Last); | |
131 | end Add; | |
132 | ||
8f9df7d8 VC |
133 | ----------------------- |
134 | -- Add_Linker_Option -- | |
135 | ----------------------- | |
136 | ||
137 | procedure Add_Linker_Option (Option : String) is | |
138 | begin | |
139 | if Option'Length > 0 then | |
140 | if Last_Linker_Option = Linker_Options_Buffer'Last then | |
141 | declare | |
142 | New_Buffer : constant String_List_Access := | |
5950a3ac AC |
143 | new String_List |
144 | (1 .. Linker_Options_Buffer'Last + | |
145 | Linker_Option_Initial_Count); | |
8f9df7d8 VC |
146 | begin |
147 | New_Buffer (Linker_Options_Buffer'Range) := | |
148 | Linker_Options_Buffer.all; | |
149 | Linker_Options_Buffer.all := (others => null); | |
150 | Free (Linker_Options_Buffer); | |
151 | Linker_Options_Buffer := New_Buffer; | |
152 | end; | |
153 | end if; | |
154 | ||
155 | Last_Linker_Option := Last_Linker_Option + 1; | |
156 | Linker_Options_Buffer (Last_Linker_Option) := new String'(Option); | |
157 | end if; | |
158 | end Add_Linker_Option; | |
159 | ||
38990220 EB |
160 | ------------------------------ |
161 | -- Check_Source_Info_In_ALI -- | |
162 | ------------------------------ | |
163 | ||
164 | function Check_Source_Info_In_ALI (The_ALI : ALI_Id) return Boolean is | |
165 | Unit_Name : Name_Id; | |
8d12c865 | 166 | |
38990220 | 167 | begin |
8d12c865 RD |
168 | -- Loop through units |
169 | ||
170 | for U in ALIs.Table (The_ALI).First_Unit .. | |
171 | ALIs.Table (The_ALI).Last_Unit | |
38990220 | 172 | loop |
8d12c865 | 173 | -- Check if the file name is one of the source of the unit |
38990220 EB |
174 | |
175 | Get_Name_String (Units.Table (U).Uname); | |
176 | Name_Len := Name_Len - 2; | |
177 | Unit_Name := Name_Find; | |
178 | ||
179 | if File_Not_A_Source_Of (Unit_Name, Units.Table (U).Sfile) then | |
180 | return False; | |
181 | end if; | |
182 | ||
8d12c865 | 183 | -- Loop to do same check for each of the withed units |
38990220 | 184 | |
38990220 EB |
185 | for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop |
186 | declare | |
187 | WR : ALI.With_Record renames Withs.Table (W); | |
8d12c865 | 188 | |
38990220 EB |
189 | begin |
190 | if WR.Sfile /= No_File then | |
191 | Get_Name_String (WR.Uname); | |
192 | Name_Len := Name_Len - 2; | |
193 | Unit_Name := Name_Find; | |
194 | ||
195 | if File_Not_A_Source_Of (Unit_Name, WR.Sfile) then | |
196 | return False; | |
197 | end if; | |
198 | end if; | |
199 | end; | |
8d12c865 RD |
200 | end loop; |
201 | end loop; | |
38990220 | 202 | |
8d12c865 | 203 | -- Loop to check subunits |
38990220 | 204 | |
8d12c865 RD |
205 | for D in ALIs.Table (The_ALI).First_Sdep .. |
206 | ALIs.Table (The_ALI).Last_Sdep | |
38990220 EB |
207 | loop |
208 | declare | |
209 | SD : Sdep_Record renames Sdep.Table (D); | |
8d12c865 | 210 | |
38990220 EB |
211 | begin |
212 | Unit_Name := SD.Subunit_Name; | |
213 | ||
214 | if Unit_Name /= No_Name then | |
8d12c865 | 215 | |
38990220 | 216 | -- For separates, the file is no longer associated with the |
fdfcc663 AC |
217 | -- unit ("proc-sep.adb" is not associated with unit "proc.sep") |
218 | -- so we need to check whether the source file still exists in | |
38990220 EB |
219 | -- the source tree: it will if it matches the naming scheme |
220 | -- (and then will be for the same unit). | |
221 | ||
222 | if Find_Source | |
76b84bf0 AC |
223 | (In_Tree => Project_Tree, |
224 | Project => No_Project, | |
225 | Base_Name => SD.Sfile) = No_Source | |
38990220 | 226 | then |
fdfcc663 AC |
227 | -- If this is not a runtime file or if, when gnatmake switch |
228 | -- -a is used, we are not able to find this subunit in the | |
229 | -- source directories, then recompilation is needed. | |
230 | ||
231 | if not Fname.Is_Internal_File_Name (SD.Sfile) | |
232 | or else | |
76b84bf0 AC |
233 | (Check_Readonly_Files |
234 | and then Find_File (SD.Sfile, Osint.Source) = No_File) | |
38990220 EB |
235 | then |
236 | if Verbose_Mode then | |
237 | Write_Line | |
fdfcc663 | 238 | ("While parsing ALI file, file " |
38990220 | 239 | & Get_Name_String (SD.Sfile) |
fdfcc663 AC |
240 | & " is indicated as containing subunit " |
241 | & Get_Name_String (Unit_Name) | |
38990220 EB |
242 | & " but this does not match what was found while" |
243 | & " parsing the project. Will recompile"); | |
244 | end if; | |
76b84bf0 | 245 | |
38990220 EB |
246 | return False; |
247 | end if; | |
248 | end if; | |
249 | end if; | |
250 | end; | |
8d12c865 | 251 | end loop; |
38990220 EB |
252 | |
253 | return True; | |
254 | end Check_Source_Info_In_ALI; | |
255 | ||
2cd44f5a VC |
256 | ----------------- |
257 | -- Create_Name -- | |
258 | ----------------- | |
259 | ||
260 | function Create_Name (Name : String) return File_Name_Type is | |
261 | begin | |
262 | Name_Len := 0; | |
263 | Add_Str_To_Name_Buffer (Name); | |
264 | return Name_Find; | |
265 | end Create_Name; | |
266 | ||
267 | function Create_Name (Name : String) return Name_Id is | |
268 | begin | |
269 | Name_Len := 0; | |
270 | Add_Str_To_Name_Buffer (Name); | |
271 | return Name_Find; | |
272 | end Create_Name; | |
273 | ||
274 | function Create_Name (Name : String) return Path_Name_Type is | |
275 | begin | |
276 | Name_Len := 0; | |
277 | Add_Str_To_Name_Buffer (Name); | |
278 | return Name_Find; | |
279 | end Create_Name; | |
280 | ||
aa720a54 AC |
281 | ---------------------- |
282 | -- Delete_All_Marks -- | |
283 | ---------------------- | |
284 | ||
285 | procedure Delete_All_Marks is | |
286 | begin | |
287 | Marks.Reset; | |
288 | end Delete_All_Marks; | |
289 | ||
958a816e VC |
290 | ---------------------------- |
291 | -- Executable_Prefix_Path -- | |
292 | ---------------------------- | |
293 | ||
294 | function Executable_Prefix_Path return String is | |
295 | Exec_Name : constant String := Command_Name; | |
296 | ||
297 | function Get_Install_Dir (S : String) return String; | |
74744c7b AC |
298 | -- S is the executable name preceded by the absolute or relative path, |
299 | -- e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory where "bin" | |
300 | -- lies (in the example "C:\usr"). If the executable is not in a "bin" | |
301 | -- directory, return "". | |
958a816e VC |
302 | |
303 | --------------------- | |
304 | -- Get_Install_Dir -- | |
305 | --------------------- | |
306 | ||
307 | function Get_Install_Dir (S : String) return String is | |
308 | Exec : String := S; | |
309 | Path_Last : Integer := 0; | |
310 | ||
311 | begin | |
312 | for J in reverse Exec'Range loop | |
313 | if Exec (J) = Directory_Separator then | |
314 | Path_Last := J - 1; | |
315 | exit; | |
316 | end if; | |
317 | end loop; | |
318 | ||
319 | if Path_Last >= Exec'First + 2 then | |
320 | To_Lower (Exec (Path_Last - 2 .. Path_Last)); | |
321 | end if; | |
322 | ||
323 | if Path_Last < Exec'First + 2 | |
324 | or else Exec (Path_Last - 2 .. Path_Last) /= "bin" | |
325 | or else (Path_Last - 3 >= Exec'First | |
326 | and then Exec (Path_Last - 3) /= Directory_Separator) | |
327 | then | |
328 | return ""; | |
329 | end if; | |
330 | ||
5fd3fd79 AC |
331 | return Normalize_Pathname |
332 | (Exec (Exec'First .. Path_Last - 4), | |
333 | Resolve_Links => Opt.Follow_Links_For_Dirs) | |
659819b9 | 334 | & Directory_Separator; |
958a816e VC |
335 | end Get_Install_Dir; |
336 | ||
337 | -- Beginning of Executable_Prefix_Path | |
338 | ||
339 | begin | |
340 | -- First determine if a path prefix was placed in front of the | |
341 | -- executable name. | |
342 | ||
343 | for J in reverse Exec_Name'Range loop | |
344 | if Exec_Name (J) = Directory_Separator then | |
345 | return Get_Install_Dir (Exec_Name); | |
346 | end if; | |
347 | end loop; | |
348 | ||
349 | -- If we get here, the user has typed the executable name with no | |
350 | -- directory prefix. | |
351 | ||
67d7b0ab | 352 | declare |
659819b9 | 353 | Path : String_Access := Locate_Exec_On_Path (Exec_Name); |
67d7b0ab VC |
354 | begin |
355 | if Path = null then | |
356 | return ""; | |
67d7b0ab | 357 | else |
659819b9 AC |
358 | declare |
359 | Dir : constant String := Get_Install_Dir (Path.all); | |
360 | begin | |
361 | Free (Path); | |
362 | return Dir; | |
363 | end; | |
67d7b0ab VC |
364 | end if; |
365 | end; | |
958a816e VC |
366 | end Executable_Prefix_Path; |
367 | ||
f7e71125 AC |
368 | -------------------------- |
369 | -- File_Not_A_Source_Of -- | |
370 | -------------------------- | |
371 | ||
372 | function File_Not_A_Source_Of | |
373 | (Uname : Name_Id; | |
374 | Sfile : File_Name_Type) return Boolean | |
375 | is | |
376 | Unit : constant Unit_Index := | |
377 | Units_Htable.Get (Project_Tree.Units_HT, Uname); | |
378 | ||
379 | At_Least_One_File : Boolean := False; | |
380 | ||
381 | begin | |
382 | if Unit /= No_Unit_Index then | |
383 | for F in Unit.File_Names'Range loop | |
384 | if Unit.File_Names (F) /= null then | |
385 | At_Least_One_File := True; | |
386 | if Unit.File_Names (F).File = Sfile then | |
387 | return False; | |
388 | end if; | |
389 | end if; | |
390 | end loop; | |
391 | ||
392 | if not At_Least_One_File then | |
393 | ||
394 | -- The unit was probably created initially for a separate unit | |
395 | -- (which are initially created as IMPL when both suffixes are the | |
396 | -- same). Later on, Override_Kind changed the type of the file, | |
397 | -- and the unit is no longer valid in fact. | |
398 | ||
399 | return False; | |
400 | end if; | |
401 | ||
402 | Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile)); | |
403 | return True; | |
404 | end if; | |
405 | ||
406 | return False; | |
407 | end File_Not_A_Source_Of; | |
408 | ||
aa720a54 AC |
409 | ---------- |
410 | -- Hash -- | |
411 | ---------- | |
412 | ||
413 | function Hash (Key : Mark_Key) return Mark_Num is | |
414 | begin | |
415 | return Union_Id (Key.File) mod Max_Mask_Num; | |
416 | end Hash; | |
417 | ||
2cd44f5a VC |
418 | ------------ |
419 | -- Inform -- | |
420 | ------------ | |
421 | ||
422 | procedure Inform (N : File_Name_Type; Msg : String) is | |
423 | begin | |
424 | Inform (Name_Id (N), Msg); | |
425 | end Inform; | |
426 | ||
427 | procedure Inform (N : Name_Id := No_Name; Msg : String) is | |
428 | begin | |
429 | Osint.Write_Program_Name; | |
430 | ||
431 | Write_Str (": "); | |
432 | ||
433 | if N /= No_Name then | |
434 | Write_Str (""""); | |
7d903840 AC |
435 | |
436 | declare | |
437 | Name : constant String := Get_Name_String (N); | |
438 | begin | |
439 | if Debug.Debug_Flag_F and then Is_Absolute_Path (Name) then | |
440 | Write_Str (File_Name (Name)); | |
441 | else | |
442 | Write_Str (Name); | |
443 | end if; | |
444 | end; | |
445 | ||
2cd44f5a VC |
446 | Write_Str (""" "); |
447 | end if; | |
448 | ||
449 | Write_Str (Msg); | |
450 | Write_Eol; | |
451 | end Inform; | |
452 | ||
8f9df7d8 VC |
453 | ---------------------------- |
454 | -- Is_External_Assignment -- | |
455 | ---------------------------- | |
456 | ||
daa72421 AC |
457 | function Is_External_Assignment |
458 | (Tree : Prj.Tree.Project_Node_Tree_Ref; | |
459 | Argv : String) return Boolean | |
460 | is | |
8f9df7d8 VC |
461 | Start : Positive := 3; |
462 | Finish : Natural := Argv'Last; | |
8f9df7d8 | 463 | |
bfc8aa81 RD |
464 | pragma Assert (Argv'First = 1); |
465 | pragma Assert (Argv (1 .. 2) = "-X"); | |
466 | ||
8f9df7d8 VC |
467 | begin |
468 | if Argv'Last < 5 then | |
469 | return False; | |
470 | ||
471 | elsif Argv (3) = '"' then | |
472 | if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then | |
473 | return False; | |
474 | else | |
475 | Start := 4; | |
476 | Finish := Argv'Last - 1; | |
477 | end if; | |
478 | end if; | |
479 | ||
d9b4a5d3 EB |
480 | return Prj.Ext.Check |
481 | (Tree => Tree, | |
482 | Declaration => Argv (Start .. Finish)); | |
8f9df7d8 VC |
483 | end Is_External_Assignment; |
484 | ||
aa720a54 AC |
485 | --------------- |
486 | -- Is_Marked -- | |
487 | --------------- | |
488 | ||
489 | function Is_Marked | |
490 | (Source_File : File_Name_Type; | |
5950a3ac | 491 | Index : Int := 0) return Boolean |
aa720a54 AC |
492 | is |
493 | begin | |
494 | return Marks.Get (K => (File => Source_File, Index => Index)); | |
495 | end Is_Marked; | |
496 | ||
8f9df7d8 VC |
497 | ----------------------------- |
498 | -- Linker_Options_Switches -- | |
499 | ----------------------------- | |
500 | ||
501 | function Linker_Options_Switches | |
7e98a4c6 VC |
502 | (Project : Project_Id; |
503 | In_Tree : Project_Tree_Ref) return String_List | |
8f9df7d8 | 504 | is |
8b9890fa | 505 | procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean); |
5950a3ac | 506 | -- The recursive routine used to add linker options |
8f9df7d8 | 507 | |
8b9890fa EB |
508 | ------------------- |
509 | -- Recursive_Add -- | |
510 | ------------------- | |
8f9df7d8 | 511 | |
8b9890fa EB |
512 | procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean) is |
513 | pragma Unreferenced (Dummy); | |
74744c7b | 514 | |
8f9df7d8 | 515 | Linker_Package : Package_Id; |
5950a3ac | 516 | Options : Variable_Value; |
5950a3ac | 517 | |
8f9df7d8 | 518 | begin |
8b9890fa EB |
519 | Linker_Package := |
520 | Prj.Util.Value_Of | |
521 | (Name => Name_Linker, | |
66713d62 | 522 | In_Packages => Proj.Decl.Packages, |
8b9890fa | 523 | In_Tree => In_Tree); |
74744c7b | 524 | |
8b9890fa EB |
525 | Options := |
526 | Prj.Util.Value_Of | |
527 | (Name => Name_Ada, | |
528 | Index => 0, | |
529 | Attribute_Or_Array_Name => Name_Linker_Options, | |
530 | In_Package => Linker_Package, | |
531 | In_Tree => In_Tree); | |
532 | ||
533 | -- If attribute is present, add the project with | |
534 | -- the attribute to table Linker_Opts. | |
535 | ||
536 | if Options /= Nil_Variable_Value then | |
537 | Linker_Opts.Increment_Last; | |
538 | Linker_Opts.Table (Linker_Opts.Last) := | |
539 | (Project => Proj, Options => Options.Values); | |
8f9df7d8 | 540 | end if; |
8b9890fa EB |
541 | end Recursive_Add; |
542 | ||
543 | procedure For_All_Projects is | |
544 | new For_Every_Project_Imported (Boolean, Recursive_Add); | |
74744c7b | 545 | |
8b9890fa | 546 | Dummy : Boolean := False; |
8f9df7d8 | 547 | |
5950a3ac AC |
548 | -- Start of processing for Linker_Options_Switches |
549 | ||
8f9df7d8 VC |
550 | begin |
551 | Linker_Opts.Init; | |
552 | ||
66713d62 | 553 | For_All_Projects (Project, Dummy, Imported_First => True); |
8f9df7d8 VC |
554 | |
555 | Last_Linker_Option := 0; | |
556 | ||
557 | for Index in reverse 1 .. Linker_Opts.Last loop | |
558 | declare | |
66713d62 | 559 | Options : String_List_Id; |
8f9df7d8 | 560 | Proj : constant Project_Id := |
74744c7b | 561 | Linker_Opts.Table (Index).Project; |
8f9df7d8 | 562 | Option : Name_Id; |
2324b3fd | 563 | Dir_Path : constant String := |
66713d62 | 564 | Get_Name_String (Proj.Directory.Name); |
8f9df7d8 VC |
565 | |
566 | begin | |
66713d62 | 567 | Options := Linker_Opts.Table (Index).Options; |
8f9df7d8 | 568 | while Options /= Nil_String loop |
74744c7b | 569 | Option := In_Tree.String_Elements.Table (Options).Value; |
f2c573b1 VC |
570 | Get_Name_String (Option); |
571 | ||
572 | -- Do not consider empty linker options | |
573 | ||
574 | if Name_Len /= 0 then | |
575 | Add_Linker_Option (Name_Buffer (1 .. Name_Len)); | |
576 | ||
577 | -- Object files and -L switches specified with relative | |
578 | -- paths must be converted to absolute paths. | |
579 | ||
580 | Test_If_Relative_Path | |
74744c7b | 581 | (Switch => Linker_Options_Buffer (Last_Linker_Option), |
2324b3fd | 582 | Parent => Dir_Path, |
f2c573b1 VC |
583 | Including_L_Switch => True); |
584 | end if; | |
585 | ||
66713d62 | 586 | Options := In_Tree.String_Elements.Table (Options).Next; |
8f9df7d8 VC |
587 | end loop; |
588 | end; | |
589 | end loop; | |
590 | ||
591 | return Linker_Options_Buffer (1 .. Last_Linker_Option); | |
592 | end Linker_Options_Switches; | |
593 | ||
594 | ----------- | |
595 | -- Mains -- | |
596 | ----------- | |
597 | ||
598 | package body Mains is | |
599 | ||
1e887886 VC |
600 | type File_And_Loc is record |
601 | File_Name : File_Name_Type; | |
602 | Location : Source_Ptr := No_Location; | |
603 | end record; | |
604 | ||
8f9df7d8 | 605 | package Names is new Table.Table |
1e887886 | 606 | (Table_Component_Type => File_And_Loc, |
8f9df7d8 VC |
607 | Table_Index_Type => Integer, |
608 | Table_Low_Bound => 1, | |
609 | Table_Initial => 10, | |
610 | Table_Increment => 100, | |
611 | Table_Name => "Makeutl.Mains.Names"); | |
612 | -- The table that stores the mains | |
613 | ||
614 | Current : Natural := 0; | |
615 | -- The index of the last main retrieved from the table | |
616 | ||
617 | -------------- | |
618 | -- Add_Main -- | |
619 | -------------- | |
620 | ||
621 | procedure Add_Main (Name : String) is | |
622 | begin | |
623 | Name_Len := 0; | |
624 | Add_Str_To_Name_Buffer (Name); | |
625 | Names.Increment_Last; | |
1e887886 | 626 | Names.Table (Names.Last) := (Name_Find, No_Location); |
8f9df7d8 VC |
627 | end Add_Main; |
628 | ||
629 | ------------ | |
630 | -- Delete -- | |
631 | ------------ | |
632 | ||
633 | procedure Delete is | |
634 | begin | |
635 | Names.Set_Last (0); | |
7e98a4c6 | 636 | Mains.Reset; |
8f9df7d8 VC |
637 | end Delete; |
638 | ||
1e887886 VC |
639 | ------------------ |
640 | -- Get_Location -- | |
641 | ------------------ | |
642 | ||
643 | function Get_Location return Source_Ptr is | |
644 | begin | |
a573518c TQ |
645 | if Current in Names.First .. Names.Last then |
646 | return Names.Table (Current).Location; | |
1e887886 | 647 | else |
a573518c | 648 | return No_Location; |
1e887886 VC |
649 | end if; |
650 | end Get_Location; | |
651 | ||
8f9df7d8 VC |
652 | --------------- |
653 | -- Next_Main -- | |
654 | --------------- | |
655 | ||
656 | function Next_Main return String is | |
657 | begin | |
658 | if Current >= Names.Last then | |
659 | return ""; | |
8f9df7d8 VC |
660 | else |
661 | Current := Current + 1; | |
1e887886 | 662 | return Get_Name_String (Names.Table (Current).File_Name); |
8f9df7d8 VC |
663 | end if; |
664 | end Next_Main; | |
665 | ||
666 | --------------------- | |
667 | -- Number_Of_Mains -- | |
668 | --------------------- | |
669 | ||
670 | function Number_Of_Mains return Natural is | |
671 | begin | |
672 | return Names.Last; | |
673 | end Number_Of_Mains; | |
674 | ||
675 | ----------- | |
676 | -- Reset -- | |
677 | ----------- | |
678 | ||
679 | procedure Reset is | |
680 | begin | |
681 | Current := 0; | |
682 | end Reset; | |
683 | ||
1e887886 VC |
684 | ------------------ |
685 | -- Set_Location -- | |
686 | ------------------ | |
687 | ||
688 | procedure Set_Location (Location : Source_Ptr) is | |
689 | begin | |
690 | if Names.Last > 0 then | |
691 | Names.Table (Names.Last).Location := Location; | |
692 | end if; | |
693 | end Set_Location; | |
694 | ||
695 | ----------------- | |
696 | -- Update_Main -- | |
697 | ----------------- | |
698 | ||
699 | procedure Update_Main (Name : String) is | |
700 | begin | |
a573518c | 701 | if Current in Names.First .. Names.Last then |
1e887886 VC |
702 | Name_Len := 0; |
703 | Add_Str_To_Name_Buffer (Name); | |
704 | Names.Table (Current).File_Name := Name_Find; | |
705 | end if; | |
706 | end Update_Main; | |
8f9df7d8 VC |
707 | end Mains; |
708 | ||
aa720a54 AC |
709 | ---------- |
710 | -- Mark -- | |
711 | ---------- | |
712 | ||
713 | procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is | |
714 | begin | |
715 | Marks.Set (K => (File => Source_File, Index => Index), E => True); | |
716 | end Mark; | |
717 | ||
7d903840 AC |
718 | ----------------------- |
719 | -- Path_Or_File_Name -- | |
720 | ----------------------- | |
721 | ||
722 | function Path_Or_File_Name (Path : Path_Name_Type) return String is | |
723 | Path_Name : constant String := Get_Name_String (Path); | |
724 | begin | |
725 | if Debug.Debug_Flag_F then | |
726 | return File_Name (Path_Name); | |
727 | else | |
728 | return Path_Name; | |
729 | end if; | |
730 | end Path_Or_File_Name; | |
731 | ||
8f9df7d8 VC |
732 | --------------------------- |
733 | -- Test_If_Relative_Path -- | |
734 | --------------------------- | |
735 | ||
736 | procedure Test_If_Relative_Path | |
1086c39b | 737 | (Switch : in out String_Access; |
2324b3fd | 738 | Parent : String; |
1086c39b | 739 | Including_L_Switch : Boolean := True; |
35debead EB |
740 | Including_Non_Switch : Boolean := True; |
741 | Including_RTS : Boolean := False) | |
8f9df7d8 VC |
742 | is |
743 | begin | |
744 | if Switch /= null then | |
8f9df7d8 | 745 | declare |
74744c7b | 746 | Sw : String (1 .. Switch'Length); |
8f9df7d8 VC |
747 | Start : Positive; |
748 | ||
749 | begin | |
750 | Sw := Switch.all; | |
751 | ||
752 | if Sw (1) = '-' then | |
753 | if Sw'Length >= 3 | |
754 | and then (Sw (2) = 'A' | |
74744c7b AC |
755 | or else Sw (2) = 'I' |
756 | or else (Including_L_Switch and then Sw (2) = 'L')) | |
8f9df7d8 VC |
757 | then |
758 | Start := 3; | |
759 | ||
760 | if Sw = "-I-" then | |
761 | return; | |
762 | end if; | |
763 | ||
764 | elsif Sw'Length >= 4 | |
765 | and then (Sw (2 .. 3) = "aL" | |
74744c7b AC |
766 | or else Sw (2 .. 3) = "aO" |
767 | or else Sw (2 .. 3) = "aI") | |
8f9df7d8 VC |
768 | then |
769 | Start := 4; | |
770 | ||
35debead EB |
771 | elsif Including_RTS |
772 | and then Sw'Length >= 7 | |
773 | and then Sw (2 .. 6) = "-RTS=" | |
774 | then | |
775 | Start := 7; | |
776 | ||
8f9df7d8 VC |
777 | else |
778 | return; | |
779 | end if; | |
780 | ||
781 | -- Because relative path arguments to --RTS= may be relative | |
782 | -- to the search directory prefix, those relative path | |
35debead EB |
783 | -- arguments are converted only when they include directory |
784 | -- information. | |
8f9df7d8 VC |
785 | |
786 | if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then | |
2324b3fd | 787 | if Parent'Length = 0 then |
8f9df7d8 | 788 | Do_Fail |
3dd9959c AC |
789 | ("relative search path switches (""" |
790 | & Sw | |
791 | & """) are not allowed"); | |
8f9df7d8 | 792 | |
35debead EB |
793 | elsif Including_RTS then |
794 | for J in Start .. Sw'Last loop | |
795 | if Sw (J) = Directory_Separator then | |
796 | Switch := | |
797 | new String' | |
798 | (Sw (1 .. Start - 1) & | |
799 | Parent & | |
800 | Directory_Separator & | |
801 | Sw (Start .. Sw'Last)); | |
802 | return; | |
803 | end if; | |
804 | end loop; | |
805 | ||
8f9df7d8 VC |
806 | else |
807 | Switch := | |
808 | new String' | |
809 | (Sw (1 .. Start - 1) & | |
2324b3fd | 810 | Parent & |
8f9df7d8 VC |
811 | Directory_Separator & |
812 | Sw (Start .. Sw'Last)); | |
813 | end if; | |
814 | end if; | |
815 | ||
1086c39b | 816 | elsif Including_Non_Switch then |
8f9df7d8 | 817 | if not Is_Absolute_Path (Sw) then |
2324b3fd | 818 | if Parent'Length = 0 then |
8f9df7d8 | 819 | Do_Fail |
3dd9959c | 820 | ("relative paths (""" & Sw & """) are not allowed"); |
8f9df7d8 | 821 | else |
2324b3fd | 822 | Switch := new String'(Parent & Directory_Separator & Sw); |
8f9df7d8 VC |
823 | end if; |
824 | end if; | |
825 | end if; | |
826 | end; | |
827 | end if; | |
828 | end Test_If_Relative_Path; | |
829 | ||
aa720a54 AC |
830 | ------------------- |
831 | -- Unit_Index_Of -- | |
832 | ------------------- | |
833 | ||
834 | function Unit_Index_Of (ALI_File : File_Name_Type) return Int is | |
835 | Start : Natural; | |
836 | Finish : Natural; | |
837 | Result : Int := 0; | |
5950a3ac | 838 | |
aa720a54 AC |
839 | begin |
840 | Get_Name_String (ALI_File); | |
841 | ||
842 | -- First, find the last dot | |
843 | ||
844 | Finish := Name_Len; | |
845 | ||
846 | while Finish >= 1 and then Name_Buffer (Finish) /= '.' loop | |
847 | Finish := Finish - 1; | |
848 | end loop; | |
849 | ||
850 | if Finish = 1 then | |
851 | return 0; | |
852 | end if; | |
853 | ||
854 | -- Now check that the dot is preceded by digits | |
855 | ||
856 | Start := Finish; | |
857 | Finish := Finish - 1; | |
858 | ||
859 | while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop | |
860 | Start := Start - 1; | |
861 | end loop; | |
862 | ||
74744c7b AC |
863 | -- If there are no digits, or if the digits are not preceded by the |
864 | -- character that precedes a unit index, this is not the ALI file of | |
865 | -- a unit in a multi-unit source. | |
aa720a54 | 866 | |
5950a3ac AC |
867 | if Start > Finish |
868 | or else Start = 1 | |
869 | or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character | |
aa720a54 AC |
870 | then |
871 | return 0; | |
872 | end if; | |
873 | ||
874 | -- Build the index from the digit(s) | |
875 | ||
876 | while Start <= Finish loop | |
5950a3ac AC |
877 | Result := Result * 10 + |
878 | Character'Pos (Name_Buffer (Start)) - Character'Pos ('0'); | |
aa720a54 AC |
879 | Start := Start + 1; |
880 | end loop; | |
881 | ||
882 | return Result; | |
883 | end Unit_Index_Of; | |
884 | ||
f7e71125 AC |
885 | ----------------- |
886 | -- Verbose_Msg -- | |
887 | ----------------- | |
888 | ||
889 | procedure Verbose_Msg | |
890 | (N1 : Name_Id; | |
891 | S1 : String; | |
892 | N2 : Name_Id := No_Name; | |
893 | S2 : String := ""; | |
894 | Prefix : String := " -> "; | |
895 | Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low) | |
896 | is | |
897 | begin | |
898 | if not Opt.Verbose_Mode | |
899 | or else Minimum_Verbosity > Opt.Verbosity_Level | |
900 | then | |
901 | return; | |
902 | end if; | |
903 | ||
904 | Write_Str (Prefix); | |
905 | Write_Str (""""); | |
906 | Write_Name (N1); | |
907 | Write_Str (""" "); | |
908 | Write_Str (S1); | |
909 | ||
910 | if N2 /= No_Name then | |
911 | Write_Str (" """); | |
912 | Write_Name (N2); | |
913 | Write_Str (""" "); | |
914 | end if; | |
915 | ||
916 | Write_Str (S2); | |
917 | Write_Eol; | |
918 | end Verbose_Msg; | |
919 | ||
920 | procedure Verbose_Msg | |
921 | (N1 : File_Name_Type; | |
922 | S1 : String; | |
923 | N2 : File_Name_Type := No_File; | |
924 | S2 : String := ""; | |
925 | Prefix : String := " -> "; | |
926 | Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low) | |
927 | is | |
928 | begin | |
929 | Verbose_Msg | |
930 | (Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity); | |
931 | end Verbose_Msg; | |
932 | ||
8f9df7d8 | 933 | end Makeutl; |