]>
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 | -- -- | |
c0e538ad | 9 | -- Copyright (C) 2004-2011, 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; |
88b17d45 | 29 | with Hostparm; |
5950a3ac | 30 | with Osint; use Osint; |
2cd44f5a | 31 | with Output; use Output; |
f7e71125 | 32 | with Opt; use Opt; |
8f9df7d8 VC |
33 | with Prj.Ext; |
34 | with Prj.Util; | |
5950a3ac | 35 | with Snames; use Snames; |
8f9df7d8 | 36 | with Table; |
a113c55d | 37 | with Tempdir; |
8f9df7d8 | 38 | |
e917aec2 RD |
39 | with Ada.Command_Line; use Ada.Command_Line; |
40 | ||
41 | with GNAT.Case_Util; use GNAT.Case_Util; | |
42 | with GNAT.Directory_Operations; use GNAT.Directory_Operations; | |
43 | with GNAT.HTable; | |
44 | ||
8f9df7d8 VC |
45 | package body Makeutl is |
46 | ||
aa720a54 AC |
47 | type Mark_Key is record |
48 | File : File_Name_Type; | |
49 | Index : Int; | |
50 | end record; | |
51 | -- Identify either a mono-unit source (when Index = 0) or a specific unit | |
7d903840 | 52 | -- (index = 1's origin index of unit) in a multi-unit source. |
aa720a54 | 53 | |
5950a3ac AC |
54 | -- There follow many global undocumented declarations, comments needed ??? |
55 | ||
aa720a54 AC |
56 | Max_Mask_Num : constant := 2048; |
57 | ||
58 | subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1; | |
59 | ||
60 | function Hash (Key : Mark_Key) return Mark_Num; | |
61 | ||
55c1c66d | 62 | package Marks is new GNAT.HTable.Simple_HTable |
aa720a54 AC |
63 | (Header_Num => Mark_Num, |
64 | Element => Boolean, | |
65 | No_Element => False, | |
66 | Key => Mark_Key, | |
67 | Hash => Hash, | |
68 | Equal => "="); | |
9de61fcb | 69 | -- A hash table to keep tracks of the marked units |
aa720a54 | 70 | |
8f9df7d8 VC |
71 | type Linker_Options_Data is record |
72 | Project : Project_Id; | |
73 | Options : String_List_Id; | |
74 | end record; | |
75 | ||
76 | Linker_Option_Initial_Count : constant := 20; | |
77 | ||
78 | Linker_Options_Buffer : String_List_Access := | |
79 | new String_List (1 .. Linker_Option_Initial_Count); | |
80 | ||
81 | Last_Linker_Option : Natural := 0; | |
82 | ||
83 | package Linker_Opts is new Table.Table ( | |
84 | Table_Component_Type => Linker_Options_Data, | |
85 | Table_Index_Type => Integer, | |
86 | Table_Low_Bound => 1, | |
87 | Table_Initial => 10, | |
88 | Table_Increment => 100, | |
89 | Table_Name => "Make.Linker_Opts"); | |
90 | ||
91 | procedure Add_Linker_Option (Option : String); | |
92 | ||
2cd44f5a VC |
93 | --------- |
94 | -- Add -- | |
95 | --------- | |
96 | ||
97 | procedure Add | |
98 | (Option : String_Access; | |
99 | To : in out String_List_Access; | |
100 | Last : in out Natural) | |
101 | is | |
102 | begin | |
103 | if Last = To'Last then | |
104 | declare | |
105 | New_Options : constant String_List_Access := | |
106 | new String_List (1 .. To'Last * 2); | |
74744c7b | 107 | |
2cd44f5a VC |
108 | begin |
109 | New_Options (To'Range) := To.all; | |
110 | ||
111 | -- Set all elements of the original options to null to avoid | |
112 | -- deallocation of copies. | |
113 | ||
114 | To.all := (others => null); | |
115 | ||
116 | Free (To); | |
117 | To := New_Options; | |
118 | end; | |
119 | end if; | |
120 | ||
121 | Last := Last + 1; | |
122 | To (Last) := Option; | |
123 | end Add; | |
124 | ||
125 | procedure Add | |
126 | (Option : String; | |
127 | To : in out String_List_Access; | |
128 | Last : in out Natural) | |
129 | is | |
130 | begin | |
131 | Add (Option => new String'(Option), To => To, Last => Last); | |
132 | end Add; | |
133 | ||
8f9df7d8 VC |
134 | ----------------------- |
135 | -- Add_Linker_Option -- | |
136 | ----------------------- | |
137 | ||
138 | procedure Add_Linker_Option (Option : String) is | |
139 | begin | |
140 | if Option'Length > 0 then | |
141 | if Last_Linker_Option = Linker_Options_Buffer'Last then | |
142 | declare | |
143 | New_Buffer : constant String_List_Access := | |
5950a3ac AC |
144 | new String_List |
145 | (1 .. Linker_Options_Buffer'Last + | |
146 | Linker_Option_Initial_Count); | |
8f9df7d8 VC |
147 | begin |
148 | New_Buffer (Linker_Options_Buffer'Range) := | |
149 | Linker_Options_Buffer.all; | |
150 | Linker_Options_Buffer.all := (others => null); | |
151 | Free (Linker_Options_Buffer); | |
152 | Linker_Options_Buffer := New_Buffer; | |
153 | end; | |
154 | end if; | |
155 | ||
156 | Last_Linker_Option := Last_Linker_Option + 1; | |
157 | Linker_Options_Buffer (Last_Linker_Option) := new String'(Option); | |
158 | end if; | |
159 | end Add_Linker_Option; | |
160 | ||
c9df623a AC |
161 | ------------------------- |
162 | -- Base_Name_Index_For -- | |
163 | ------------------------- | |
164 | ||
165 | function Base_Name_Index_For | |
166 | (Main : String; | |
167 | Main_Index : Int; | |
168 | Index_Separator : Character) return File_Name_Type | |
169 | is | |
170 | Result : File_Name_Type; | |
c8c41617 | 171 | |
c9df623a AC |
172 | begin |
173 | Name_Len := 0; | |
174 | Add_Str_To_Name_Buffer (Base_Name (Main)); | |
175 | ||
c8c41617 RD |
176 | -- Remove the extension, if any, that is the last part of the base name |
177 | -- starting with a dot and following some characters. | |
c9df623a AC |
178 | |
179 | for J in reverse 2 .. Name_Len loop | |
180 | if Name_Buffer (J) = '.' then | |
181 | Name_Len := J - 1; | |
182 | exit; | |
183 | end if; | |
184 | end loop; | |
185 | ||
186 | -- Add the index info, if index is different from 0 | |
187 | ||
188 | if Main_Index > 0 then | |
189 | Add_Char_To_Name_Buffer (Index_Separator); | |
190 | ||
191 | declare | |
192 | Img : constant String := Main_Index'Img; | |
193 | begin | |
194 | Add_Str_To_Name_Buffer (Img (2 .. Img'Last)); | |
195 | end; | |
196 | end if; | |
c8c41617 | 197 | |
c9df623a AC |
198 | Result := Name_Find; |
199 | return Result; | |
200 | end Base_Name_Index_For; | |
201 | ||
38990220 EB |
202 | ------------------------------ |
203 | -- Check_Source_Info_In_ALI -- | |
204 | ------------------------------ | |
205 | ||
72e9f2b9 AC |
206 | function Check_Source_Info_In_ALI |
207 | (The_ALI : ALI_Id; | |
208 | Tree : Project_Tree_Ref) return Boolean | |
209 | is | |
38990220 | 210 | Unit_Name : Name_Id; |
8d12c865 | 211 | |
38990220 | 212 | begin |
8d12c865 RD |
213 | -- Loop through units |
214 | ||
215 | for U in ALIs.Table (The_ALI).First_Unit .. | |
216 | ALIs.Table (The_ALI).Last_Unit | |
38990220 | 217 | loop |
8d12c865 | 218 | -- Check if the file name is one of the source of the unit |
38990220 EB |
219 | |
220 | Get_Name_String (Units.Table (U).Uname); | |
221 | Name_Len := Name_Len - 2; | |
222 | Unit_Name := Name_Find; | |
223 | ||
224 | if File_Not_A_Source_Of (Unit_Name, Units.Table (U).Sfile) then | |
225 | return False; | |
226 | end if; | |
227 | ||
8d12c865 | 228 | -- Loop to do same check for each of the withed units |
38990220 | 229 | |
38990220 EB |
230 | for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop |
231 | declare | |
232 | WR : ALI.With_Record renames Withs.Table (W); | |
8d12c865 | 233 | |
38990220 EB |
234 | begin |
235 | if WR.Sfile /= No_File then | |
236 | Get_Name_String (WR.Uname); | |
237 | Name_Len := Name_Len - 2; | |
238 | Unit_Name := Name_Find; | |
239 | ||
240 | if File_Not_A_Source_Of (Unit_Name, WR.Sfile) then | |
241 | return False; | |
242 | end if; | |
243 | end if; | |
244 | end; | |
8d12c865 RD |
245 | end loop; |
246 | end loop; | |
38990220 | 247 | |
72e9f2b9 | 248 | -- Loop to check subunits and replaced sources |
38990220 | 249 | |
8d12c865 RD |
250 | for D in ALIs.Table (The_ALI).First_Sdep .. |
251 | ALIs.Table (The_ALI).Last_Sdep | |
38990220 EB |
252 | loop |
253 | declare | |
254 | SD : Sdep_Record renames Sdep.Table (D); | |
8d12c865 | 255 | |
38990220 EB |
256 | begin |
257 | Unit_Name := SD.Subunit_Name; | |
258 | ||
72e9f2b9 AC |
259 | if Unit_Name = No_Name then |
260 | -- Check if this source file has been replaced by a source with | |
261 | -- a different file name. | |
262 | ||
263 | if Tree /= null and then Tree.Replaced_Source_Number > 0 then | |
264 | declare | |
265 | Replacement : constant File_Name_Type := | |
266 | Replaced_Source_HTable.Get | |
267 | (Tree.Replaced_Sources, SD.Sfile); | |
268 | ||
269 | begin | |
270 | if Replacement /= No_File then | |
271 | if Verbose_Mode then | |
272 | Write_Line | |
273 | ("source file" & | |
274 | Get_Name_String (SD.Sfile) & | |
275 | " has been replaced by " & | |
276 | Get_Name_String (Replacement)); | |
277 | end if; | |
278 | ||
279 | return False; | |
280 | end if; | |
281 | end; | |
282 | end if; | |
8d12c865 | 283 | |
72e9f2b9 | 284 | else |
38990220 | 285 | -- For separates, the file is no longer associated with the |
fdfcc663 AC |
286 | -- unit ("proc-sep.adb" is not associated with unit "proc.sep") |
287 | -- so we need to check whether the source file still exists in | |
38990220 EB |
288 | -- the source tree: it will if it matches the naming scheme |
289 | -- (and then will be for the same unit). | |
290 | ||
291 | if Find_Source | |
76b84bf0 AC |
292 | (In_Tree => Project_Tree, |
293 | Project => No_Project, | |
294 | Base_Name => SD.Sfile) = No_Source | |
38990220 | 295 | then |
fdfcc663 AC |
296 | -- If this is not a runtime file or if, when gnatmake switch |
297 | -- -a is used, we are not able to find this subunit in the | |
298 | -- source directories, then recompilation is needed. | |
299 | ||
300 | if not Fname.Is_Internal_File_Name (SD.Sfile) | |
301 | or else | |
76b84bf0 | 302 | (Check_Readonly_Files |
c5fdd4ad | 303 | and then Full_Source_Name (SD.Sfile) = No_File) |
38990220 EB |
304 | then |
305 | if Verbose_Mode then | |
306 | Write_Line | |
fdfcc663 | 307 | ("While parsing ALI file, file " |
38990220 | 308 | & Get_Name_String (SD.Sfile) |
fdfcc663 AC |
309 | & " is indicated as containing subunit " |
310 | & Get_Name_String (Unit_Name) | |
38990220 EB |
311 | & " but this does not match what was found while" |
312 | & " parsing the project. Will recompile"); | |
313 | end if; | |
76b84bf0 | 314 | |
38990220 EB |
315 | return False; |
316 | end if; | |
317 | end if; | |
318 | end if; | |
319 | end; | |
8d12c865 | 320 | end loop; |
38990220 EB |
321 | |
322 | return True; | |
323 | end Check_Source_Info_In_ALI; | |
324 | ||
a113c55d AC |
325 | -------------------------------- |
326 | -- Create_Binder_Mapping_File -- | |
327 | -------------------------------- | |
328 | ||
329 | function Create_Binder_Mapping_File return Path_Name_Type is | |
330 | Mapping_Path : Path_Name_Type := No_Path; | |
331 | ||
332 | Mapping_FD : File_Descriptor := Invalid_FD; | |
333 | -- A File Descriptor for an eventual mapping file | |
334 | ||
335 | ALI_Unit : Unit_Name_Type := No_Unit_Name; | |
336 | -- The unit name of an ALI file | |
337 | ||
338 | ALI_Name : File_Name_Type := No_File; | |
339 | -- The file name of the ALI file | |
340 | ||
341 | ALI_Project : Project_Id := No_Project; | |
342 | -- The project of the ALI file | |
343 | ||
344 | Bytes : Integer; | |
345 | OK : Boolean := False; | |
346 | Unit : Unit_Index; | |
347 | ||
348 | Status : Boolean; | |
349 | -- For call to Close | |
350 | ||
351 | begin | |
352 | Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path); | |
353 | Record_Temp_File (Project_Tree, Mapping_Path); | |
354 | ||
355 | if Mapping_FD /= Invalid_FD then | |
356 | OK := True; | |
357 | ||
358 | -- Traverse all units | |
359 | ||
360 | Unit := Units_Htable.Get_First (Project_Tree.Units_HT); | |
361 | while Unit /= No_Unit_Index loop | |
362 | if Unit.Name /= No_Name then | |
363 | ||
364 | -- If there is a body, put it in the mapping | |
365 | ||
366 | if Unit.File_Names (Impl) /= No_Source | |
367 | and then Unit.File_Names (Impl).Project /= No_Project | |
368 | then | |
369 | Get_Name_String (Unit.Name); | |
370 | Add_Str_To_Name_Buffer ("%b"); | |
371 | ALI_Unit := Name_Find; | |
372 | ALI_Name := | |
373 | Lib_File_Name (Unit.File_Names (Impl).Display_File); | |
374 | ALI_Project := Unit.File_Names (Impl).Project; | |
375 | ||
376 | -- Otherwise, if there is a spec, put it in the mapping | |
377 | ||
378 | elsif Unit.File_Names (Spec) /= No_Source | |
379 | and then Unit.File_Names (Spec).Project /= No_Project | |
380 | then | |
381 | Get_Name_String (Unit.Name); | |
382 | Add_Str_To_Name_Buffer ("%s"); | |
383 | ALI_Unit := Name_Find; | |
384 | ALI_Name := | |
385 | Lib_File_Name (Unit.File_Names (Spec).Display_File); | |
386 | ALI_Project := Unit.File_Names (Spec).Project; | |
387 | ||
388 | else | |
389 | ALI_Name := No_File; | |
390 | end if; | |
391 | ||
392 | -- If we have something to put in the mapping then do it now. | |
393 | -- However, if the project is extended, we don't put anything | |
394 | -- in the mapping file, since we don't know where the ALI file | |
395 | -- is: it might be in the extended project object directory as | |
396 | -- well as in the extending project object directory. | |
397 | ||
398 | if ALI_Name /= No_File | |
399 | and then ALI_Project.Extended_By = No_Project | |
400 | and then ALI_Project.Extends = No_Project | |
401 | then | |
402 | -- First check if the ALI file exists. If it does not, do | |
403 | -- not put the unit in the mapping file. | |
404 | ||
405 | declare | |
406 | ALI : constant String := Get_Name_String (ALI_Name); | |
407 | ||
408 | begin | |
409 | -- For library projects, use the library ALI directory, | |
410 | -- for other projects, use the object directory. | |
411 | ||
412 | if ALI_Project.Library then | |
413 | Get_Name_String | |
414 | (ALI_Project.Library_ALI_Dir.Display_Name); | |
415 | else | |
416 | Get_Name_String | |
417 | (ALI_Project.Object_Directory.Display_Name); | |
418 | end if; | |
419 | ||
a113c55d AC |
420 | Add_Str_To_Name_Buffer (ALI); |
421 | Add_Char_To_Name_Buffer (ASCII.LF); | |
422 | ||
423 | declare | |
424 | ALI_Path_Name : constant String := | |
23685ae6 | 425 | Name_Buffer (1 .. Name_Len); |
a113c55d AC |
426 | |
427 | begin | |
428 | if Is_Regular_File | |
429 | (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1)) | |
430 | then | |
431 | -- First line is the unit name | |
432 | ||
433 | Get_Name_String (ALI_Unit); | |
434 | Add_Char_To_Name_Buffer (ASCII.LF); | |
435 | Bytes := | |
436 | Write | |
437 | (Mapping_FD, | |
438 | Name_Buffer (1)'Address, | |
439 | Name_Len); | |
440 | OK := Bytes = Name_Len; | |
441 | ||
442 | exit when not OK; | |
443 | ||
444 | -- Second line it the ALI file name | |
445 | ||
446 | Get_Name_String (ALI_Name); | |
447 | Add_Char_To_Name_Buffer (ASCII.LF); | |
448 | Bytes := | |
449 | Write | |
450 | (Mapping_FD, | |
451 | Name_Buffer (1)'Address, | |
452 | Name_Len); | |
453 | OK := (Bytes = Name_Len); | |
454 | ||
455 | exit when not OK; | |
456 | ||
457 | -- Third line it the ALI path name | |
458 | ||
459 | Bytes := | |
460 | Write | |
461 | (Mapping_FD, | |
462 | ALI_Path_Name (1)'Address, | |
463 | ALI_Path_Name'Length); | |
464 | OK := (Bytes = ALI_Path_Name'Length); | |
465 | ||
466 | -- If OK is False, it means we were unable to | |
467 | -- write a line. No point in continuing with the | |
468 | -- other units. | |
469 | ||
470 | exit when not OK; | |
471 | end if; | |
472 | end; | |
473 | end; | |
474 | end if; | |
475 | end if; | |
476 | ||
477 | Unit := Units_Htable.Get_Next (Project_Tree.Units_HT); | |
478 | end loop; | |
479 | ||
480 | Close (Mapping_FD, Status); | |
481 | ||
482 | OK := OK and Status; | |
483 | end if; | |
484 | ||
485 | -- If the creation of the mapping file was successful, we add the switch | |
486 | -- to the arguments of gnatbind. | |
487 | ||
488 | if OK then | |
489 | return Mapping_Path; | |
490 | ||
491 | else | |
492 | return No_Path; | |
493 | end if; | |
494 | end Create_Binder_Mapping_File; | |
495 | ||
2cd44f5a VC |
496 | ----------------- |
497 | -- Create_Name -- | |
498 | ----------------- | |
499 | ||
500 | function Create_Name (Name : String) return File_Name_Type is | |
501 | begin | |
502 | Name_Len := 0; | |
503 | Add_Str_To_Name_Buffer (Name); | |
504 | return Name_Find; | |
505 | end Create_Name; | |
506 | ||
507 | function Create_Name (Name : String) return Name_Id is | |
508 | begin | |
509 | Name_Len := 0; | |
510 | Add_Str_To_Name_Buffer (Name); | |
511 | return Name_Find; | |
512 | end Create_Name; | |
513 | ||
514 | function Create_Name (Name : String) return Path_Name_Type is | |
515 | begin | |
516 | Name_Len := 0; | |
517 | Add_Str_To_Name_Buffer (Name); | |
518 | return Name_Find; | |
519 | end Create_Name; | |
520 | ||
aa720a54 AC |
521 | ---------------------- |
522 | -- Delete_All_Marks -- | |
523 | ---------------------- | |
524 | ||
525 | procedure Delete_All_Marks is | |
526 | begin | |
527 | Marks.Reset; | |
528 | end Delete_All_Marks; | |
529 | ||
958a816e VC |
530 | ---------------------------- |
531 | -- Executable_Prefix_Path -- | |
532 | ---------------------------- | |
533 | ||
534 | function Executable_Prefix_Path return String is | |
535 | Exec_Name : constant String := Command_Name; | |
536 | ||
537 | function Get_Install_Dir (S : String) return String; | |
74744c7b AC |
538 | -- S is the executable name preceded by the absolute or relative path, |
539 | -- e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory where "bin" | |
540 | -- lies (in the example "C:\usr"). If the executable is not in a "bin" | |
541 | -- directory, return "". | |
958a816e VC |
542 | |
543 | --------------------- | |
544 | -- Get_Install_Dir -- | |
545 | --------------------- | |
546 | ||
547 | function Get_Install_Dir (S : String) return String is | |
548 | Exec : String := S; | |
549 | Path_Last : Integer := 0; | |
550 | ||
551 | begin | |
552 | for J in reverse Exec'Range loop | |
553 | if Exec (J) = Directory_Separator then | |
554 | Path_Last := J - 1; | |
555 | exit; | |
556 | end if; | |
557 | end loop; | |
558 | ||
559 | if Path_Last >= Exec'First + 2 then | |
560 | To_Lower (Exec (Path_Last - 2 .. Path_Last)); | |
561 | end if; | |
562 | ||
563 | if Path_Last < Exec'First + 2 | |
564 | or else Exec (Path_Last - 2 .. Path_Last) /= "bin" | |
565 | or else (Path_Last - 3 >= Exec'First | |
566 | and then Exec (Path_Last - 3) /= Directory_Separator) | |
567 | then | |
568 | return ""; | |
569 | end if; | |
570 | ||
5fd3fd79 | 571 | return Normalize_Pathname |
d56e7acd AC |
572 | (Exec (Exec'First .. Path_Last - 4), |
573 | Resolve_Links => Opt.Follow_Links_For_Dirs) | |
659819b9 | 574 | & Directory_Separator; |
958a816e VC |
575 | end Get_Install_Dir; |
576 | ||
577 | -- Beginning of Executable_Prefix_Path | |
578 | ||
579 | begin | |
88b17d45 AC |
580 | -- For VMS, the path returned is always /gnu/ |
581 | ||
582 | if Hostparm.OpenVMS then | |
583 | return "/gnu/"; | |
584 | end if; | |
585 | ||
958a816e VC |
586 | -- First determine if a path prefix was placed in front of the |
587 | -- executable name. | |
588 | ||
589 | for J in reverse Exec_Name'Range loop | |
590 | if Exec_Name (J) = Directory_Separator then | |
591 | return Get_Install_Dir (Exec_Name); | |
592 | end if; | |
593 | end loop; | |
594 | ||
595 | -- If we get here, the user has typed the executable name with no | |
596 | -- directory prefix. | |
597 | ||
67d7b0ab | 598 | declare |
659819b9 | 599 | Path : String_Access := Locate_Exec_On_Path (Exec_Name); |
67d7b0ab VC |
600 | begin |
601 | if Path = null then | |
602 | return ""; | |
67d7b0ab | 603 | else |
659819b9 AC |
604 | declare |
605 | Dir : constant String := Get_Install_Dir (Path.all); | |
606 | begin | |
607 | Free (Path); | |
608 | return Dir; | |
609 | end; | |
67d7b0ab VC |
610 | end if; |
611 | end; | |
958a816e VC |
612 | end Executable_Prefix_Path; |
613 | ||
f7e71125 AC |
614 | -------------------------- |
615 | -- File_Not_A_Source_Of -- | |
616 | -------------------------- | |
617 | ||
618 | function File_Not_A_Source_Of | |
619 | (Uname : Name_Id; | |
620 | Sfile : File_Name_Type) return Boolean | |
621 | is | |
622 | Unit : constant Unit_Index := | |
623 | Units_Htable.Get (Project_Tree.Units_HT, Uname); | |
624 | ||
625 | At_Least_One_File : Boolean := False; | |
626 | ||
627 | begin | |
628 | if Unit /= No_Unit_Index then | |
629 | for F in Unit.File_Names'Range loop | |
630 | if Unit.File_Names (F) /= null then | |
631 | At_Least_One_File := True; | |
632 | if Unit.File_Names (F).File = Sfile then | |
633 | return False; | |
634 | end if; | |
635 | end if; | |
636 | end loop; | |
637 | ||
638 | if not At_Least_One_File then | |
639 | ||
640 | -- The unit was probably created initially for a separate unit | |
641 | -- (which are initially created as IMPL when both suffixes are the | |
642 | -- same). Later on, Override_Kind changed the type of the file, | |
643 | -- and the unit is no longer valid in fact. | |
644 | ||
645 | return False; | |
646 | end if; | |
647 | ||
648 | Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile)); | |
649 | return True; | |
650 | end if; | |
651 | ||
652 | return False; | |
653 | end File_Not_A_Source_Of; | |
654 | ||
34798441 EB |
655 | ------------------ |
656 | -- Get_Switches -- | |
657 | ------------------ | |
658 | ||
659 | procedure Get_Switches | |
660 | (Source : Prj.Source_Id; | |
661 | Pkg_Name : Name_Id; | |
662 | Project_Tree : Project_Tree_Ref; | |
663 | Value : out Variable_Value; | |
664 | Is_Default : out Boolean) | |
665 | is | |
666 | begin | |
667 | Get_Switches | |
668 | (Source_File => Source.File, | |
669 | Source_Lang => Source.Language.Name, | |
670 | Source_Prj => Source.Project, | |
671 | Pkg_Name => Pkg_Name, | |
672 | Project_Tree => Project_Tree, | |
673 | Value => Value, | |
674 | Is_Default => Is_Default); | |
675 | end Get_Switches; | |
676 | ||
677 | ------------------ | |
678 | -- Get_Switches -- | |
679 | ------------------ | |
680 | ||
681 | procedure Get_Switches | |
682 | (Source_File : File_Name_Type; | |
683 | Source_Lang : Name_Id; | |
684 | Source_Prj : Project_Id; | |
685 | Pkg_Name : Name_Id; | |
686 | Project_Tree : Project_Tree_Ref; | |
687 | Value : out Variable_Value; | |
688 | Is_Default : out Boolean) | |
689 | is | |
49bfcf43 AC |
690 | Project : constant Project_Id := |
691 | Ultimate_Extending_Project_Of (Source_Prj); | |
692 | Pkg : constant Package_Id := | |
693 | Prj.Util.Value_Of | |
694 | (Name => Pkg_Name, | |
695 | In_Packages => Project.Decl.Packages, | |
696 | In_Tree => Project_Tree); | |
34798441 EB |
697 | begin |
698 | Is_Default := False; | |
699 | ||
700 | if Source_File /= No_File then | |
701 | Value := Prj.Util.Value_Of | |
702 | (Name => Name_Id (Source_File), | |
703 | Attribute_Or_Array_Name => Name_Switches, | |
704 | In_Package => Pkg, | |
705 | In_Tree => Project_Tree, | |
706 | Allow_Wildcards => True); | |
707 | end if; | |
708 | ||
709 | if Value = Nil_Variable_Value then | |
710 | Is_Default := True; | |
711 | Is_Default := True; | |
712 | Value := | |
713 | Prj.Util.Value_Of | |
714 | (Name => Source_Lang, | |
715 | Attribute_Or_Array_Name => Name_Switches, | |
716 | In_Package => Pkg, | |
717 | In_Tree => Project_Tree, | |
718 | Force_Lower_Case_Index => True); | |
719 | end if; | |
720 | ||
721 | if Value = Nil_Variable_Value then | |
722 | Value := | |
723 | Prj.Util.Value_Of | |
724 | (Name => All_Other_Names, | |
725 | Attribute_Or_Array_Name => Name_Switches, | |
726 | In_Package => Pkg, | |
727 | In_Tree => Project_Tree, | |
728 | Force_Lower_Case_Index => True); | |
729 | end if; | |
730 | ||
731 | if Value = Nil_Variable_Value then | |
732 | Value := | |
733 | Prj.Util.Value_Of | |
734 | (Name => Source_Lang, | |
735 | Attribute_Or_Array_Name => Name_Default_Switches, | |
736 | In_Package => Pkg, | |
737 | In_Tree => Project_Tree); | |
738 | end if; | |
739 | end Get_Switches; | |
740 | ||
aa720a54 AC |
741 | ---------- |
742 | -- Hash -- | |
743 | ---------- | |
744 | ||
745 | function Hash (Key : Mark_Key) return Mark_Num is | |
746 | begin | |
747 | return Union_Id (Key.File) mod Max_Mask_Num; | |
748 | end Hash; | |
749 | ||
2cd44f5a VC |
750 | ------------ |
751 | -- Inform -- | |
752 | ------------ | |
753 | ||
754 | procedure Inform (N : File_Name_Type; Msg : String) is | |
755 | begin | |
756 | Inform (Name_Id (N), Msg); | |
757 | end Inform; | |
758 | ||
759 | procedure Inform (N : Name_Id := No_Name; Msg : String) is | |
760 | begin | |
761 | Osint.Write_Program_Name; | |
762 | ||
763 | Write_Str (": "); | |
764 | ||
765 | if N /= No_Name then | |
766 | Write_Str (""""); | |
7d903840 AC |
767 | |
768 | declare | |
769 | Name : constant String := Get_Name_String (N); | |
770 | begin | |
771 | if Debug.Debug_Flag_F and then Is_Absolute_Path (Name) then | |
772 | Write_Str (File_Name (Name)); | |
773 | else | |
774 | Write_Str (Name); | |
775 | end if; | |
776 | end; | |
777 | ||
2cd44f5a VC |
778 | Write_Str (""" "); |
779 | end if; | |
780 | ||
781 | Write_Str (Msg); | |
782 | Write_Eol; | |
783 | end Inform; | |
784 | ||
8f9df7d8 VC |
785 | ---------------------------- |
786 | -- Is_External_Assignment -- | |
787 | ---------------------------- | |
788 | ||
daa72421 | 789 | function Is_External_Assignment |
804fe3c4 | 790 | (Env : Prj.Tree.Environment; |
daa72421 AC |
791 | Argv : String) return Boolean |
792 | is | |
8f9df7d8 VC |
793 | Start : Positive := 3; |
794 | Finish : Natural := Argv'Last; | |
8f9df7d8 | 795 | |
bfc8aa81 RD |
796 | pragma Assert (Argv'First = 1); |
797 | pragma Assert (Argv (1 .. 2) = "-X"); | |
798 | ||
8f9df7d8 VC |
799 | begin |
800 | if Argv'Last < 5 then | |
801 | return False; | |
802 | ||
803 | elsif Argv (3) = '"' then | |
804 | if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then | |
805 | return False; | |
806 | else | |
807 | Start := 4; | |
808 | Finish := Argv'Last - 1; | |
809 | end if; | |
810 | end if; | |
811 | ||
d9b4a5d3 | 812 | return Prj.Ext.Check |
804fe3c4 | 813 | (Self => Env.External, |
d9b4a5d3 | 814 | Declaration => Argv (Start .. Finish)); |
8f9df7d8 VC |
815 | end Is_External_Assignment; |
816 | ||
aa720a54 AC |
817 | --------------- |
818 | -- Is_Marked -- | |
819 | --------------- | |
820 | ||
821 | function Is_Marked | |
822 | (Source_File : File_Name_Type; | |
5950a3ac | 823 | Index : Int := 0) return Boolean |
aa720a54 AC |
824 | is |
825 | begin | |
826 | return Marks.Get (K => (File => Source_File, Index => Index)); | |
827 | end Is_Marked; | |
828 | ||
8f9df7d8 VC |
829 | ----------------------------- |
830 | -- Linker_Options_Switches -- | |
831 | ----------------------------- | |
832 | ||
833 | function Linker_Options_Switches | |
7e98a4c6 VC |
834 | (Project : Project_Id; |
835 | In_Tree : Project_Tree_Ref) return String_List | |
8f9df7d8 | 836 | is |
8b9890fa | 837 | procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean); |
5950a3ac | 838 | -- The recursive routine used to add linker options |
8f9df7d8 | 839 | |
8b9890fa EB |
840 | ------------------- |
841 | -- Recursive_Add -- | |
842 | ------------------- | |
8f9df7d8 | 843 | |
8b9890fa EB |
844 | procedure Recursive_Add (Proj : Project_Id; Dummy : in out Boolean) is |
845 | pragma Unreferenced (Dummy); | |
74744c7b | 846 | |
8f9df7d8 | 847 | Linker_Package : Package_Id; |
5950a3ac | 848 | Options : Variable_Value; |
5950a3ac | 849 | |
8f9df7d8 | 850 | begin |
8b9890fa EB |
851 | Linker_Package := |
852 | Prj.Util.Value_Of | |
853 | (Name => Name_Linker, | |
66713d62 | 854 | In_Packages => Proj.Decl.Packages, |
8b9890fa | 855 | In_Tree => In_Tree); |
74744c7b | 856 | |
8b9890fa EB |
857 | Options := |
858 | Prj.Util.Value_Of | |
859 | (Name => Name_Ada, | |
860 | Index => 0, | |
861 | Attribute_Or_Array_Name => Name_Linker_Options, | |
862 | In_Package => Linker_Package, | |
863 | In_Tree => In_Tree); | |
864 | ||
865 | -- If attribute is present, add the project with | |
866 | -- the attribute to table Linker_Opts. | |
867 | ||
868 | if Options /= Nil_Variable_Value then | |
869 | Linker_Opts.Increment_Last; | |
870 | Linker_Opts.Table (Linker_Opts.Last) := | |
871 | (Project => Proj, Options => Options.Values); | |
8f9df7d8 | 872 | end if; |
8b9890fa EB |
873 | end Recursive_Add; |
874 | ||
875 | procedure For_All_Projects is | |
876 | new For_Every_Project_Imported (Boolean, Recursive_Add); | |
74744c7b | 877 | |
8b9890fa | 878 | Dummy : Boolean := False; |
8f9df7d8 | 879 | |
5950a3ac AC |
880 | -- Start of processing for Linker_Options_Switches |
881 | ||
8f9df7d8 VC |
882 | begin |
883 | Linker_Opts.Init; | |
884 | ||
66713d62 | 885 | For_All_Projects (Project, Dummy, Imported_First => True); |
8f9df7d8 VC |
886 | |
887 | Last_Linker_Option := 0; | |
888 | ||
889 | for Index in reverse 1 .. Linker_Opts.Last loop | |
890 | declare | |
66713d62 | 891 | Options : String_List_Id; |
8f9df7d8 | 892 | Proj : constant Project_Id := |
74744c7b | 893 | Linker_Opts.Table (Index).Project; |
8f9df7d8 | 894 | Option : Name_Id; |
2324b3fd | 895 | Dir_Path : constant String := |
66713d62 | 896 | Get_Name_String (Proj.Directory.Name); |
8f9df7d8 VC |
897 | |
898 | begin | |
66713d62 | 899 | Options := Linker_Opts.Table (Index).Options; |
8f9df7d8 | 900 | while Options /= Nil_String loop |
74744c7b | 901 | Option := In_Tree.String_Elements.Table (Options).Value; |
f2c573b1 VC |
902 | Get_Name_String (Option); |
903 | ||
904 | -- Do not consider empty linker options | |
905 | ||
906 | if Name_Len /= 0 then | |
907 | Add_Linker_Option (Name_Buffer (1 .. Name_Len)); | |
908 | ||
909 | -- Object files and -L switches specified with relative | |
910 | -- paths must be converted to absolute paths. | |
911 | ||
912 | Test_If_Relative_Path | |
74744c7b | 913 | (Switch => Linker_Options_Buffer (Last_Linker_Option), |
2324b3fd | 914 | Parent => Dir_Path, |
f2c573b1 VC |
915 | Including_L_Switch => True); |
916 | end if; | |
917 | ||
66713d62 | 918 | Options := In_Tree.String_Elements.Table (Options).Next; |
8f9df7d8 VC |
919 | end loop; |
920 | end; | |
921 | end loop; | |
922 | ||
923 | return Linker_Options_Buffer (1 .. Last_Linker_Option); | |
924 | end Linker_Options_Switches; | |
925 | ||
926 | ----------- | |
927 | -- Mains -- | |
928 | ----------- | |
929 | ||
930 | package body Mains is | |
931 | ||
1e887886 VC |
932 | type File_And_Loc is record |
933 | File_Name : File_Name_Type; | |
c9df623a | 934 | Index : Int := 0; |
1e887886 VC |
935 | Location : Source_Ptr := No_Location; |
936 | end record; | |
937 | ||
8f9df7d8 | 938 | package Names is new Table.Table |
1e887886 | 939 | (Table_Component_Type => File_And_Loc, |
8f9df7d8 VC |
940 | Table_Index_Type => Integer, |
941 | Table_Low_Bound => 1, | |
942 | Table_Initial => 10, | |
943 | Table_Increment => 100, | |
944 | Table_Name => "Makeutl.Mains.Names"); | |
945 | -- The table that stores the mains | |
946 | ||
947 | Current : Natural := 0; | |
948 | -- The index of the last main retrieved from the table | |
949 | ||
950 | -------------- | |
951 | -- Add_Main -- | |
952 | -------------- | |
953 | ||
954 | procedure Add_Main (Name : String) is | |
955 | begin | |
956 | Name_Len := 0; | |
957 | Add_Str_To_Name_Buffer (Name); | |
958 | Names.Increment_Last; | |
c9df623a | 959 | Names.Table (Names.Last) := (Name_Find, 0, No_Location); |
8f9df7d8 VC |
960 | end Add_Main; |
961 | ||
962 | ------------ | |
963 | -- Delete -- | |
964 | ------------ | |
965 | ||
966 | procedure Delete is | |
967 | begin | |
968 | Names.Set_Last (0); | |
7e98a4c6 | 969 | Mains.Reset; |
8f9df7d8 VC |
970 | end Delete; |
971 | ||
c9df623a AC |
972 | --------------- |
973 | -- Get_Index -- | |
974 | --------------- | |
975 | ||
976 | function Get_Index return Int is | |
977 | begin | |
978 | if Current in Names.First .. Names.Last then | |
979 | return Names.Table (Current).Index; | |
980 | else | |
981 | return 0; | |
982 | end if; | |
983 | end Get_Index; | |
984 | ||
1e887886 VC |
985 | ------------------ |
986 | -- Get_Location -- | |
987 | ------------------ | |
988 | ||
989 | function Get_Location return Source_Ptr is | |
990 | begin | |
a573518c TQ |
991 | if Current in Names.First .. Names.Last then |
992 | return Names.Table (Current).Location; | |
1e887886 | 993 | else |
a573518c | 994 | return No_Location; |
1e887886 VC |
995 | end if; |
996 | end Get_Location; | |
997 | ||
8f9df7d8 VC |
998 | --------------- |
999 | -- Next_Main -- | |
1000 | --------------- | |
1001 | ||
1002 | function Next_Main return String is | |
1003 | begin | |
1004 | if Current >= Names.Last then | |
1005 | return ""; | |
8f9df7d8 VC |
1006 | else |
1007 | Current := Current + 1; | |
1e887886 | 1008 | return Get_Name_String (Names.Table (Current).File_Name); |
8f9df7d8 VC |
1009 | end if; |
1010 | end Next_Main; | |
1011 | ||
1012 | --------------------- | |
1013 | -- Number_Of_Mains -- | |
1014 | --------------------- | |
1015 | ||
1016 | function Number_Of_Mains return Natural is | |
1017 | begin | |
1018 | return Names.Last; | |
1019 | end Number_Of_Mains; | |
1020 | ||
1021 | ----------- | |
1022 | -- Reset -- | |
1023 | ----------- | |
1024 | ||
1025 | procedure Reset is | |
1026 | begin | |
1027 | Current := 0; | |
1028 | end Reset; | |
1029 | ||
c9df623a AC |
1030 | --------------- |
1031 | -- Set_Index -- | |
1032 | --------------- | |
1033 | ||
1034 | procedure Set_Index (Index : Int) is | |
1035 | begin | |
1036 | if Names.Last > 0 then | |
1037 | Names.Table (Names.Last).Index := Index; | |
1038 | end if; | |
1039 | end Set_Index; | |
1040 | ||
1e887886 VC |
1041 | ------------------ |
1042 | -- Set_Location -- | |
1043 | ------------------ | |
1044 | ||
1045 | procedure Set_Location (Location : Source_Ptr) is | |
1046 | begin | |
1047 | if Names.Last > 0 then | |
1048 | Names.Table (Names.Last).Location := Location; | |
1049 | end if; | |
1050 | end Set_Location; | |
1051 | ||
1052 | ----------------- | |
1053 | -- Update_Main -- | |
1054 | ----------------- | |
1055 | ||
1056 | procedure Update_Main (Name : String) is | |
1057 | begin | |
a573518c | 1058 | if Current in Names.First .. Names.Last then |
1e887886 VC |
1059 | Name_Len := 0; |
1060 | Add_Str_To_Name_Buffer (Name); | |
1061 | Names.Table (Current).File_Name := Name_Find; | |
1062 | end if; | |
1063 | end Update_Main; | |
8f9df7d8 VC |
1064 | end Mains; |
1065 | ||
aa720a54 AC |
1066 | ---------- |
1067 | -- Mark -- | |
1068 | ---------- | |
1069 | ||
1070 | procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is | |
1071 | begin | |
1072 | Marks.Set (K => (File => Source_File, Index => Index), E => True); | |
1073 | end Mark; | |
1074 | ||
7d903840 AC |
1075 | ----------------------- |
1076 | -- Path_Or_File_Name -- | |
1077 | ----------------------- | |
1078 | ||
1079 | function Path_Or_File_Name (Path : Path_Name_Type) return String is | |
1080 | Path_Name : constant String := Get_Name_String (Path); | |
1081 | begin | |
1082 | if Debug.Debug_Flag_F then | |
1083 | return File_Name (Path_Name); | |
1084 | else | |
1085 | return Path_Name; | |
1086 | end if; | |
1087 | end Path_Or_File_Name; | |
1088 | ||
8f9df7d8 VC |
1089 | --------------------------- |
1090 | -- Test_If_Relative_Path -- | |
1091 | --------------------------- | |
1092 | ||
1093 | procedure Test_If_Relative_Path | |
1086c39b | 1094 | (Switch : in out String_Access; |
2324b3fd | 1095 | Parent : String; |
1086c39b | 1096 | Including_L_Switch : Boolean := True; |
35debead EB |
1097 | Including_Non_Switch : Boolean := True; |
1098 | Including_RTS : Boolean := False) | |
8f9df7d8 VC |
1099 | is |
1100 | begin | |
1101 | if Switch /= null then | |
8f9df7d8 | 1102 | declare |
74744c7b | 1103 | Sw : String (1 .. Switch'Length); |
8f9df7d8 VC |
1104 | Start : Positive; |
1105 | ||
1106 | begin | |
1107 | Sw := Switch.all; | |
1108 | ||
1109 | if Sw (1) = '-' then | |
1110 | if Sw'Length >= 3 | |
1111 | and then (Sw (2) = 'A' | |
74744c7b AC |
1112 | or else Sw (2) = 'I' |
1113 | or else (Including_L_Switch and then Sw (2) = 'L')) | |
8f9df7d8 VC |
1114 | then |
1115 | Start := 3; | |
1116 | ||
1117 | if Sw = "-I-" then | |
1118 | return; | |
1119 | end if; | |
1120 | ||
1121 | elsif Sw'Length >= 4 | |
1122 | and then (Sw (2 .. 3) = "aL" | |
74744c7b AC |
1123 | or else Sw (2 .. 3) = "aO" |
1124 | or else Sw (2 .. 3) = "aI") | |
8f9df7d8 VC |
1125 | then |
1126 | Start := 4; | |
1127 | ||
35debead EB |
1128 | elsif Including_RTS |
1129 | and then Sw'Length >= 7 | |
1130 | and then Sw (2 .. 6) = "-RTS=" | |
1131 | then | |
1132 | Start := 7; | |
1133 | ||
8f9df7d8 VC |
1134 | else |
1135 | return; | |
1136 | end if; | |
1137 | ||
1138 | -- Because relative path arguments to --RTS= may be relative | |
1139 | -- to the search directory prefix, those relative path | |
35debead EB |
1140 | -- arguments are converted only when they include directory |
1141 | -- information. | |
8f9df7d8 VC |
1142 | |
1143 | if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then | |
2324b3fd | 1144 | if Parent'Length = 0 then |
8f9df7d8 | 1145 | Do_Fail |
3dd9959c AC |
1146 | ("relative search path switches (""" |
1147 | & Sw | |
1148 | & """) are not allowed"); | |
8f9df7d8 | 1149 | |
35debead EB |
1150 | elsif Including_RTS then |
1151 | for J in Start .. Sw'Last loop | |
1152 | if Sw (J) = Directory_Separator then | |
1153 | Switch := | |
1154 | new String' | |
1155 | (Sw (1 .. Start - 1) & | |
1156 | Parent & | |
1157 | Directory_Separator & | |
1158 | Sw (Start .. Sw'Last)); | |
1159 | return; | |
1160 | end if; | |
1161 | end loop; | |
1162 | ||
8f9df7d8 VC |
1163 | else |
1164 | Switch := | |
1165 | new String' | |
1166 | (Sw (1 .. Start - 1) & | |
2324b3fd | 1167 | Parent & |
8f9df7d8 VC |
1168 | Directory_Separator & |
1169 | Sw (Start .. Sw'Last)); | |
1170 | end if; | |
1171 | end if; | |
1172 | ||
1086c39b | 1173 | elsif Including_Non_Switch then |
8f9df7d8 | 1174 | if not Is_Absolute_Path (Sw) then |
2324b3fd | 1175 | if Parent'Length = 0 then |
8f9df7d8 | 1176 | Do_Fail |
3dd9959c | 1177 | ("relative paths (""" & Sw & """) are not allowed"); |
8f9df7d8 | 1178 | else |
2324b3fd | 1179 | Switch := new String'(Parent & Directory_Separator & Sw); |
8f9df7d8 VC |
1180 | end if; |
1181 | end if; | |
1182 | end if; | |
1183 | end; | |
1184 | end if; | |
1185 | end Test_If_Relative_Path; | |
1186 | ||
aa720a54 AC |
1187 | ------------------- |
1188 | -- Unit_Index_Of -- | |
1189 | ------------------- | |
1190 | ||
1191 | function Unit_Index_Of (ALI_File : File_Name_Type) return Int is | |
1192 | Start : Natural; | |
1193 | Finish : Natural; | |
1194 | Result : Int := 0; | |
5950a3ac | 1195 | |
aa720a54 AC |
1196 | begin |
1197 | Get_Name_String (ALI_File); | |
1198 | ||
1199 | -- First, find the last dot | |
1200 | ||
1201 | Finish := Name_Len; | |
1202 | ||
1203 | while Finish >= 1 and then Name_Buffer (Finish) /= '.' loop | |
1204 | Finish := Finish - 1; | |
1205 | end loop; | |
1206 | ||
1207 | if Finish = 1 then | |
1208 | return 0; | |
1209 | end if; | |
1210 | ||
1211 | -- Now check that the dot is preceded by digits | |
1212 | ||
1213 | Start := Finish; | |
1214 | Finish := Finish - 1; | |
1215 | ||
1216 | while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop | |
1217 | Start := Start - 1; | |
1218 | end loop; | |
1219 | ||
74744c7b AC |
1220 | -- If there are no digits, or if the digits are not preceded by the |
1221 | -- character that precedes a unit index, this is not the ALI file of | |
1222 | -- a unit in a multi-unit source. | |
aa720a54 | 1223 | |
5950a3ac AC |
1224 | if Start > Finish |
1225 | or else Start = 1 | |
1226 | or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character | |
aa720a54 AC |
1227 | then |
1228 | return 0; | |
1229 | end if; | |
1230 | ||
1231 | -- Build the index from the digit(s) | |
1232 | ||
1233 | while Start <= Finish loop | |
5950a3ac AC |
1234 | Result := Result * 10 + |
1235 | Character'Pos (Name_Buffer (Start)) - Character'Pos ('0'); | |
aa720a54 AC |
1236 | Start := Start + 1; |
1237 | end loop; | |
1238 | ||
1239 | return Result; | |
1240 | end Unit_Index_Of; | |
1241 | ||
f7e71125 AC |
1242 | ----------------- |
1243 | -- Verbose_Msg -- | |
1244 | ----------------- | |
1245 | ||
1246 | procedure Verbose_Msg | |
1247 | (N1 : Name_Id; | |
1248 | S1 : String; | |
1249 | N2 : Name_Id := No_Name; | |
1250 | S2 : String := ""; | |
1251 | Prefix : String := " -> "; | |
1252 | Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low) | |
1253 | is | |
1254 | begin | |
1255 | if not Opt.Verbose_Mode | |
1256 | or else Minimum_Verbosity > Opt.Verbosity_Level | |
1257 | then | |
1258 | return; | |
1259 | end if; | |
1260 | ||
1261 | Write_Str (Prefix); | |
1262 | Write_Str (""""); | |
1263 | Write_Name (N1); | |
1264 | Write_Str (""" "); | |
1265 | Write_Str (S1); | |
1266 | ||
1267 | if N2 /= No_Name then | |
1268 | Write_Str (" """); | |
1269 | Write_Name (N2); | |
1270 | Write_Str (""" "); | |
1271 | end if; | |
1272 | ||
1273 | Write_Str (S2); | |
1274 | Write_Eol; | |
1275 | end Verbose_Msg; | |
1276 | ||
1277 | procedure Verbose_Msg | |
1278 | (N1 : File_Name_Type; | |
1279 | S1 : String; | |
1280 | N2 : File_Name_Type := No_File; | |
1281 | S2 : String := ""; | |
1282 | Prefix : String := " -> "; | |
1283 | Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low) | |
1284 | is | |
1285 | begin | |
1286 | Verbose_Msg | |
1287 | (Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity); | |
1288 | end Verbose_Msg; | |
1289 | ||
8f9df7d8 | 1290 | end Makeutl; |