gcc/ada/gnatbind.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             G N A T B I N D                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
  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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  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
  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 Casing;   use Casing;
  36 with Csets;
  37 with Debug;    use Debug;
  38 with Fmap;
  39 with Gnatvsn;  use Gnatvsn;
  40 with Namet;    use Namet;
  41 with Opt;      use Opt;
  42 with Osint;    use Osint;
  43 with Osint.B;  use Osint.B;
  44 with Output;   use Output;
  45 with Rident;   use Rident;
  46 with Snames;
  47 with Switch;   use Switch;
  48 with Switch.B; use Switch.B;
  49 with Targparm; use Targparm;
  50 with Types;    use Types;
  51
  52 with System.Case_Util; use System.Case_Util;
  53
  54 procedure Gnatbind is
  55
  56    Total_Errors : Nat := 0;
  57    --  Counts total errors in all files
  58
  59    Total_Warnings : Nat := 0;
  60    --  Total warnings in all files
  61
  62    Main_Lib_File : File_Name_Type;
  63    --  Current main library file
  64
  65    Std_Lib_File : File_Name_Type;
  66    --  Standard library
  67
  68    Text     : Text_Buffer_Ptr;
  69    Next_Arg : Positive;
  70
  71    Output_File_Name_Seen : Boolean := False;
  72    Output_File_Name      : String_Ptr := new String'("");
  73
  74    L_Switch_Seen : Boolean := False;
  75
  76    Mapping_File : String_Ptr := null;
  77
  78    function Gnatbind_Supports_Auto_Init return Boolean;
  79    --  Indicates if automatic initialization of elaboration procedure
  80    --  through the constructor mechanism is possible on the platform.
  81
  82    procedure List_Applicable_Restrictions;
  83    --  List restrictions that apply to this partition if option taken
  84
  85    procedure Scan_Bind_Arg (Argv : String);
  86    --  Scan and process binder specific arguments. Argv is a single argument.
  87    --  All the one character arguments are still handled by Switch. This
  88    --  routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
  89
  90    function Is_Cross_Compiler return Boolean;
  91    --  Returns True iff this is a cross-compiler
  92
  93    ---------------------------------
  94    -- Gnatbind_Supports_Auto_Init --
  95    ---------------------------------
  96
  97    function Gnatbind_Supports_Auto_Init return Boolean is
  98       function gnat_binder_supports_auto_init return Integer;
  99       pragma Import (C, gnat_binder_supports_auto_init,
 100                      "__gnat_binder_supports_auto_init");
 101    begin
 102       return gnat_binder_supports_auto_init /= 0;
 103    end Gnatbind_Supports_Auto_Init;
 104
 105    -----------------------
 106    -- Is_Cross_Compiler --
 107    -----------------------
 108
 109    function Is_Cross_Compiler return Boolean is
 110       Cross_Compiler : Integer;
 111       pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
 112    begin
 113       return Cross_Compiler = 1;
 114    end Is_Cross_Compiler;
 115
 116    ----------------------------------
 117    -- List_Applicable_Restrictions --
 118    ----------------------------------
 119
 120    procedure List_Applicable_Restrictions is
 121
 122       --  Define those restrictions that should be output if the gnatbind
 123       --  -r switch is used. Not all restrictions are output for the reasons
 124       --  given above in the list, and this array is used to test whether
 125       --  the corresponding pragma should be listed. True means that it
 126       --  should not be listed.
 127
 128       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
 129         (No_Exceptions            => True,
 130          --  Has unexpected Suppress (All_Checks) effect
 131
 132          No_Implicit_Conditionals => True,
 133          --  This could modify and pessimize generated code
 134
 135          No_Implicit_Dynamic_Code => True,
 136          --  This could modify and pessimize generated code
 137
 138          No_Implicit_Loops        => True,
 139          --  This could modify and pessimize generated code
 140
 141          No_Recursion             => True,
 142          --  Not checkable at compile time
 143
 144          No_Reentrancy            => True,
 145          --  Not checkable at compile time
 146
 147          Max_Entry_Queue_Length    => True,
 148          --  Not checkable at compile time
 149
 150          Max_Storage_At_Blocking  => True,
 151          --  Not checkable at compile time
 152
 153          others => False);
 154
 155       Additional_Restrictions_Listed : Boolean := False;
 156       --  Set True if we have listed header for restrictions
 157
 158    begin
 159       --  Loop through restrictions
 160
 161       for R in All_Restrictions loop
 162          if not No_Restriction_List (R) then
 163
 164             --  We list a restriction if it is not violated, or if
 165             --  it is violated but the violation count is exactly known.
 166
 167             if Cumulative_Restrictions.Violated (R) = False
 168               or else (R in All_Parameter_Restrictions
 169                        and then
 170                          Cumulative_Restrictions.Unknown (R) = False)
 171             then
 172                if not Additional_Restrictions_Listed then
 173                   Write_Eol;
 174                   Write_Line
 175                     ("The following additional restrictions may be" &
 176                      " applied to this partition:");
 177                   Additional_Restrictions_Listed := True;
 178                end if;
 179
 180                Write_Str ("pragma Restrictions (");
 181
 182                declare
 183                   S : constant String := Restriction_Id'Image (R);
 184                begin
 185                   Name_Len := S'Length;
 186                   Name_Buffer (1 .. Name_Len) := S;
 187                end;
 188
 189                Set_Casing (Mixed_Case);
 190                Write_Str (Name_Buffer (1 .. Name_Len));
 191
 192                if R in All_Parameter_Restrictions then
 193                   Write_Str (" => ");
 194                   Write_Int (Int (Cumulative_Restrictions.Count (R)));
 195                end if;
 196
 197                Write_Str (");");
 198                Write_Eol;
 199             end if;
 200          end if;
 201       end loop;
 202    end List_Applicable_Restrictions;
 203
 204    -------------------
 205    -- Scan_Bind_Arg --
 206    -------------------
 207
 208    procedure Scan_Bind_Arg (Argv : String) is
 209       pragma Assert (Argv'First = 1);
 210
 211    begin
 212       --  Now scan arguments that are specific to the binder and are not
 213       --  handled by the common circuitry in Switch.
 214
 215       if Opt.Output_File_Name_Present
 216         and then not Output_File_Name_Seen
 217       then
 218          Output_File_Name_Seen := True;
 219
 220          if Argv'Length = 0
 221            or else (Argv'Length >= 1 and then Argv (1) = '-')
 222          then
 223             Fail ("output File_Name missing after -o");
 224
 225          else
 226             Output_File_Name := new String'(Argv);
 227          end if;
 228
 229       elsif Argv'Length >= 2 and then Argv (1) = '-' then
 230
 231          --  -I-
 232
 233          if Argv (2 .. Argv'Last) = "I-" then
 234             Opt.Look_In_Primary_Dir := False;
 235
 236          --  -Idir
 237
 238          elsif Argv (2) = 'I' then
 239             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
 240             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
 241
 242          --  -Ldir
 243
 244          elsif Argv (2) = 'L' then
 245             if Argv'Length >= 3 then
 246
 247                --  Remember that the -L switch was specified, so that if this
 248                --  is on OpenVMS, the export names are put in uppercase.
 249                --  This is not known before the target parameters are read.
 250
 251                L_Switch_Seen := True;
 252
 253                Opt.Bind_For_Library := True;
 254                Opt.Ada_Init_Name :=
 255                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
 256                Opt.Ada_Final_Name :=
 257                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
 258                Opt.Ada_Main_Name :=
 259                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
 260
 261                --  This option (-Lxxx) implies -n
 262
 263                Opt.Bind_Main_Program := False;
 264
 265             else
 266                Fail
 267                  ("Prefix of initialization and finalization " &
 268                   "procedure names missing in -L");
 269             end if;
 270
 271          --  -Sin -Slo -Shi -Sxx
 272
 273          elsif Argv'Length = 4
 274            and then Argv (2) = 'S'
 275          then
 276             declare
 277                C1 : Character := Argv (3);
 278                C2 : Character := Argv (4);
 279
 280             begin
 281                --  Fold to upper case
 282
 283                if C1 in 'a' .. 'z' then
 284                   C1 := Character'Val (Character'Pos (C1) - 32);
 285                end if;
 286
 287                if C2 in 'a' .. 'z' then
 288                   C2 := Character'Val (Character'Pos (C2) - 32);
 289                end if;
 290
 291                --  Test valid option and set mode accordingly
 292
 293                if C1 = 'E' and then C2 = 'V' then
 294                   null;
 295
 296                elsif C1 = 'I' and then C2 = 'N' then
 297                   null;
 298
 299                elsif C1 = 'L' and then C2 = 'O' then
 300                   null;
 301
 302                elsif C1 = 'H' and then C2 = 'I' then
 303                   null;
 304
 305                elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
 306                        and then
 307                      (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
 308                then
 309                   null;
 310
 311                --  Invalid -S switch, let Switch give error, set defalut of IN
 312
 313                else
 314                   Scan_Binder_Switches (Argv);
 315                   C1 := 'I';
 316                   C2 := 'N';
 317                end if;
 318
 319                Initialize_Scalars_Mode1 := C1;
 320                Initialize_Scalars_Mode2 := C2;
 321             end;
 322
 323          --  -aIdir
 324
 325          elsif Argv'Length >= 3
 326            and then Argv (2 .. 3) = "aI"
 327          then
 328             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
 329
 330          --  -aOdir
 331
 332          elsif Argv'Length >= 3
 333            and then Argv (2 .. 3) = "aO"
 334          then
 335             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
 336
 337          --  -nostdlib
 338
 339          elsif Argv (2 .. Argv'Last) = "nostdlib" then
 340             Opt.No_Stdlib := True;
 341
 342          --  -nostdinc
 343
 344          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 345             Opt.No_Stdinc := True;
 346
 347          --  -static
 348
 349          elsif Argv (2 .. Argv'Last) = "static" then
 350             Opt.Shared_Libgnat := False;
 351
 352          --  -shared
 353
 354          elsif Argv (2 .. Argv'Last) = "shared" then
 355             Opt.Shared_Libgnat := True;
 356
 357          --  -F=mapping_file
 358
 359          elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
 360             if Mapping_File /= null then
 361                Fail ("cannot specify several mapping files");
 362             end if;
 363
 364             Mapping_File := new String'(Argv (4 .. Argv'Last));
 365
 366          --  -Mname
 367
 368          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 369             if not Is_Cross_Compiler then
 370                Write_Line
 371                  ("gnatbind: -M not expected to be used on native platforms");
 372             end if;
 373
 374             Opt.Bind_Alternate_Main_Name := True;
 375             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 376
 377          --  All other options are single character and are handled by
 378          --  Scan_Binder_Switches.
 379
 380          else
 381             Scan_Binder_Switches (Argv);
 382          end if;
 383
 384       --  Not a switch, so must be a file name (if non-empty)
 385
 386       elsif Argv'Length /= 0 then
 387          if Argv'Length > 4
 388            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 389          then
 390             Add_File (Argv);
 391          else
 392             Add_File (Argv & ".ali");
 393          end if;
 394       end if;
 395    end Scan_Bind_Arg;
 396
 397 --  Start of processing for Gnatbind
 398
 399 begin
 400
 401    --  Set default for Shared_Libgnat option
 402
 403    declare
 404       Shared_Libgnat_Default : Character;
 405       pragma Import
 406         (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
 407
 408       SHARED : constant Character := 'H';
 409       STATIC : constant Character := 'T';
 410
 411    begin
 412       pragma Assert
 413         (Shared_Libgnat_Default = SHARED
 414          or else
 415         Shared_Libgnat_Default = STATIC);
 416       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 417    end;
 418
 419    --  Use low level argument routines to avoid dragging in the secondary stack
 420
 421    Next_Arg := 1;
 422    Scan_Args : while Next_Arg < Arg_Count loop
 423       declare
 424          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 425       begin
 426          Fill_Arg (Next_Argv'Address, Next_Arg);
 427          Scan_Bind_Arg (Next_Argv);
 428       end;
 429
 430       Next_Arg := Next_Arg + 1;
 431    end loop Scan_Args;
 432
 433    if Use_Pragma_Linker_Constructor then
 434       if Bind_Main_Program then
 435          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
 436
 437       elsif not Gnatbind_Supports_Auto_Init then
 438          Fail ("automatic initialisation of elaboration " &
 439                "not supported on this platform");
 440       end if;
 441    end if;
 442
 443    --  Test for trailing -o switch
 444
 445    if Opt.Output_File_Name_Present
 446      and then not Output_File_Name_Seen
 447    then
 448       Fail ("output file name missing after -o");
 449    end if;
 450
 451    --  Output usage if requested
 452
 453    if Usage_Requested then
 454       Bindusg.Display;
 455    end if;
 456
 457    --  Check that the Ada binder file specified has extension .adb and that
 458    --  the C binder file has extension .c
 459
 460    if Opt.Output_File_Name_Present
 461      and then Output_File_Name_Seen
 462    then
 463       Check_Extensions : declare
 464          Length : constant Natural := Output_File_Name'Length;
 465          Last   : constant Natural := Output_File_Name'Last;
 466
 467       begin
 468          if Ada_Bind_File then
 469             if Length <= 4
 470               or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 471             then
 472                Fail ("output file name should have .adb extension");
 473             end if;
 474
 475          else
 476             if Length <= 2
 477               or else Output_File_Name (Last - 1 .. Last) /= ".c"
 478             then
 479                Fail ("output file name should have .c extension");
 480             end if;
 481          end if;
 482       end Check_Extensions;
 483    end if;
 484
 485    Osint.Add_Default_Search_Dirs;
 486
 487    --  Carry out package initializations. These are initializations which
 488    --  might logically be performed at elaboration time, but Namet at least
 489    --  can't be done that way (because it is used in the Compiler), and we
 490    --  decide to be consistent. Like elaboration, the order in which these
 491    --  calls are made is in some cases important.
 492
 493    Csets.Initialize;
 494    Namet.Initialize;
 495    Snames.Initialize;
 496
 497    --  Acquire target parameters
 498
 499    Targparm.Get_Target_Parameters;
 500
 501    --  Initialize Cumulative_Restrictions with the restrictions on the target
 502    --  scanned from the system.ads file. Then as we read ALI files, we will
 503    --  accumulate additional restrictions specified in other files.
 504
 505    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 506
 507    --  On OpenVMS, when -L is used, all external names used in pragmas Export
 508    --  are in upper case. The reason is that on OpenVMS, the macro-assembler
 509    --  MACASM-32, used to build Stand-Alone Libraries, only understands
 510    --  uppercase.
 511
 512    if L_Switch_Seen and then OpenVMS_On_Target then
 513       To_Upper (Opt.Ada_Init_Name.all);
 514       To_Upper (Opt.Ada_Final_Name.all);
 515       To_Upper (Opt.Ada_Main_Name.all);
 516    end if;
 517
 518    --  Acquire configurable run-time mode
 519
 520    if Configurable_Run_Time_On_Target then
 521       Configurable_Run_Time_Mode := True;
 522    end if;
 523
 524    --  Output copyright notice if in verbose mode
 525
 526    if Verbose_Mode then
 527       Write_Eol;
 528       Write_Str ("GNATBIND ");
 529       Write_Str (Gnat_Version_String);
 530       Write_Eol;
 531       Write_Str ("Copyright 1995-" &
 532                  Current_Year &
 533                  ", Free Software Foundation, Inc.");
 534       Write_Eol;
 535    end if;
 536
 537    --  Output usage information if no files
 538
 539    if not More_Lib_Files then
 540       Bindusg.Display;
 541       Exit_Program (E_Fatal);
 542    end if;
 543
 544    --  If a mapping file was specified, initialize the file mapping
 545
 546    if Mapping_File /= null then
 547       Fmap.Initialize (Mapping_File.all);
 548    end if;
 549
 550    --  The block here is to catch the Unrecoverable_Error exception in the
 551    --  case where we exceed the maximum number of permissible errors or some
 552    --  other unrecoverable error occurs.
 553
 554    begin
 555       --  Initialize binder packages
 556
 557       Initialize_Binderr;
 558       Initialize_ALI;
 559       Initialize_ALI_Source;
 560
 561       if Verbose_Mode then
 562          Write_Eol;
 563       end if;
 564
 565       --  Input ALI files
 566
 567       while More_Lib_Files loop
 568          Main_Lib_File := Next_Main_Lib_File;
 569
 570          if Verbose_Mode then
 571             if Check_Only then
 572                Write_Str ("Checking: ");
 573             else
 574                Write_Str ("Binding: ");
 575             end if;
 576
 577             Write_Name (Main_Lib_File);
 578             Write_Eol;
 579          end if;
 580
 581          Text := Read_Library_Info (Main_Lib_File, True);
 582
 583          declare
 584             Id : ALI_Id;
 585             pragma Warnings (Off, Id);
 586
 587          begin
 588             Id := Scan_ALI
 589                     (F             => Main_Lib_File,
 590                      T             => Text,
 591                      Ignore_ED     => False,
 592                      Err           => False,
 593                      Ignore_Errors => Debug_Flag_I);
 594          end;
 595
 596          Free (Text);
 597       end loop;
 598
 599       --  No_Run_Time mode
 600
 601       if No_Run_Time_Mode then
 602
 603          --  Set standard configuration parameters
 604
 605          Suppress_Standard_Library_On_Target := True;
 606          Configurable_Run_Time_Mode          := True;
 607       end if;
 608
 609       --  For main ALI files, even if they are interfaces, we get their
 610       --  dependencies. To be sure, we reset the Interface flag for all main
 611       --  ALI files.
 612
 613       for Index in ALIs.First .. ALIs.Last loop
 614          ALIs.Table (Index).SAL_Interface := False;
 615       end loop;
 616
 617       --  Add System.Standard_Library to list to ensure that these files are
 618       --  included in the bind, even if not directly referenced from Ada code
 619       --  This is suppressed if the appropriate targparm switch is set.
 620
 621       if not Suppress_Standard_Library_On_Target then
 622          Name_Buffer (1 .. 12) := "s-stalib.ali";
 623          Name_Len := 12;
 624          Std_Lib_File := Name_Find;
 625          Text := Read_Library_Info (Std_Lib_File, True);
 626
 627          declare
 628             Id : ALI_Id;
 629             pragma Warnings (Off, Id);
 630
 631          begin
 632             Id :=
 633               Scan_ALI
 634                 (F             => Std_Lib_File,
 635                  T             => Text,
 636                  Ignore_ED     => False,
 637                  Err           => False,
 638                  Ignore_Errors => Debug_Flag_I);
 639          end;
 640
 641          Free (Text);
 642       end if;
 643
 644       --  Acquire all information in ALI files that have been read in
 645
 646       for Index in ALIs.First .. ALIs.Last loop
 647          Read_ALI (Index);
 648       end loop;
 649
 650       --  Quit if some file needs compiling
 651
 652       if No_Object_Specified then
 653          raise Unrecoverable_Error;
 654       end if;
 655
 656       --  Build source file table from the ALI files we have read in
 657
 658       Set_Source_Table;
 659
 660       --  Check that main library file is a suitable main program
 661
 662       if Bind_Main_Program
 663         and then ALIs.Table (ALIs.First).Main_Program = None
 664         and then not No_Main_Subprogram
 665       then
 666          Error_Msg_Name_1 := Main_Lib_File;
 667          Error_Msg ("% does not contain a unit that can be a main program");
 668       end if;
 669
 670       --  Perform consistency and correctness checks
 671
 672       Check_Duplicated_Subunits;
 673       Check_Versions;
 674       Check_Consistency;
 675       Check_Configuration_Consistency;
 676
 677       --  List restrictions that could be applied to this partition
 678
 679       if List_Restrictions then
 680          List_Applicable_Restrictions;
 681       end if;
 682
 683       --  Complete bind if no errors
 684
 685       if Errors_Detected = 0 then
 686          Find_Elab_Order;
 687
 688          if Errors_Detected = 0 then
 689             if Elab_Order_Output then
 690                Write_Eol;
 691                Write_Str ("ELABORATION ORDER");
 692                Write_Eol;
 693
 694                for J in Elab_Order.First .. Elab_Order.Last loop
 695                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 696                      Write_Str ("   ");
 697                      Write_Unit_Name
 698                        (Units.Table (Elab_Order.Table (J)).Uname);
 699                      Write_Eol;
 700                   end if;
 701                end loop;
 702
 703                Write_Eol;
 704             end if;
 705
 706             if not Check_Only then
 707                Gen_Output_File (Output_File_Name.all);
 708             end if;
 709          end if;
 710       end if;
 711
 712       Total_Errors := Total_Errors + Errors_Detected;
 713       Total_Warnings := Total_Warnings + Warnings_Detected;
 714
 715    exception
 716       when Unrecoverable_Error =>
 717          Total_Errors := Total_Errors + Errors_Detected;
 718          Total_Warnings := Total_Warnings + Warnings_Detected;
 719    end;
 720
 721    --  All done. Set proper exit status
 722
 723    Finalize_Binderr;
 724    Namet.Finalize;
 725
 726    if Total_Errors > 0 then
 727       Exit_Program (E_Errors);
 728
 729    elsif Total_Warnings > 0 then
 730       Exit_Program (E_Warnings);
 731
 732    else
 733       --  Do not call Exit_Program (E_Success), so that finalization occurs
 734       --  normally.
 735
 736       null;
 737    end if;
 738
 739 end Gnatbind;