]>
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 | -- -- | |
39f4e199 | 9 | -- Copyright (C) 2004-2007, 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- -- | |
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 -- | |
cb5fee25 KC |
19 | -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- |
20 | -- Boston, MA 02110-1301, USA. -- | |
8f9df7d8 VC |
21 | -- -- |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
24 | -- -- | |
25 | ------------------------------------------------------------------------------ | |
26 | ||
958a816e VC |
27 | with Ada.Command_Line; use Ada.Command_Line; |
28 | ||
5950a3ac | 29 | with Osint; use Osint; |
8f9df7d8 VC |
30 | with Prj.Ext; |
31 | with Prj.Util; | |
5950a3ac | 32 | with Snames; use Snames; |
8f9df7d8 | 33 | with Table; |
8f9df7d8 | 34 | |
958a816e | 35 | with System.Case_Util; use System.Case_Util; |
aa720a54 AC |
36 | with System.HTable; |
37 | ||
8f9df7d8 VC |
38 | package body Makeutl is |
39 | ||
aa720a54 AC |
40 | type Mark_Key is record |
41 | File : File_Name_Type; | |
42 | Index : Int; | |
43 | end record; | |
44 | -- Identify either a mono-unit source (when Index = 0) or a specific unit | |
45 | -- in a multi-unit source. | |
46 | ||
5950a3ac AC |
47 | -- There follow many global undocumented declarations, comments needed ??? |
48 | ||
aa720a54 AC |
49 | Max_Mask_Num : constant := 2048; |
50 | ||
51 | subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1; | |
52 | ||
53 | function Hash (Key : Mark_Key) return Mark_Num; | |
54 | ||
55 | package Marks is new System.HTable.Simple_HTable | |
56 | (Header_Num => Mark_Num, | |
57 | Element => Boolean, | |
58 | No_Element => False, | |
59 | Key => Mark_Key, | |
60 | Hash => Hash, | |
61 | Equal => "="); | |
9de61fcb | 62 | -- A hash table to keep tracks of the marked units |
aa720a54 | 63 | |
8f9df7d8 VC |
64 | type Linker_Options_Data is record |
65 | Project : Project_Id; | |
66 | Options : String_List_Id; | |
67 | end record; | |
68 | ||
69 | Linker_Option_Initial_Count : constant := 20; | |
70 | ||
71 | Linker_Options_Buffer : String_List_Access := | |
72 | new String_List (1 .. Linker_Option_Initial_Count); | |
73 | ||
74 | Last_Linker_Option : Natural := 0; | |
75 | ||
76 | package Linker_Opts is new Table.Table ( | |
77 | Table_Component_Type => Linker_Options_Data, | |
78 | Table_Index_Type => Integer, | |
79 | Table_Low_Bound => 1, | |
80 | Table_Initial => 10, | |
81 | Table_Increment => 100, | |
82 | Table_Name => "Make.Linker_Opts"); | |
83 | ||
84 | procedure Add_Linker_Option (Option : String); | |
85 | ||
86 | ----------------------- | |
87 | -- Add_Linker_Option -- | |
88 | ----------------------- | |
89 | ||
90 | procedure Add_Linker_Option (Option : String) is | |
91 | begin | |
92 | if Option'Length > 0 then | |
93 | if Last_Linker_Option = Linker_Options_Buffer'Last then | |
94 | declare | |
95 | New_Buffer : constant String_List_Access := | |
5950a3ac AC |
96 | new String_List |
97 | (1 .. Linker_Options_Buffer'Last + | |
98 | Linker_Option_Initial_Count); | |
8f9df7d8 VC |
99 | begin |
100 | New_Buffer (Linker_Options_Buffer'Range) := | |
101 | Linker_Options_Buffer.all; | |
102 | Linker_Options_Buffer.all := (others => null); | |
103 | Free (Linker_Options_Buffer); | |
104 | Linker_Options_Buffer := New_Buffer; | |
105 | end; | |
106 | end if; | |
107 | ||
108 | Last_Linker_Option := Last_Linker_Option + 1; | |
109 | Linker_Options_Buffer (Last_Linker_Option) := new String'(Option); | |
110 | end if; | |
111 | end Add_Linker_Option; | |
112 | ||
aa720a54 AC |
113 | ---------------------- |
114 | -- Delete_All_Marks -- | |
115 | ---------------------- | |
116 | ||
117 | procedure Delete_All_Marks is | |
118 | begin | |
119 | Marks.Reset; | |
120 | end Delete_All_Marks; | |
121 | ||
958a816e VC |
122 | ---------------------------- |
123 | -- Executable_Prefix_Path -- | |
124 | ---------------------------- | |
125 | ||
126 | function Executable_Prefix_Path return String is | |
127 | Exec_Name : constant String := Command_Name; | |
128 | ||
129 | function Get_Install_Dir (S : String) return String; | |
130 | -- S is the executable name preceeded by the absolute or relative | |
131 | -- path, e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory | |
132 | -- where "bin" lies (in the example "C:\usr"). | |
133 | -- If the executable is not in a "bin" directory, return "". | |
134 | ||
135 | --------------------- | |
136 | -- Get_Install_Dir -- | |
137 | --------------------- | |
138 | ||
139 | function Get_Install_Dir (S : String) return String is | |
140 | Exec : String := S; | |
141 | Path_Last : Integer := 0; | |
142 | ||
143 | begin | |
144 | for J in reverse Exec'Range loop | |
145 | if Exec (J) = Directory_Separator then | |
146 | Path_Last := J - 1; | |
147 | exit; | |
148 | end if; | |
149 | end loop; | |
150 | ||
151 | if Path_Last >= Exec'First + 2 then | |
152 | To_Lower (Exec (Path_Last - 2 .. Path_Last)); | |
153 | end if; | |
154 | ||
155 | if Path_Last < Exec'First + 2 | |
156 | or else Exec (Path_Last - 2 .. Path_Last) /= "bin" | |
157 | or else (Path_Last - 3 >= Exec'First | |
158 | and then Exec (Path_Last - 3) /= Directory_Separator) | |
159 | then | |
160 | return ""; | |
161 | end if; | |
162 | ||
163 | return Normalize_Pathname (Exec (Exec'First .. Path_Last - 4)); | |
164 | end Get_Install_Dir; | |
165 | ||
166 | -- Beginning of Executable_Prefix_Path | |
167 | ||
168 | begin | |
169 | -- First determine if a path prefix was placed in front of the | |
170 | -- executable name. | |
171 | ||
172 | for J in reverse Exec_Name'Range loop | |
173 | if Exec_Name (J) = Directory_Separator then | |
174 | return Get_Install_Dir (Exec_Name); | |
175 | end if; | |
176 | end loop; | |
177 | ||
178 | -- If we get here, the user has typed the executable name with no | |
179 | -- directory prefix. | |
180 | ||
181 | return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name).all); | |
182 | end Executable_Prefix_Path; | |
183 | ||
aa720a54 AC |
184 | ---------- |
185 | -- Hash -- | |
186 | ---------- | |
187 | ||
188 | function Hash (Key : Mark_Key) return Mark_Num is | |
189 | begin | |
190 | return Union_Id (Key.File) mod Max_Mask_Num; | |
191 | end Hash; | |
192 | ||
8f9df7d8 VC |
193 | ---------------------------- |
194 | -- Is_External_Assignment -- | |
195 | ---------------------------- | |
196 | ||
197 | function Is_External_Assignment (Argv : String) return Boolean is | |
198 | Start : Positive := 3; | |
199 | Finish : Natural := Argv'Last; | |
200 | Equal_Pos : Natural; | |
201 | ||
bfc8aa81 RD |
202 | pragma Assert (Argv'First = 1); |
203 | pragma Assert (Argv (1 .. 2) = "-X"); | |
204 | ||
8f9df7d8 VC |
205 | begin |
206 | if Argv'Last < 5 then | |
207 | return False; | |
208 | ||
209 | elsif Argv (3) = '"' then | |
210 | if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then | |
211 | return False; | |
212 | else | |
213 | Start := 4; | |
214 | Finish := Argv'Last - 1; | |
215 | end if; | |
216 | end if; | |
217 | ||
218 | Equal_Pos := Start; | |
219 | ||
220 | while Equal_Pos <= Finish and then Argv (Equal_Pos) /= '=' loop | |
221 | Equal_Pos := Equal_Pos + 1; | |
222 | end loop; | |
223 | ||
224 | if Equal_Pos = Start | |
39f4e199 | 225 | or else Equal_Pos > Finish |
8f9df7d8 VC |
226 | then |
227 | return False; | |
8f9df7d8 VC |
228 | else |
229 | Prj.Ext.Add | |
230 | (External_Name => Argv (Start .. Equal_Pos - 1), | |
231 | Value => Argv (Equal_Pos + 1 .. Finish)); | |
232 | return True; | |
233 | end if; | |
234 | end Is_External_Assignment; | |
235 | ||
aa720a54 AC |
236 | --------------- |
237 | -- Is_Marked -- | |
238 | --------------- | |
239 | ||
240 | function Is_Marked | |
241 | (Source_File : File_Name_Type; | |
5950a3ac | 242 | Index : Int := 0) return Boolean |
aa720a54 AC |
243 | is |
244 | begin | |
245 | return Marks.Get (K => (File => Source_File, Index => Index)); | |
246 | end Is_Marked; | |
247 | ||
8f9df7d8 VC |
248 | ----------------------------- |
249 | -- Linker_Options_Switches -- | |
250 | ----------------------------- | |
251 | ||
252 | function Linker_Options_Switches | |
7e98a4c6 VC |
253 | (Project : Project_Id; |
254 | In_Tree : Project_Tree_Ref) return String_List | |
8f9df7d8 | 255 | is |
5950a3ac AC |
256 | procedure Recursive_Add_Linker_Options (Proj : Project_Id); |
257 | -- The recursive routine used to add linker options | |
8f9df7d8 VC |
258 | |
259 | ---------------------------------- | |
260 | -- Recursive_Add_Linker_Options -- | |
261 | ---------------------------------- | |
262 | ||
8f9df7d8 | 263 | procedure Recursive_Add_Linker_Options (Proj : Project_Id) is |
5950a3ac | 264 | Data : Project_Data; |
8f9df7d8 | 265 | Linker_Package : Package_Id; |
5950a3ac AC |
266 | Options : Variable_Value; |
267 | Imported : Project_List; | |
268 | ||
8f9df7d8 VC |
269 | begin |
270 | if Proj /= No_Project then | |
7e98a4c6 | 271 | Data := In_Tree.Projects.Table (Proj); |
8f9df7d8 VC |
272 | |
273 | if not Data.Seen then | |
7e98a4c6 | 274 | In_Tree.Projects.Table (Proj).Seen := True; |
8f9df7d8 VC |
275 | Imported := Data.Imported_Projects; |
276 | ||
277 | while Imported /= Empty_Project_List loop | |
278 | Recursive_Add_Linker_Options | |
7e98a4c6 VC |
279 | (In_Tree.Project_Lists.Table |
280 | (Imported).Project); | |
281 | Imported := In_Tree.Project_Lists.Table | |
282 | (Imported).Next; | |
8f9df7d8 VC |
283 | end loop; |
284 | ||
285 | if Proj /= Project then | |
286 | Linker_Package := | |
287 | Prj.Util.Value_Of | |
7e98a4c6 VC |
288 | (Name => Name_Linker, |
289 | In_Packages => Data.Decl.Packages, | |
290 | In_Tree => In_Tree); | |
8f9df7d8 VC |
291 | Options := |
292 | Prj.Util.Value_Of | |
7e98a4c6 VC |
293 | (Name => Name_Ada, |
294 | Index => 0, | |
8f9df7d8 | 295 | Attribute_Or_Array_Name => Name_Linker_Options, |
7e98a4c6 VC |
296 | In_Package => Linker_Package, |
297 | In_Tree => In_Tree); | |
8f9df7d8 VC |
298 | |
299 | -- If attribute is present, add the project with | |
300 | -- the attribute to table Linker_Opts. | |
301 | ||
302 | if Options /= Nil_Variable_Value then | |
303 | Linker_Opts.Increment_Last; | |
304 | Linker_Opts.Table (Linker_Opts.Last) := | |
305 | (Project => Proj, Options => Options.Values); | |
306 | end if; | |
307 | end if; | |
308 | end if; | |
309 | end if; | |
310 | end Recursive_Add_Linker_Options; | |
311 | ||
5950a3ac AC |
312 | -- Start of processing for Linker_Options_Switches |
313 | ||
8f9df7d8 VC |
314 | begin |
315 | Linker_Opts.Init; | |
316 | ||
7e98a4c6 VC |
317 | for Index in Project_Table.First .. |
318 | Project_Table.Last (In_Tree.Projects) | |
319 | loop | |
320 | In_Tree.Projects.Table (Index).Seen := False; | |
8f9df7d8 VC |
321 | end loop; |
322 | ||
323 | Recursive_Add_Linker_Options (Project); | |
324 | ||
325 | Last_Linker_Option := 0; | |
326 | ||
327 | for Index in reverse 1 .. Linker_Opts.Last loop | |
328 | declare | |
329 | Options : String_List_Id := Linker_Opts.Table (Index).Options; | |
330 | Proj : constant Project_Id := | |
331 | Linker_Opts.Table (Index).Project; | |
332 | Option : Name_Id; | |
333 | ||
334 | begin | |
335 | -- If Dir_Path has not been computed for this project, do it now | |
336 | ||
7e98a4c6 VC |
337 | if In_Tree.Projects.Table (Proj).Dir_Path = null then |
338 | In_Tree.Projects.Table (Proj).Dir_Path := | |
8f9df7d8 | 339 | new String' |
7e98a4c6 VC |
340 | (Get_Name_String |
341 | (In_Tree.Projects.Table | |
342 | (Proj). Directory)); | |
8f9df7d8 VC |
343 | end if; |
344 | ||
345 | while Options /= Nil_String loop | |
7e98a4c6 VC |
346 | Option := |
347 | In_Tree.String_Elements.Table (Options).Value; | |
f2c573b1 VC |
348 | Get_Name_String (Option); |
349 | ||
350 | -- Do not consider empty linker options | |
351 | ||
352 | if Name_Len /= 0 then | |
353 | Add_Linker_Option (Name_Buffer (1 .. Name_Len)); | |
354 | ||
355 | -- Object files and -L switches specified with relative | |
356 | -- paths must be converted to absolute paths. | |
357 | ||
358 | Test_If_Relative_Path | |
359 | (Switch => | |
360 | Linker_Options_Buffer (Last_Linker_Option), | |
361 | Parent => | |
362 | In_Tree.Projects.Table (Proj).Dir_Path, | |
363 | Including_L_Switch => True); | |
364 | end if; | |
365 | ||
7e98a4c6 VC |
366 | Options := |
367 | In_Tree.String_Elements.Table (Options).Next; | |
8f9df7d8 VC |
368 | end loop; |
369 | end; | |
370 | end loop; | |
371 | ||
372 | return Linker_Options_Buffer (1 .. Last_Linker_Option); | |
373 | end Linker_Options_Switches; | |
374 | ||
375 | ----------- | |
376 | -- Mains -- | |
377 | ----------- | |
378 | ||
379 | package body Mains is | |
380 | ||
381 | package Names is new Table.Table | |
382 | (Table_Component_Type => File_Name_Type, | |
383 | Table_Index_Type => Integer, | |
384 | Table_Low_Bound => 1, | |
385 | Table_Initial => 10, | |
386 | Table_Increment => 100, | |
387 | Table_Name => "Makeutl.Mains.Names"); | |
388 | -- The table that stores the mains | |
389 | ||
390 | Current : Natural := 0; | |
391 | -- The index of the last main retrieved from the table | |
392 | ||
393 | -------------- | |
394 | -- Add_Main -- | |
395 | -------------- | |
396 | ||
397 | procedure Add_Main (Name : String) is | |
398 | begin | |
399 | Name_Len := 0; | |
400 | Add_Str_To_Name_Buffer (Name); | |
401 | Names.Increment_Last; | |
402 | Names.Table (Names.Last) := Name_Find; | |
403 | end Add_Main; | |
404 | ||
405 | ------------ | |
406 | -- Delete -- | |
407 | ------------ | |
408 | ||
409 | procedure Delete is | |
410 | begin | |
411 | Names.Set_Last (0); | |
7e98a4c6 | 412 | Mains.Reset; |
8f9df7d8 VC |
413 | end Delete; |
414 | ||
415 | --------------- | |
416 | -- Next_Main -- | |
417 | --------------- | |
418 | ||
419 | function Next_Main return String is | |
420 | begin | |
421 | if Current >= Names.Last then | |
422 | return ""; | |
423 | ||
424 | else | |
425 | Current := Current + 1; | |
426 | return Get_Name_String (Names.Table (Current)); | |
427 | end if; | |
428 | end Next_Main; | |
429 | ||
430 | --------------------- | |
431 | -- Number_Of_Mains -- | |
432 | --------------------- | |
433 | ||
434 | function Number_Of_Mains return Natural is | |
435 | begin | |
436 | return Names.Last; | |
437 | end Number_Of_Mains; | |
438 | ||
439 | ----------- | |
440 | -- Reset -- | |
441 | ----------- | |
442 | ||
443 | procedure Reset is | |
444 | begin | |
445 | Current := 0; | |
446 | end Reset; | |
447 | ||
448 | end Mains; | |
449 | ||
aa720a54 AC |
450 | ---------- |
451 | -- Mark -- | |
452 | ---------- | |
453 | ||
454 | procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is | |
455 | begin | |
456 | Marks.Set (K => (File => Source_File, Index => Index), E => True); | |
457 | end Mark; | |
458 | ||
8f9df7d8 VC |
459 | --------------------------- |
460 | -- Test_If_Relative_Path -- | |
461 | --------------------------- | |
462 | ||
463 | procedure Test_If_Relative_Path | |
464 | (Switch : in out String_Access; | |
465 | Parent : String_Access; | |
466 | Including_L_Switch : Boolean := True) | |
467 | is | |
468 | begin | |
469 | if Switch /= null then | |
8f9df7d8 VC |
470 | declare |
471 | Sw : String (1 .. Switch'Length); | |
472 | Start : Positive; | |
473 | ||
474 | begin | |
475 | Sw := Switch.all; | |
476 | ||
477 | if Sw (1) = '-' then | |
478 | if Sw'Length >= 3 | |
479 | and then (Sw (2) = 'A' | |
480 | or else Sw (2) = 'I' | |
481 | or else (Including_L_Switch and then Sw (2) = 'L')) | |
482 | then | |
483 | Start := 3; | |
484 | ||
485 | if Sw = "-I-" then | |
486 | return; | |
487 | end if; | |
488 | ||
489 | elsif Sw'Length >= 4 | |
490 | and then (Sw (2 .. 3) = "aL" | |
491 | or else Sw (2 .. 3) = "aO" | |
492 | or else Sw (2 .. 3) = "aI") | |
493 | then | |
494 | Start := 4; | |
495 | ||
496 | else | |
497 | return; | |
498 | end if; | |
499 | ||
500 | -- Because relative path arguments to --RTS= may be relative | |
501 | -- to the search directory prefix, those relative path | |
502 | -- arguments are not converted. | |
503 | ||
504 | if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then | |
505 | if Parent = null or else Parent'Length = 0 then | |
506 | Do_Fail | |
507 | ("relative search path switches (""", | |
508 | Sw, | |
509 | """) are not allowed"); | |
510 | ||
511 | else | |
512 | Switch := | |
513 | new String' | |
514 | (Sw (1 .. Start - 1) & | |
515 | Parent.all & | |
516 | Directory_Separator & | |
517 | Sw (Start .. Sw'Last)); | |
518 | end if; | |
519 | end if; | |
520 | ||
521 | else | |
522 | if not Is_Absolute_Path (Sw) then | |
523 | if Parent = null or else Parent'Length = 0 then | |
524 | Do_Fail | |
525 | ("relative paths (""", Sw, """) are not allowed"); | |
526 | ||
527 | else | |
528 | Switch := | |
529 | new String'(Parent.all & Directory_Separator & Sw); | |
530 | end if; | |
531 | end if; | |
532 | end if; | |
533 | end; | |
534 | end if; | |
535 | end Test_If_Relative_Path; | |
536 | ||
aa720a54 AC |
537 | ------------------- |
538 | -- Unit_Index_Of -- | |
539 | ------------------- | |
540 | ||
541 | function Unit_Index_Of (ALI_File : File_Name_Type) return Int is | |
542 | Start : Natural; | |
543 | Finish : Natural; | |
544 | Result : Int := 0; | |
5950a3ac | 545 | |
aa720a54 AC |
546 | begin |
547 | Get_Name_String (ALI_File); | |
548 | ||
549 | -- First, find the last dot | |
550 | ||
551 | Finish := Name_Len; | |
552 | ||
553 | while Finish >= 1 and then Name_Buffer (Finish) /= '.' loop | |
554 | Finish := Finish - 1; | |
555 | end loop; | |
556 | ||
557 | if Finish = 1 then | |
558 | return 0; | |
559 | end if; | |
560 | ||
561 | -- Now check that the dot is preceded by digits | |
562 | ||
563 | Start := Finish; | |
564 | Finish := Finish - 1; | |
565 | ||
566 | while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop | |
567 | Start := Start - 1; | |
568 | end loop; | |
569 | ||
570 | -- If there is no difits, or if the digits are not preceded by | |
571 | -- the character that precedes a unit index, this is not the ALI file | |
572 | -- of a unit in a multi-unit source. | |
573 | ||
5950a3ac AC |
574 | if Start > Finish |
575 | or else Start = 1 | |
576 | or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character | |
aa720a54 AC |
577 | then |
578 | return 0; | |
579 | end if; | |
580 | ||
581 | -- Build the index from the digit(s) | |
582 | ||
583 | while Start <= Finish loop | |
5950a3ac AC |
584 | Result := Result * 10 + |
585 | Character'Pos (Name_Buffer (Start)) - Character'Pos ('0'); | |
aa720a54 AC |
586 | Start := Start + 1; |
587 | end loop; | |
588 | ||
589 | return Result; | |
590 | end Unit_Index_Of; | |
591 | ||
8f9df7d8 | 592 | end Makeutl; |