]>
Commit | Line | Data |
---|---|---|
83cce46b | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T B I N D -- | |
6 | -- -- | |
7 | -- B o d y -- | |
83cce46b | 8 | -- -- |
9dfe12ae | 9 | -- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- |
83cce46b | 10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
e78e8c8e | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
83cce46b | 24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | with ALI; use ALI; | |
28 | with ALI.Util; use ALI.Util; | |
29 | with Bcheck; use Bcheck; | |
30 | with Binde; use Binde; | |
31 | with Binderr; use Binderr; | |
32 | with Bindgen; use Bindgen; | |
33 | with Bindusg; | |
34 | with Butil; use Butil; | |
35 | with Csets; | |
9dfe12ae | 36 | with Fmap; |
83cce46b | 37 | with Gnatvsn; use Gnatvsn; |
38 | with Namet; use Namet; | |
39 | with Opt; use Opt; | |
40 | with Osint; use Osint; | |
f15731c4 | 41 | with Osint.B; use Osint.B; |
83cce46b | 42 | with Output; use Output; |
9dfe12ae | 43 | with Rident; use Rident; |
83cce46b | 44 | with Switch; use Switch; |
f15731c4 | 45 | with Switch.B; use Switch.B; |
46 | with Targparm; use Targparm; | |
83cce46b | 47 | with Types; use Types; |
9dfe12ae | 48 | with Uintp; use Uintp; |
49 | ||
50 | with System.Case_Util; use System.Case_Util; | |
83cce46b | 51 | |
52 | procedure Gnatbind is | |
53 | ||
54 | Total_Errors : Nat := 0; | |
55 | -- Counts total errors in all files | |
56 | ||
57 | Total_Warnings : Nat := 0; | |
58 | -- Total warnings in all files | |
59 | ||
60 | Main_Lib_File : File_Name_Type; | |
61 | -- Current main library file | |
62 | ||
63 | Std_Lib_File : File_Name_Type; | |
64 | -- Standard library | |
65 | ||
9dfe12ae | 66 | Text : Text_Buffer_Ptr; |
83cce46b | 67 | Next_Arg : Positive; |
68 | ||
69 | Output_File_Name_Seen : Boolean := False; | |
9dfe12ae | 70 | Output_File_Name : String_Ptr := new String'(""); |
83cce46b | 71 | |
9dfe12ae | 72 | L_Switch_Seen : Boolean := False; |
73 | ||
74 | Mapping_File : String_Ptr := null; | |
83cce46b | 75 | |
76 | procedure Scan_Bind_Arg (Argv : String); | |
77 | -- Scan and process binder specific arguments. Argv is a single argument. | |
78 | -- All the one character arguments are still handled by Switch. This | |
79 | -- routine handles -aO -aI and -I-. | |
80 | ||
81 | ------------------- | |
82 | -- Scan_Bind_Arg -- | |
83 | ------------------- | |
84 | ||
85 | procedure Scan_Bind_Arg (Argv : String) is | |
86 | begin | |
87 | -- Now scan arguments that are specific to the binder and are not | |
88 | -- handled by the common circuitry in Switch. | |
89 | ||
90 | if Opt.Output_File_Name_Present | |
91 | and then not Output_File_Name_Seen | |
92 | then | |
93 | Output_File_Name_Seen := True; | |
94 | ||
95 | if Argv'Length = 0 | |
f15731c4 | 96 | or else (Argv'Length >= 1 and then Argv (1) = '-') |
83cce46b | 97 | then |
98 | Fail ("output File_Name missing after -o"); | |
99 | ||
100 | else | |
101 | Output_File_Name := new String'(Argv); | |
102 | end if; | |
103 | ||
f15731c4 | 104 | elsif Argv'Length >= 2 and then Argv (1) = '-' then |
105 | ||
83cce46b | 106 | -- -I- |
107 | ||
108 | if Argv (2 .. Argv'Last) = "I-" then | |
109 | Opt.Look_In_Primary_Dir := False; | |
110 | ||
111 | -- -Idir | |
112 | ||
113 | elsif Argv (2) = 'I' then | |
114 | Add_Src_Search_Dir (Argv (3 .. Argv'Last)); | |
115 | Add_Lib_Search_Dir (Argv (3 .. Argv'Last)); | |
116 | ||
117 | -- -Ldir | |
118 | ||
119 | elsif Argv (2) = 'L' then | |
120 | if Argv'Length >= 3 then | |
9dfe12ae | 121 | |
122 | -- Remember that the -L switch was specified, so that if this | |
123 | -- is on OpenVMS, the export names are put in uppercase. | |
124 | -- This is not known before the target parameters are read. | |
125 | ||
126 | L_Switch_Seen := True; | |
127 | ||
83cce46b | 128 | Opt.Bind_For_Library := True; |
129 | Opt.Ada_Init_Name := | |
130 | new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix); | |
131 | Opt.Ada_Final_Name := | |
132 | new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix); | |
133 | Opt.Ada_Main_Name := | |
134 | new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix); | |
135 | ||
136 | -- This option (-Lxxx) implies -n | |
137 | ||
138 | Opt.Bind_Main_Program := False; | |
9dfe12ae | 139 | |
83cce46b | 140 | else |
141 | Fail | |
142 | ("Prefix of initialization and finalization " & | |
143 | "procedure names missing in -L"); | |
144 | end if; | |
145 | ||
146 | -- -Sin -Slo -Shi -Sxx | |
147 | ||
148 | elsif Argv'Length = 4 | |
149 | and then Argv (2) = 'S' | |
150 | then | |
151 | declare | |
152 | C1 : Character := Argv (3); | |
153 | C2 : Character := Argv (4); | |
154 | ||
155 | begin | |
9dfe12ae | 156 | -- Fold to upper case |
157 | ||
83cce46b | 158 | if C1 in 'a' .. 'z' then |
159 | C1 := Character'Val (Character'Pos (C1) - 32); | |
160 | end if; | |
161 | ||
162 | if C2 in 'a' .. 'z' then | |
163 | C2 := Character'Val (Character'Pos (C2) - 32); | |
164 | end if; | |
165 | ||
9dfe12ae | 166 | -- Test valid option and set mode accordingly |
167 | ||
168 | if C1 = 'E' and then C2 = 'V' then | |
169 | null; | |
170 | ||
171 | elsif C1 = 'I' and then C2 = 'N' then | |
172 | null; | |
83cce46b | 173 | |
174 | elsif C1 = 'L' and then C2 = 'O' then | |
9dfe12ae | 175 | null; |
83cce46b | 176 | |
177 | elsif C1 = 'H' and then C2 = 'I' then | |
9dfe12ae | 178 | null; |
83cce46b | 179 | |
180 | elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F') | |
181 | and then | |
182 | (C2 in '0' .. '9' or else C2 in 'A' .. 'F') | |
183 | then | |
9dfe12ae | 184 | null; |
83cce46b | 185 | |
9dfe12ae | 186 | -- Invalid -S switch, let Switch give error, set defalut of IN |
83cce46b | 187 | |
188 | else | |
189 | Scan_Binder_Switches (Argv); | |
9dfe12ae | 190 | C1 := 'I'; |
191 | C2 := 'N'; | |
83cce46b | 192 | end if; |
9dfe12ae | 193 | |
194 | Initialize_Scalars_Mode1 := C1; | |
195 | Initialize_Scalars_Mode2 := C2; | |
83cce46b | 196 | end; |
197 | ||
198 | -- -aIdir | |
199 | ||
200 | elsif Argv'Length >= 3 | |
201 | and then Argv (2 .. 3) = "aI" | |
202 | then | |
203 | Add_Src_Search_Dir (Argv (4 .. Argv'Last)); | |
204 | ||
205 | -- -aOdir | |
206 | ||
207 | elsif Argv'Length >= 3 | |
208 | and then Argv (2 .. 3) = "aO" | |
209 | then | |
210 | Add_Lib_Search_Dir (Argv (4 .. Argv'Last)); | |
211 | ||
212 | -- -nostdlib | |
213 | ||
214 | elsif Argv (2 .. Argv'Last) = "nostdlib" then | |
215 | Opt.No_Stdlib := True; | |
216 | ||
217 | -- -nostdinc | |
218 | ||
219 | elsif Argv (2 .. Argv'Last) = "nostdinc" then | |
220 | Opt.No_Stdinc := True; | |
221 | ||
222 | -- -static | |
223 | ||
224 | elsif Argv (2 .. Argv'Last) = "static" then | |
225 | Opt.Shared_Libgnat := False; | |
226 | ||
227 | -- -shared | |
228 | ||
229 | elsif Argv (2 .. Argv'Last) = "shared" then | |
230 | Opt.Shared_Libgnat := True; | |
231 | ||
9dfe12ae | 232 | -- -F=mapping_file |
233 | ||
234 | elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then | |
235 | if Mapping_File /= null then | |
236 | Fail ("cannot specify several mapping files"); | |
237 | end if; | |
238 | ||
239 | Mapping_File := new String'(Argv (4 .. Argv'Last)); | |
240 | ||
83cce46b | 241 | -- -Mname |
242 | ||
243 | elsif Argv'Length >= 3 and then Argv (2) = 'M' then | |
244 | Opt.Bind_Alternate_Main_Name := True; | |
9dfe12ae | 245 | Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last)); |
83cce46b | 246 | |
247 | -- All other options are single character and are handled | |
248 | -- by Scan_Binder_Switches. | |
249 | ||
250 | else | |
251 | Scan_Binder_Switches (Argv); | |
252 | end if; | |
253 | ||
254 | -- Not a switch, so must be a file name (if non-empty) | |
255 | ||
256 | elsif Argv'Length /= 0 then | |
257 | if Argv'Length > 4 | |
258 | and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali" | |
259 | then | |
f15731c4 | 260 | Add_File (Argv); |
83cce46b | 261 | else |
f15731c4 | 262 | Add_File (Argv & ".ali"); |
83cce46b | 263 | end if; |
264 | end if; | |
265 | end Scan_Bind_Arg; | |
266 | ||
267 | -- Start of processing for Gnatbind | |
268 | ||
269 | begin | |
83cce46b | 270 | |
271 | -- Set default for Shared_Libgnat option | |
272 | ||
273 | declare | |
274 | Shared_Libgnat_Default : Character; | |
275 | pragma Import (C, Shared_Libgnat_Default, "shared_libgnat_default"); | |
276 | ||
277 | SHARED : constant Character := 'H'; | |
278 | STATIC : constant Character := 'T'; | |
279 | ||
280 | begin | |
281 | pragma Assert | |
282 | (Shared_Libgnat_Default = SHARED | |
283 | or else | |
284 | Shared_Libgnat_Default = STATIC); | |
285 | Shared_Libgnat := (Shared_Libgnat_Default = SHARED); | |
286 | end; | |
287 | ||
288 | -- Use low level argument routines to avoid dragging in the secondary stack | |
289 | ||
290 | Next_Arg := 1; | |
291 | Scan_Args : while Next_Arg < Arg_Count loop | |
292 | declare | |
293 | Next_Argv : String (1 .. Len_Arg (Next_Arg)); | |
294 | ||
295 | begin | |
296 | Fill_Arg (Next_Argv'Address, Next_Arg); | |
297 | Scan_Bind_Arg (Next_Argv); | |
298 | end; | |
299 | Next_Arg := Next_Arg + 1; | |
300 | end loop Scan_Args; | |
301 | ||
302 | -- Test for trailing -o switch | |
303 | ||
304 | if Opt.Output_File_Name_Present | |
305 | and then not Output_File_Name_Seen | |
306 | then | |
307 | Fail ("output file name missing after -o"); | |
308 | end if; | |
309 | ||
310 | -- Output usage if requested | |
311 | ||
312 | if Usage_Requested then | |
313 | Bindusg; | |
314 | end if; | |
315 | ||
316 | -- Check that the Ada binder file specified has extension .adb and that | |
317 | -- the C binder file has extension .c | |
318 | ||
319 | if Opt.Output_File_Name_Present | |
320 | and then Output_File_Name_Seen | |
321 | then | |
322 | Check_Extensions : declare | |
323 | Length : constant Natural := Output_File_Name'Length; | |
324 | Last : constant Natural := Output_File_Name'Last; | |
325 | ||
326 | begin | |
327 | if Ada_Bind_File then | |
328 | if Length <= 4 | |
329 | or else Output_File_Name (Last - 3 .. Last) /= ".adb" | |
330 | then | |
331 | Fail ("output file name should have .adb extension"); | |
332 | end if; | |
333 | ||
334 | else | |
335 | if Length <= 2 | |
336 | or else Output_File_Name (Last - 1 .. Last) /= ".c" | |
337 | then | |
338 | Fail ("output file name should have .c extension"); | |
339 | end if; | |
340 | end if; | |
341 | end Check_Extensions; | |
342 | end if; | |
343 | ||
344 | Osint.Add_Default_Search_Dirs; | |
345 | ||
9dfe12ae | 346 | -- Carry out package initializations. These are initializations which |
347 | -- might logically be performed at elaboration time, but Namet at | |
348 | -- least can't be done that way (because it is used in the Compiler), | |
349 | -- and we decide to be consistent. Like elaboration, the order in | |
350 | -- which these calls are made is in some cases important. | |
f15731c4 | 351 | |
9dfe12ae | 352 | Csets.Initialize; |
353 | Namet.Initialize; | |
f15731c4 | 354 | |
9dfe12ae | 355 | -- Acquire target parameters |
356 | ||
357 | Targparm.Get_Target_Parameters; | |
358 | ||
359 | -- On OpenVMS, when -L is used, all external names used in pragmas Export | |
360 | -- are in upper case. The reason is that on OpenVMS, the macro-assembler | |
361 | -- MACASM-32, used to build Stand-Alone Libraries, only understands | |
362 | -- uppercase. | |
f15731c4 | 363 | |
9dfe12ae | 364 | if L_Switch_Seen and then OpenVMS_On_Target then |
365 | To_Upper (Opt.Ada_Init_Name.all); | |
366 | To_Upper (Opt.Ada_Final_Name.all); | |
367 | To_Upper (Opt.Ada_Main_Name.all); | |
368 | end if; | |
369 | ||
370 | -- Acquire configurable run-time mode | |
371 | ||
372 | if Configurable_Run_Time_On_Target then | |
373 | Configurable_Run_Time_Mode := True; | |
374 | end if; | |
375 | ||
376 | -- Output copyright notice if in verbose mode | |
377 | ||
378 | if Verbose_Mode then | |
379 | Write_Eol; | |
380 | Write_Str ("GNATBIND "); | |
83cce46b | 381 | Write_Str (Gnat_Version_String); |
9dfe12ae | 382 | Write_Str (" Copyright 1995-2003 Free Software Foundation, Inc."); |
83cce46b | 383 | Write_Eol; |
384 | end if; | |
385 | ||
386 | -- Output usage information if no files | |
387 | ||
388 | if not More_Lib_Files then | |
389 | Bindusg; | |
390 | Exit_Program (E_Fatal); | |
391 | end if; | |
392 | ||
9dfe12ae | 393 | -- If a mapping file was specified, initialize the file mapping |
394 | ||
395 | if Mapping_File /= null then | |
396 | Fmap.Initialize (Mapping_File.all); | |
397 | end if; | |
398 | ||
83cce46b | 399 | -- The block here is to catch the Unrecoverable_Error exception in the |
400 | -- case where we exceed the maximum number of permissible errors or some | |
401 | -- other unrecoverable error occurs. | |
402 | ||
403 | begin | |
9dfe12ae | 404 | -- Initialize binder packages |
405 | ||
83cce46b | 406 | Initialize_Binderr; |
407 | Initialize_ALI; | |
408 | Initialize_ALI_Source; | |
409 | ||
410 | if Verbose_Mode then | |
411 | Write_Eol; | |
412 | end if; | |
413 | ||
414 | -- Input ALI files | |
415 | ||
416 | while More_Lib_Files loop | |
417 | Main_Lib_File := Next_Main_Lib_File; | |
418 | ||
419 | if Verbose_Mode then | |
420 | if Check_Only then | |
421 | Write_Str ("Checking: "); | |
422 | else | |
423 | Write_Str ("Binding: "); | |
424 | end if; | |
425 | ||
426 | Write_Name (Main_Lib_File); | |
427 | Write_Eol; | |
428 | end if; | |
429 | ||
430 | Text := Read_Library_Info (Main_Lib_File, True); | |
9dfe12ae | 431 | |
432 | declare | |
433 | Id : ALI_Id; | |
434 | pragma Warnings (Off, Id); | |
435 | ||
436 | begin | |
437 | Id := Scan_ALI | |
438 | (F => Main_Lib_File, | |
439 | T => Text, | |
440 | Ignore_ED => Force_RM_Elaboration_Order, | |
441 | Err => False); | |
442 | end; | |
443 | ||
83cce46b | 444 | Free (Text); |
445 | end loop; | |
446 | ||
9dfe12ae | 447 | -- No_Run_Time mode |
448 | ||
449 | if No_Run_Time_Mode then | |
450 | ||
451 | -- Set standard restrictions | |
452 | ||
453 | Restrictions_On_Target (No_Finalization) := True; | |
454 | Restrictions_On_Target (No_Exception_Handlers) := True; | |
455 | Restrictions_On_Target (No_Tasking) := True; | |
456 | Restriction_Parameters_On_Target (Max_Tasks) := Uint_0; | |
457 | ||
458 | -- Set standard configuration parameters | |
459 | ||
460 | Suppress_Standard_Library_On_Target := True; | |
461 | Configurable_Run_Time_Mode := True; | |
462 | end if; | |
463 | ||
464 | -- For main ALI files, even if they are interfaces, we get their | |
465 | -- dependencies. To be sure, we reset the Interface flag for all main | |
466 | -- ALI files. | |
467 | ||
468 | for Index in ALIs.First .. ALIs.Last loop | |
469 | ALIs.Table (Index).Interface := False; | |
470 | end loop; | |
471 | ||
83cce46b | 472 | -- Add System.Standard_Library to list to ensure that these files are |
473 | -- included in the bind, even if not directly referenced from Ada code | |
9dfe12ae | 474 | -- This is suppressed if the configurable run-time requests it. |
83cce46b | 475 | |
9dfe12ae | 476 | if not Suppress_Standard_Library_On_Target then |
83cce46b | 477 | Name_Buffer (1 .. 12) := "s-stalib.ali"; |
478 | Name_Len := 12; | |
479 | Std_Lib_File := Name_Find; | |
480 | Text := Read_Library_Info (Std_Lib_File, True); | |
9dfe12ae | 481 | |
482 | declare | |
483 | Id : ALI_Id; | |
484 | pragma Warnings (Off, Id); | |
485 | ||
486 | begin | |
487 | Id := | |
488 | Scan_ALI | |
489 | (F => Std_Lib_File, | |
490 | T => Text, | |
491 | Ignore_ED => Force_RM_Elaboration_Order, | |
492 | Err => False); | |
493 | end; | |
494 | ||
83cce46b | 495 | Free (Text); |
496 | end if; | |
497 | ||
498 | -- Acquire all information in ALI files that have been read in | |
499 | ||
500 | for Index in ALIs.First .. ALIs.Last loop | |
501 | Read_ALI (Index); | |
502 | end loop; | |
503 | ||
86f5f2af | 504 | -- Warn if -f switch used |
83cce46b | 505 | |
86f5f2af | 506 | if Force_RM_Elaboration_Order then |
507 | Error_Msg | |
508 | ("?-f is obsolescent and should not be used"); | |
509 | Error_Msg | |
510 | ("?may result in missing run-time elaboration checks"); | |
511 | Error_Msg | |
512 | ("?use -gnatE, pragma Suppress (Elaboration_Checks) instead"); | |
83cce46b | 513 | end if; |
514 | ||
515 | -- Quit if some file needs compiling | |
516 | ||
517 | if No_Object_Specified then | |
518 | raise Unrecoverable_Error; | |
519 | end if; | |
520 | ||
521 | -- Build source file table from the ALI files we have read in | |
522 | ||
523 | Set_Source_Table; | |
524 | ||
525 | -- Check that main library file is a suitable main program | |
526 | ||
527 | if Bind_Main_Program | |
528 | and then ALIs.Table (ALIs.First).Main_Program = None | |
529 | and then not No_Main_Subprogram | |
530 | then | |
531 | Error_Msg_Name_1 := Main_Lib_File; | |
532 | Error_Msg ("% does not contain a unit that can be a main program"); | |
533 | end if; | |
534 | ||
535 | -- Perform consistency and correctness checks | |
536 | ||
537 | Check_Duplicated_Subunits; | |
538 | Check_Versions; | |
539 | Check_Consistency; | |
540 | Check_Configuration_Consistency; | |
541 | ||
9dfe12ae | 542 | -- Acquire restrictions and add them to target restrictions. After |
543 | -- this loop, Restrictions_On_Target entries will be set True for | |
544 | -- all partition-wide restrictions specified in the partition. | |
545 | ||
546 | for J in Partition_Restrictions loop | |
547 | if Restrictions (J) = 'r' then | |
548 | Restrictions_On_Target (J) := True; | |
549 | end if; | |
550 | end loop; | |
551 | ||
83cce46b | 552 | -- Complete bind if no errors |
553 | ||
554 | if Errors_Detected = 0 then | |
555 | Find_Elab_Order; | |
556 | ||
557 | if Errors_Detected = 0 then | |
558 | if Elab_Order_Output then | |
559 | Write_Eol; | |
560 | Write_Str ("ELABORATION ORDER"); | |
561 | Write_Eol; | |
562 | ||
563 | for J in Elab_Order.First .. Elab_Order.Last loop | |
9dfe12ae | 564 | if not Units.Table (Elab_Order.Table (J)).Interface then |
565 | Write_Str (" "); | |
566 | Write_Unit_Name | |
567 | (Units.Table (Elab_Order.Table (J)).Uname); | |
568 | Write_Eol; | |
569 | end if; | |
83cce46b | 570 | end loop; |
571 | ||
572 | Write_Eol; | |
573 | end if; | |
574 | ||
575 | if not Check_Only then | |
576 | Gen_Output_File (Output_File_Name.all); | |
577 | end if; | |
578 | end if; | |
579 | end if; | |
580 | ||
581 | Total_Errors := Total_Errors + Errors_Detected; | |
582 | Total_Warnings := Total_Warnings + Warnings_Detected; | |
583 | ||
584 | exception | |
585 | when Unrecoverable_Error => | |
586 | Total_Errors := Total_Errors + Errors_Detected; | |
587 | Total_Warnings := Total_Warnings + Warnings_Detected; | |
588 | end; | |
589 | ||
590 | -- All done. Set proper exit status. | |
591 | ||
592 | Finalize_Binderr; | |
593 | Namet.Finalize; | |
594 | ||
595 | if Total_Errors > 0 then | |
596 | Exit_Program (E_Errors); | |
597 | elsif Total_Warnings > 0 then | |
598 | Exit_Program (E_Warnings); | |
599 | else | |
600 | Exit_Program (E_Success); | |
601 | end if; | |
602 | ||
603 | end Gnatbind; |