]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/gnatbind.adb
c++: Handle multiple aggregate overloads [PR95319].
[thirdparty/gcc.git] / gcc / ada / gnatbind.adb
CommitLineData
38cbfe40
RK
1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- G N A T B I N D --
6-- --
7-- B o d y --
38cbfe40 8-- --
1d005acc 9-- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
38cbfe40
RK
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- --
38cbfe40
RK
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. --
38cbfe40
RK
20-- --
21-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc 22-- Extensive contributions were provided by Ada Core Technologies Inc. --
38cbfe40
RK
23-- --
24------------------------------------------------------------------------------
25
26with ALI; use ALI;
27with ALI.Util; use ALI.Util;
28with Bcheck; use Bcheck;
38cbfe40
RK
29with Binderr; use Binderr;
30with Bindgen; use Bindgen;
69e6ee2f 31with Bindo; use Bindo;
38cbfe40 32with Bindusg;
6e937c1c 33with Casing; use Casing;
38cbfe40 34with Csets;
2e071734 35with Debug; use Debug;
fbf5a39b 36with Fmap;
38cbfe40
RK
37with Namet; use Namet;
38with Opt; use Opt;
a316b3fc 39
38cbfe40 40with Osint; use Osint;
a316b3fc
AC
41-- Note that we use low-level routines in Osint to read command-line
42-- arguments. We cannot depend on Ada.Command_Line, because it contains modern
43-- Ada features that would break bootstrapping with old base compilers.
44
07fc65c4 45with Osint.B; use Osint.B;
38cbfe40 46with Output; use Output;
fbf5a39b 47with Rident; use Rident;
5453d5bd 48with Snames;
38cbfe40 49with Switch; use Switch;
07fc65c4
GB
50with Switch.B; use Switch.B;
51with Targparm; use Targparm;
38cbfe40 52with Types; use Types;
fbf5a39b
AC
53
54with System.Case_Util; use System.Case_Util;
a316b3fc 55with System.Response_File;
47eb2d8d
VC
56with System.OS_Lib; use System.OS_Lib;
57
38cbfe40
RK
58procedure Gnatbind is
59
60 Total_Errors : Nat := 0;
61 -- Counts total errors in all files
62
63 Total_Warnings : Nat := 0;
64 -- Total warnings in all files
65
66 Main_Lib_File : File_Name_Type;
67 -- Current main library file
68
22630237
VC
69 First_Main_Lib_File : File_Name_Type := No_File;
70 -- The first library file, that should be a main subprogram if neither -n
71 -- nor -z are used.
72
582dbb53 73 Text : Text_Buffer_Ptr;
38cbfe40
RK
74
75 Output_File_Name_Seen : Boolean := False;
fbf5a39b 76 Output_File_Name : String_Ptr := new String'("");
38cbfe40 77
6e937c1c
AC
78 Mapping_File : String_Ptr := null;
79
2f8d7dfe 80 procedure Add_Artificial_ALI_File (Name : String);
20250fb8 81 -- Artificially add ALI file Name in the closure
2f8d7dfe 82
b87520cd 83 function Gnatbind_Supports_Auto_Init return Boolean;
354ae449
AC
84 -- Indicates if automatic initialization of elaboration procedure through
85 -- the constructor mechanism is possible on the platform.
86
87 function Is_Cross_Compiler return Boolean;
88 -- Returns True iff this is a cross-compiler
b87520cd 89
6e937c1c
AC
90 procedure List_Applicable_Restrictions;
91 -- List restrictions that apply to this partition if option taken
38cbfe40
RK
92
93 procedure Scan_Bind_Arg (Argv : String);
94 -- Scan and process binder specific arguments. Argv is a single argument.
95 -- All the one character arguments are still handled by Switch. This
bfc8aa81 96 -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
38cbfe40 97
b546e2a7
AC
98 generic
99 with procedure Action (Argv : String);
100 procedure Generic_Scan_Bind_Args;
101 -- Iterate through the args calling Action on each one, taking care of
102 -- response files.
103
104 procedure Write_Arg (S : String);
105 -- Passed to Generic_Scan_Bind_Args to print args
106
2f8d7dfe
AC
107 -----------------------------
108 -- Add_Artificial_ALI_File --
109 -----------------------------
110
111 procedure Add_Artificial_ALI_File (Name : String) is
112 Id : ALI_Id;
113 pragma Warnings (Off, Id);
20250fb8 114
582dbb53
AC
115 Std_Lib_File : File_Name_Type;
116 -- Standard library
117
2f8d7dfe
AC
118 begin
119 Name_Len := Name'Length;
120 Name_Buffer (1 .. Name_Len) := Name;
121 Std_Lib_File := Name_Find;
122 Text := Read_Library_Info (Std_Lib_File, True);
123
124 Id :=
125 Scan_ALI
126 (F => Std_Lib_File,
127 T => Text,
128 Ignore_ED => False,
129 Err => False,
130 Ignore_Errors => Debug_Flag_I);
131
132 Free (Text);
133 end Add_Artificial_ALI_File;
134
b87520cd
VC
135 ---------------------------------
136 -- Gnatbind_Supports_Auto_Init --
137 ---------------------------------
138
139 function Gnatbind_Supports_Auto_Init return Boolean is
140 function gnat_binder_supports_auto_init return Integer;
141 pragma Import (C, gnat_binder_supports_auto_init,
142 "__gnat_binder_supports_auto_init");
354ae449 143
b87520cd
VC
144 begin
145 return gnat_binder_supports_auto_init /= 0;
146 end Gnatbind_Supports_Auto_Init;
147
0bce6c77
PO
148 -----------------------
149 -- Is_Cross_Compiler --
150 -----------------------
151
152 function Is_Cross_Compiler return Boolean is
153 Cross_Compiler : Integer;
154 pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
354ae449 155
0bce6c77
PO
156 begin
157 return Cross_Compiler = 1;
158 end Is_Cross_Compiler;
159
6e937c1c
AC
160 ----------------------------------
161 -- List_Applicable_Restrictions --
162 ----------------------------------
163
164 procedure List_Applicable_Restrictions is
165
166 -- Define those restrictions that should be output if the gnatbind
167 -- -r switch is used. Not all restrictions are output for the reasons
baa3441d 168 -- given below in the list, and this array is used to test whether
6e937c1c 169 -- the corresponding pragma should be listed. True means that it
b77c24b8 170 -- should be listed.
6e937c1c 171
b77c24b8
BD
172 Restrictions_To_List : constant array (All_Restrictions) of Boolean :=
173 (No_Standard_Allocators_After_Elaboration => False,
87003b28
RD
174 -- This involves run-time conditions not checkable at compile time
175
b77c24b8 176 No_Anonymous_Allocators => False,
87003b28
RD
177 -- Premature, since we have not implemented this yet
178
b77c24b8 179 No_Exception_Propagation => False,
baa3441d
RD
180 -- Modifies code resulting in different exception semantics
181
b77c24b8 182 No_Exceptions => False,
6e937c1c
AC
183 -- Has unexpected Suppress (All_Checks) effect
184
b77c24b8 185 No_Implicit_Conditionals => False,
6e937c1c
AC
186 -- This could modify and pessimize generated code
187
b77c24b8 188 No_Implicit_Dynamic_Code => False,
6e937c1c
AC
189 -- This could modify and pessimize generated code
190
b77c24b8 191 No_Implicit_Loops => False,
6e937c1c
AC
192 -- This could modify and pessimize generated code
193
b77c24b8 194 No_Recursion => False,
6e937c1c
AC
195 -- Not checkable at compile time
196
b77c24b8 197 No_Reentrancy => False,
6e937c1c
AC
198 -- Not checkable at compile time
199
b77c24b8 200 Max_Entry_Queue_Length => False,
6e937c1c
AC
201 -- Not checkable at compile time
202
b77c24b8 203 Max_Storage_At_Blocking => False,
6e937c1c
AC
204 -- Not checkable at compile time
205
b77c24b8
BD
206 No_Implementation_Restrictions => False,
207 -- Listing this one would cause a chicken&egg problem; the program
208 -- doesn't use implementation-defined restrictions, but after
209 -- applying the listed restrictions, it probably WILL use them,
210 -- so No_Implementation_Restrictions will cause an error.
211
beaa97ab
AC
212 -- The following three should not be partition-wide, so the
213 -- following tests are junk to be removed eventually ???
214
b77c24b8 215 No_Specification_Of_Aspect => False,
ce532f42
AC
216 -- Requires a parameter value, not a count
217
b77c24b8 218 No_Use_Of_Attribute => False,
ce532f42
AC
219 -- Requires a parameter value, not a count
220
b77c24b8 221 No_Use_Of_Pragma => False,
ce532f42
AC
222 -- Requires a parameter value, not a count
223
b77c24b8 224 others => True);
6e937c1c
AC
225
226 Additional_Restrictions_Listed : Boolean := False;
227 -- Set True if we have listed header for restrictions
228
4dcfaf77
RD
229 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
230 -- Returns True if the given restriction can be listed as an additional
231 -- restriction that could be set.
6e937c1c 232
4dcfaf77
RD
233 ------------------------------
234 -- Restriction_Could_Be_Set --
235 ------------------------------
236
237 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
238 CR : Restrictions_Info renames Cumulative_Restrictions;
239
240 begin
241 case R is
242
243 -- Boolean restriction
244
245 when All_Boolean_Restrictions =>
246
247 -- The condition for listing a boolean restriction as an
248 -- additional restriction that could be set is that it is
249 -- not violated by any unit, and not already set.
250
251 return CR.Violated (R) = False and then CR.Set (R) = False;
252
253 -- Parameter restriction
254
255 when All_Parameter_Restrictions =>
256
257 -- If the restriction is violated and the level of violation is
258 -- unknown, the restriction can definitely not be listed.
259
260 if CR.Violated (R) and then CR.Unknown (R) then
261 return False;
6e937c1c 262
4dcfaf77 263 -- We can list the restriction if it is not set
6e937c1c 264
4dcfaf77
RD
265 elsif not CR.Set (R) then
266 return True;
6e937c1c 267
4dcfaf77
RD
268 -- We can list the restriction if is set to a greater value
269 -- than the maximum value known for the violation.
6e937c1c 270
4dcfaf77
RD
271 else
272 return CR.Value (R) > CR.Count (R);
6e937c1c
AC
273 end if;
274
4dcfaf77
RD
275 -- No other values for R possible
276
277 when others =>
278 raise Program_Error;
4dcfaf77
RD
279 end case;
280 end Restriction_Could_Be_Set;
281
282 -- Start of processing for List_Applicable_Restrictions
283
284 begin
285 -- Loop through restrictions
286
287 for R in All_Restrictions loop
b77c24b8 288 if Restrictions_To_List (R)
354ae449 289 and then Restriction_Could_Be_Set (R)
4dcfaf77
RD
290 then
291 if not Additional_Restrictions_Listed then
6e937c1c 292 Write_Eol;
4dcfaf77 293 Write_Line
b77c24b8
BD
294 ("-- The following additional restrictions may be applied "
295 & "to this partition:");
4dcfaf77 296 Additional_Restrictions_Listed := True;
6e937c1c 297 end if;
4dcfaf77
RD
298
299 Write_Str ("pragma Restrictions (");
300
301 declare
302 S : constant String := Restriction_Id'Image (R);
354ae449 303
4dcfaf77
RD
304 begin
305 Name_Len := S'Length;
306 Name_Buffer (1 .. Name_Len) := S;
307 end;
308
309 Set_Casing (Mixed_Case);
310 Write_Str (Name_Buffer (1 .. Name_Len));
311
312 if R in All_Parameter_Restrictions then
313 Write_Str (" => ");
314 Write_Int (Int (Cumulative_Restrictions.Count (R)));
315 end if;
316
317 Write_Str (");");
318 Write_Eol;
6e937c1c
AC
319 end if;
320 end loop;
321 end List_Applicable_Restrictions;
322
38cbfe40
RK
323 -------------------
324 -- Scan_Bind_Arg --
325 -------------------
326
327 procedure Scan_Bind_Arg (Argv : String) is
bfc8aa81
RD
328 pragma Assert (Argv'First = 1);
329
38cbfe40
RK
330 begin
331 -- Now scan arguments that are specific to the binder and are not
332 -- handled by the common circuitry in Switch.
333
334 if Opt.Output_File_Name_Present
335 and then not Output_File_Name_Seen
336 then
337 Output_File_Name_Seen := True;
338
3ec54569 339 if Argv'Length = 0 or else Argv (1) = '-' then
38cbfe40
RK
340 Fail ("output File_Name missing after -o");
341
342 else
343 Output_File_Name := new String'(Argv);
344 end if;
345
07fc65c4
GB
346 elsif Argv'Length >= 2 and then Argv (1) = '-' then
347
38cbfe40
RK
348 -- -I-
349
350 if Argv (2 .. Argv'Last) = "I-" then
351 Opt.Look_In_Primary_Dir := False;
352
353 -- -Idir
354
355 elsif Argv (2) = 'I' then
356 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
357 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
358
359 -- -Ldir
360
361 elsif Argv (2) = 'L' then
362 if Argv'Length >= 3 then
fbf5a39b 363
38cbfe40
RK
364 Opt.Bind_For_Library := True;
365 Opt.Ada_Init_Name :=
366 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
367 Opt.Ada_Final_Name :=
368 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
369 Opt.Ada_Main_Name :=
370 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
371
372 -- This option (-Lxxx) implies -n
373
374 Opt.Bind_Main_Program := False;
fbf5a39b 375
38cbfe40
RK
376 else
377 Fail
354ae449
AC
378 ("Prefix of initialization and finalization procedure names "
379 & "missing in -L");
38cbfe40
RK
380 end if;
381
baa3441d 382 -- -Sin -Slo -Shi -Sxx -Sev
38cbfe40
RK
383
384 elsif Argv'Length = 4
385 and then Argv (2) = 'S'
386 then
387 declare
388 C1 : Character := Argv (3);
389 C2 : Character := Argv (4);
390
391 begin
fbf5a39b
AC
392 -- Fold to upper case
393
38cbfe40
RK
394 if C1 in 'a' .. 'z' then
395 C1 := Character'Val (Character'Pos (C1) - 32);
396 end if;
397
398 if C2 in 'a' .. 'z' then
399 C2 := Character'Val (Character'Pos (C2) - 32);
400 end if;
401
fbf5a39b
AC
402 -- Test valid option and set mode accordingly
403
404 if C1 = 'E' and then C2 = 'V' then
405 null;
406
407 elsif C1 = 'I' and then C2 = 'N' then
408 null;
38cbfe40
RK
409
410 elsif C1 = 'L' and then C2 = 'O' then
fbf5a39b 411 null;
38cbfe40
RK
412
413 elsif C1 = 'H' and then C2 = 'I' then
fbf5a39b 414 null;
38cbfe40
RK
415
416 elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
417 and then
418 (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
419 then
fbf5a39b 420 null;
38cbfe40 421
dec55d76 422 -- Invalid -S switch, let Switch give error, set default of IN
38cbfe40
RK
423
424 else
425 Scan_Binder_Switches (Argv);
fbf5a39b
AC
426 C1 := 'I';
427 C2 := 'N';
38cbfe40 428 end if;
fbf5a39b
AC
429
430 Initialize_Scalars_Mode1 := C1;
431 Initialize_Scalars_Mode2 := C2;
38cbfe40
RK
432 end;
433
434 -- -aIdir
435
436 elsif Argv'Length >= 3
437 and then Argv (2 .. 3) = "aI"
438 then
439 Add_Src_Search_Dir (Argv (4 .. Argv'Last));
440
441 -- -aOdir
442
443 elsif Argv'Length >= 3
444 and then Argv (2 .. 3) = "aO"
445 then
446 Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
447
448 -- -nostdlib
449
450 elsif Argv (2 .. Argv'Last) = "nostdlib" then
451 Opt.No_Stdlib := True;
452
453 -- -nostdinc
454
455 elsif Argv (2 .. Argv'Last) = "nostdinc" then
456 Opt.No_Stdinc := True;
457
458 -- -static
459
460 elsif Argv (2 .. Argv'Last) = "static" then
461 Opt.Shared_Libgnat := False;
462
463 -- -shared
464
465 elsif Argv (2 .. Argv'Last) = "shared" then
466 Opt.Shared_Libgnat := True;
467
fbf5a39b
AC
468 -- -F=mapping_file
469
470 elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
471 if Mapping_File /= null then
472 Fail ("cannot specify several mapping files");
473 end if;
474
475 Mapping_File := new String'(Argv (4 .. Argv'Last));
476
be04e8ed
PB
477 -- -minimal
478
479 elsif Argv (2 .. Argv'Last) = "minimal" then
480 if not Is_Cross_Compiler then
481 Write_Line
482 ("gnatbind: -minimal not expected to be used on native " &
483 "platforms");
484 end if;
485
486 Opt.Minimal_Binder := True;
487
38cbfe40
RK
488 -- -Mname
489
490 elsif Argv'Length >= 3 and then Argv (2) = 'M' then
6d566287
AC
491 if not Is_Cross_Compiler then
492 Write_Line
493 ("gnatbind: -M not expected to be used on native platforms");
0bce6c77 494 end if;
38cbfe40 495
6d566287
AC
496 Opt.Bind_Alternate_Main_Name := True;
497 Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
498
82c80734
RD
499 -- All other options are single character and are handled by
500 -- Scan_Binder_Switches.
38cbfe40
RK
501
502 else
503 Scan_Binder_Switches (Argv);
504 end if;
505
506 -- Not a switch, so must be a file name (if non-empty)
507
508 elsif Argv'Length /= 0 then
509 if Argv'Length > 4
510 and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
511 then
07fc65c4 512 Add_File (Argv);
38cbfe40 513 else
07fc65c4 514 Add_File (Argv & ".ali");
38cbfe40
RK
515 end if;
516 end if;
517 end Scan_Bind_Arg;
518
b546e2a7
AC
519 ----------------------------
520 -- Generic_Scan_Bind_Args --
521 ----------------------------
522
523 procedure Generic_Scan_Bind_Args is
524 Next_Arg : Positive := 1;
f1c80977 525
b546e2a7 526 begin
b546e2a7
AC
527 while Next_Arg < Arg_Count loop
528 declare
529 Next_Argv : String (1 .. Len_Arg (Next_Arg));
f1c80977 530
b546e2a7
AC
531 begin
532 Fill_Arg (Next_Argv'Address, Next_Arg);
533
534 if Next_Argv'Length > 0 then
535 if Next_Argv (1) = '@' then
536 if Next_Argv'Length > 1 then
537 declare
538 Arguments : constant Argument_List :=
a316b3fc 539 System.Response_File.Arguments_From
7ec25b2b
AC
540 (Response_File_Name =>
541 Next_Argv (2 .. Next_Argv'Last),
542 Recursive => True,
543 Ignore_Non_Existing_Files => True);
b546e2a7
AC
544 begin
545 for J in Arguments'Range loop
546 Action (Arguments (J).all);
547 end loop;
548 end;
549 end if;
550
551 else
552 Action (Next_Argv);
553 end if;
554 end if;
555 end;
556
557 Next_Arg := Next_Arg + 1;
558 end loop;
559 end Generic_Scan_Bind_Args;
560
f1c80977
AC
561 ---------------
562 -- Write_Arg --
563 ---------------
564
b546e2a7
AC
565 procedure Write_Arg (S : String) is
566 begin
567 Write_Str (" " & S);
568 end Write_Arg;
569
6a1cb33a 570 procedure Check_Version_And_Help is
a5fe697b 571 new Check_Version_And_Help_G (Bindusg.Display);
6a1cb33a 572
354ae449
AC
573 procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
574 procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
575
38cbfe40
RK
576-- Start of processing for Gnatbind
577
578begin
38cbfe40
RK
579 -- Set default for Shared_Libgnat option
580
581 declare
582 Shared_Libgnat_Default : Character;
af4b9434
AC
583 pragma Import
584 (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
38cbfe40
RK
585
586 SHARED : constant Character := 'H';
587 STATIC : constant Character := 'T';
588
589 begin
590 pragma Assert
591 (Shared_Libgnat_Default = SHARED
354ae449
AC
592 or else
593 Shared_Libgnat_Default = STATIC);
38cbfe40
RK
594 Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
595 end;
596
3c777b50
AC
597 -- Carry out package initializations. These are initializations which
598 -- might logically be performed at elaboration time, and we decide to be
599 -- consistent. Like elaboration, the order in which these calls are made
600 -- is in some cases important.
601
602 Csets.Initialize;
603 Snames.Initialize;
604
605 -- Scan the switches and arguments. Note that Snames must already be
606 -- initialized (for processing of the -V switch).
41c8951a
VC
607
608 -- First, scan to detect --version and/or --help
609
ac401891 610 Check_Version_And_Help ("GNATBIND", "1992");
41c8951a 611
b546e2a7
AC
612 -- We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether
613 -- to Put_Bind_Args.
47eb2d8d 614
b546e2a7 615 Scan_Bind_Args;
bfc8aa81 616
b546e2a7 617 if Verbose_Mode then
a316b3fc
AC
618 declare
619 Command_Name : String (1 .. Len_Arg (0));
620 begin
621 Fill_Arg (Command_Name'Address, 0);
622 Write_Str (Command_Name);
623 end;
624
b546e2a7
AC
625 Put_Bind_Args;
626 Write_Eol;
627 end if;
38cbfe40 628
b87520cd
VC
629 if Use_Pragma_Linker_Constructor then
630 if Bind_Main_Program then
631 Fail ("switch -a must be used in conjunction with -n or -Lxxx");
632
b87520cd 633 elsif not Gnatbind_Supports_Auto_Init then
354ae449
AC
634 Fail ("automatic initialisation of elaboration not supported on this "
635 & "platform");
b87520cd
VC
636 end if;
637 end if;
638
38cbfe40
RK
639 -- Test for trailing -o switch
640
03a2b9ed 641 if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
38cbfe40
RK
642 Fail ("output file name missing after -o");
643 end if;
644
645 -- Output usage if requested
646
647 if Usage_Requested then
bfc8aa81 648 Bindusg.Display;
38cbfe40
RK
649 end if;
650
3565684a 651 -- Check that the binder file specified has extension .adb
38cbfe40 652
03a2b9ed 653 if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
38cbfe40
RK
654 Check_Extensions : declare
655 Length : constant Natural := Output_File_Name'Length;
656 Last : constant Natural := Output_File_Name'Last;
354ae449 657
38cbfe40 658 begin
a54d0eb4
AC
659 if Length <= 4
660 or else Output_File_Name (Last - 3 .. Last) /= ".adb"
661 then
662 Fail ("output file name should have .adb extension");
38cbfe40
RK
663 end if;
664 end Check_Extensions;
665 end if;
666
667 Osint.Add_Default_Search_Dirs;
668
fbf5a39b
AC
669 -- Acquire target parameters
670
671 Targparm.Get_Target_Parameters;
672
06effe87
AC
673 -- Initialize Cumulative_Restrictions with the restrictions on the target
674 -- scanned from the system.ads file. Then as we read ALI files, we will
675 -- accumulate additional restrictions specified in other files.
676
677 Cumulative_Restrictions := Targparm.Restrictions_On_Target;
678
fbf5a39b
AC
679 -- Acquire configurable run-time mode
680
681 if Configurable_Run_Time_On_Target then
682 Configurable_Run_Time_Mode := True;
683 end if;
684
685 -- Output copyright notice if in verbose mode
686
687 if Verbose_Mode then
688 Write_Eol;
41c8951a 689 Display_Version ("GNATBIND", "1995");
38cbfe40
RK
690 end if;
691
d2d8b2a7 692 -- Output usage information if no arguments
38cbfe40
RK
693
694 if not More_Lib_Files then
a316b3fc 695 if Arg_Count = 0 then
d2d8b2a7
AC
696 Bindusg.Display;
697 else
7b966a95 698 Write_Line ("try ""gnatbind --help"" for more information.");
d2d8b2a7
AC
699 end if;
700
38cbfe40
RK
701 Exit_Program (E_Fatal);
702 end if;
703
fbf5a39b
AC
704 -- If a mapping file was specified, initialize the file mapping
705
706 if Mapping_File /= null then
707 Fmap.Initialize (Mapping_File.all);
708 end if;
709
38cbfe40
RK
710 -- The block here is to catch the Unrecoverable_Error exception in the
711 -- case where we exceed the maximum number of permissible errors or some
712 -- other unrecoverable error occurs.
713
714 begin
fbf5a39b
AC
715 -- Initialize binder packages
716
38cbfe40
RK
717 Initialize_Binderr;
718 Initialize_ALI;
719 Initialize_ALI_Source;
720
721 if Verbose_Mode then
722 Write_Eol;
723 end if;
724
725 -- Input ALI files
726
727 while More_Lib_Files loop
728 Main_Lib_File := Next_Main_Lib_File;
729
22630237
VC
730 if First_Main_Lib_File = No_File then
731 First_Main_Lib_File := Main_Lib_File;
732 end if;
733
38cbfe40
RK
734 if Verbose_Mode then
735 if Check_Only then
736 Write_Str ("Checking: ");
737 else
738 Write_Str ("Binding: ");
739 end if;
740
741 Write_Name (Main_Lib_File);
742 Write_Eol;
743 end if;
744
745 Text := Read_Library_Info (Main_Lib_File, True);
fbf5a39b
AC
746
747 declare
748 Id : ALI_Id;
749 pragma Warnings (Off, Id);
750
751 begin
752 Id := Scan_ALI
5d993afd
VC
753 (F => Main_Lib_File,
754 T => Text,
755 Ignore_ED => False,
756 Err => False,
757 Ignore_Errors => Debug_Flag_I,
758 Directly_Scanned => True);
fbf5a39b
AC
759 end;
760
38cbfe40
RK
761 Free (Text);
762 end loop;
763
fbf5a39b
AC
764 -- No_Run_Time mode
765
766 if No_Run_Time_Mode then
767
fbf5a39b
AC
768 -- Set standard configuration parameters
769
bfc8aa81
RD
770 Suppress_Standard_Library_On_Target := True;
771 Configurable_Run_Time_Mode := True;
fbf5a39b
AC
772 end if;
773
774 -- For main ALI files, even if they are interfaces, we get their
775 -- dependencies. To be sure, we reset the Interface flag for all main
776 -- ALI files.
777
778 for Index in ALIs.First .. ALIs.Last loop
82c80734 779 ALIs.Table (Index).SAL_Interface := False;
fbf5a39b
AC
780 end loop;
781
38cbfe40
RK
782 -- Add System.Standard_Library to list to ensure that these files are
783 -- included in the bind, even if not directly referenced from Ada code
2f8d7dfe 784 -- This is suppressed if the appropriate targparm switch is set. Be sure
582dbb53 785 -- in any case that System is in the closure, as it may contain linker
2f8d7dfe
AC
786 -- options. Note that it will be automatically added if s-stalib is
787 -- added.
38cbfe40 788
fbf5a39b 789 if not Suppress_Standard_Library_On_Target then
2f8d7dfe
AC
790 Add_Artificial_ALI_File ("s-stalib.ali");
791 else
792 Add_Artificial_ALI_File ("system.ali");
38cbfe40
RK
793 end if;
794
12577815 795 -- Load ALIs for all dependent units
38cbfe40
RK
796
797 for Index in ALIs.First .. ALIs.Last loop
6c994759 798 Read_Withed_ALIs (Index);
38cbfe40
RK
799 end loop;
800
38cbfe40
RK
801 -- Quit if some file needs compiling
802
803 if No_Object_Specified then
af3ded08 804 Error_Msg ("no object specified");
38cbfe40
RK
805 raise Unrecoverable_Error;
806 end if;
807
b9696ffb
AC
808 -- Quit with message if we had a GNATprove file
809
810 if GNATprove_Mode_Specified then
811 Error_Msg ("one or more files compiled in GNATprove mode");
812 raise Unrecoverable_Error;
813 end if;
814
12577815
TQ
815 -- Output list of ALI files in closure
816
817 if Output_ALI_List then
3f2ad11d
AC
818 if ALI_List_Filename /= null then
819 Set_List_File (ALI_List_Filename.all);
820 end if;
12577815 821
3f2ad11d
AC
822 for Index in ALIs.First .. ALIs.Last loop
823 declare
824 Full_Afile : constant File_Name_Type :=
825 Find_File (ALIs.Table (Index).Afile, Library);
826 begin
827 Write_Name (Full_Afile);
828 Write_Eol;
829 end;
830 end loop;
831
832 if ALI_List_Filename /= null then
833 Close_List_File;
834 end if;
12577815
TQ
835 end if;
836
38cbfe40
RK
837 -- Build source file table from the ALI files we have read in
838
839 Set_Source_Table;
840
22630237
VC
841 -- If there is main program to bind, set Main_Lib_File to the first
842 -- library file, and the name from which to derive the binder generate
843 -- file to the first ALI file.
844
845 if Bind_Main_Program then
846 Main_Lib_File := First_Main_Lib_File;
847 Set_Current_File_Name_Index (To => 1);
848 end if;
849
38cbfe40
RK
850 -- Check that main library file is a suitable main program
851
852 if Bind_Main_Program
853 and then ALIs.Table (ALIs.First).Main_Program = None
854 and then not No_Main_Subprogram
855 then
f2282a58
AC
856 Get_Name_String
857 (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
858
859 declare
860 Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
861 begin
862 To_Mixed (Unit_Name);
863 Get_Name_String (ALIs.Table (ALIs.First).Sfile);
864 Add_Str_To_Name_Buffer (":1: ");
865 Add_Str_To_Name_Buffer (Unit_Name);
866 Add_Str_To_Name_Buffer (" cannot be used as a main program");
867 Write_Line (Name_Buffer (1 .. Name_Len));
868 Errors_Detected := Errors_Detected + 1;
869 end;
38cbfe40
RK
870 end if;
871
75e4e36d
AC
872 -- Perform consistency and correctness checks. Disable these in CodePeer
873 -- mode where we want to be more flexible.
874
875 if not CodePeer_Mode then
876 Check_Duplicated_Subunits;
877 Check_Versions;
878 Check_Consistency;
879 Check_Configuration_Consistency;
880 end if;
38cbfe40 881
6e937c1c 882 -- List restrictions that could be applied to this partition
fbf5a39b 883
6e937c1c
AC
884 if List_Restrictions then
885 List_Applicable_Restrictions;
886 end if;
fbf5a39b 887
38cbfe40
RK
888 -- Complete bind if no errors
889
890 if Errors_Detected = 0 then
354ae449 891 declare
354ae449 892 use Unit_Id_Tables;
69e6ee2f 893 Elab_Order : Unit_Id_Table;
47eb2d8d 894
354ae449 895 begin
9795b203 896 Find_Elaboration_Order (Elab_Order, First_Main_Lib_File);
47eb2d8d 897
354ae449
AC
898 if Errors_Detected = 0 and then not Check_Only then
899 Gen_Output_File
900 (Output_File_Name.all,
901 Elab_Order => Elab_Order.Table (First .. Last (Elab_Order)));
47eb2d8d 902 end if;
354ae449 903 end;
38cbfe40
RK
904 end if;
905
69e6ee2f 906 Total_Errors := Total_Errors + Errors_Detected;
38cbfe40
RK
907 Total_Warnings := Total_Warnings + Warnings_Detected;
908
909 exception
910 when Unrecoverable_Error =>
69e6ee2f 911 Total_Errors := Total_Errors + Errors_Detected;
38cbfe40
RK
912 Total_Warnings := Total_Warnings + Warnings_Detected;
913 end;
914
354ae449 915 -- All done. Set the proper exit status.
38cbfe40
RK
916
917 Finalize_Binderr;
918 Namet.Finalize;
919
920 if Total_Errors > 0 then
921 Exit_Program (E_Errors);
6d566287 922
38cbfe40
RK
923 elsif Total_Warnings > 0 then
924 Exit_Program (E_Warnings);
6d566287 925
38cbfe40 926 else
6d566287
AC
927 -- Do not call Exit_Program (E_Success), so that finalization occurs
928 -- normally.
929
930 null;
38cbfe40 931 end if;
38cbfe40 932end Gnatbind;