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-2005, 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-.
  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    begin
 210       --  Now scan arguments that are specific to the binder and are not
 211       --  handled by the common circuitry in Switch.
 212
 213       if Opt.Output_File_Name_Present
 214         and then not Output_File_Name_Seen
 215       then
 216          Output_File_Name_Seen := True;
 217
 218          if Argv'Length = 0
 219            or else (Argv'Length >= 1 and then Argv (1) = '-')
 220          then
 221             Fail ("output File_Name missing after -o");
 222
 223          else
 224             Output_File_Name := new String'(Argv);
 225          end if;
 226
 227       elsif Argv'Length >= 2 and then Argv (1) = '-' then
 228
 229          --  -I-
 230
 231          if Argv (2 .. Argv'Last) = "I-" then
 232             Opt.Look_In_Primary_Dir := False;
 233
 234          --  -Idir
 235
 236          elsif Argv (2) = 'I' then
 237             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
 238             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
 239
 240          --  -Ldir
 241
 242          elsif Argv (2) = 'L' then
 243             if Argv'Length >= 3 then
 244
 245                --  Remember that the -L switch was specified, so that if this
 246                --  is on OpenVMS, the export names are put in uppercase.
 247                --  This is not known before the target parameters are read.
 248
 249                L_Switch_Seen := True;
 250
 251                Opt.Bind_For_Library := True;
 252                Opt.Ada_Init_Name :=
 253                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
 254                Opt.Ada_Final_Name :=
 255                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
 256                Opt.Ada_Main_Name :=
 257                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
 258
 259                --  This option (-Lxxx) implies -n
 260
 261                Opt.Bind_Main_Program := False;
 262
 263             else
 264                Fail
 265                  ("Prefix of initialization and finalization " &
 266                   "procedure names missing in -L");
 267             end if;
 268
 269          --  -Sin -Slo -Shi -Sxx
 270
 271          elsif Argv'Length = 4
 272            and then Argv (2) = 'S'
 273          then
 274             declare
 275                C1 : Character := Argv (3);
 276                C2 : Character := Argv (4);
 277
 278             begin
 279                --  Fold to upper case
 280
 281                if C1 in 'a' .. 'z' then
 282                   C1 := Character'Val (Character'Pos (C1) - 32);
 283                end if;
 284
 285                if C2 in 'a' .. 'z' then
 286                   C2 := Character'Val (Character'Pos (C2) - 32);
 287                end if;
 288
 289                --  Test valid option and set mode accordingly
 290
 291                if C1 = 'E' and then C2 = 'V' then
 292                   null;
 293
 294                elsif C1 = 'I' and then C2 = 'N' then
 295                   null;
 296
 297                elsif C1 = 'L' and then C2 = 'O' then
 298                   null;
 299
 300                elsif C1 = 'H' and then C2 = 'I' then
 301                   null;
 302
 303                elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
 304                        and then
 305                      (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
 306                then
 307                   null;
 308
 309                --  Invalid -S switch, let Switch give error, set defalut of IN
 310
 311                else
 312                   Scan_Binder_Switches (Argv);
 313                   C1 := 'I';
 314                   C2 := 'N';
 315                end if;
 316
 317                Initialize_Scalars_Mode1 := C1;
 318                Initialize_Scalars_Mode2 := C2;
 319             end;
 320
 321          --  -aIdir
 322
 323          elsif Argv'Length >= 3
 324            and then Argv (2 .. 3) = "aI"
 325          then
 326             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
 327
 328          --  -aOdir
 329
 330          elsif Argv'Length >= 3
 331            and then Argv (2 .. 3) = "aO"
 332          then
 333             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
 334
 335          --  -nostdlib
 336
 337          elsif Argv (2 .. Argv'Last) = "nostdlib" then
 338             Opt.No_Stdlib := True;
 339
 340          --  -nostdinc
 341
 342          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 343             Opt.No_Stdinc := True;
 344
 345          --  -static
 346
 347          elsif Argv (2 .. Argv'Last) = "static" then
 348             Opt.Shared_Libgnat := False;
 349
 350          --  -shared
 351
 352          elsif Argv (2 .. Argv'Last) = "shared" then
 353             Opt.Shared_Libgnat := True;
 354
 355          --  -F=mapping_file
 356
 357          elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
 358             if Mapping_File /= null then
 359                Fail ("cannot specify several mapping files");
 360             end if;
 361
 362             Mapping_File := new String'(Argv (4 .. Argv'Last));
 363
 364          --  -Mname
 365
 366          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 367             if Is_Cross_Compiler then
 368                Opt.Bind_Alternate_Main_Name := True;
 369                Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 370             else
 371                Fail ("-M option only valid for a cross-compiler");
 372             end if;
 373
 374          --  All other options are single character and are handled by
 375          --  Scan_Binder_Switches.
 376
 377          else
 378             Scan_Binder_Switches (Argv);
 379          end if;
 380
 381       --  Not a switch, so must be a file name (if non-empty)
 382
 383       elsif Argv'Length /= 0 then
 384          if Argv'Length > 4
 385            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 386          then
 387             Add_File (Argv);
 388          else
 389             Add_File (Argv & ".ali");
 390          end if;
 391       end if;
 392    end Scan_Bind_Arg;
 393
 394 --  Start of processing for Gnatbind
 395
 396 begin
 397
 398    --  Set default for Shared_Libgnat option
 399
 400    declare
 401       Shared_Libgnat_Default : Character;
 402       pragma Import
 403         (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
 404
 405       SHARED : constant Character := 'H';
 406       STATIC : constant Character := 'T';
 407
 408    begin
 409       pragma Assert
 410         (Shared_Libgnat_Default = SHARED
 411          or else
 412         Shared_Libgnat_Default = STATIC);
 413       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 414    end;
 415
 416    --  Use low level argument routines to avoid dragging in the secondary stack
 417
 418    Next_Arg := 1;
 419    Scan_Args : while Next_Arg < Arg_Count loop
 420       declare
 421          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 422
 423       begin
 424          Fill_Arg (Next_Argv'Address, Next_Arg);
 425          Scan_Bind_Arg (Next_Argv);
 426       end;
 427       Next_Arg := Next_Arg + 1;
 428    end loop Scan_Args;
 429
 430    if Use_Pragma_Linker_Constructor then
 431       if Bind_Main_Program then
 432          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
 433
 434       elsif not Gnatbind_Supports_Auto_Init then
 435          Fail ("automatic initialisation of elaboration " &
 436                "not supported on this platform");
 437       end if;
 438    end if;
 439
 440    --  Test for trailing -o switch
 441
 442    if Opt.Output_File_Name_Present
 443      and then not Output_File_Name_Seen
 444    then
 445       Fail ("output file name missing after -o");
 446    end if;
 447
 448    --  Output usage if requested
 449
 450    if Usage_Requested then
 451       Bindusg;
 452    end if;
 453
 454    --  Check that the Ada binder file specified has extension .adb and that
 455    --  the C binder file has extension .c
 456
 457    if Opt.Output_File_Name_Present
 458      and then Output_File_Name_Seen
 459    then
 460       Check_Extensions : declare
 461          Length : constant Natural := Output_File_Name'Length;
 462          Last   : constant Natural := Output_File_Name'Last;
 463
 464       begin
 465          if Ada_Bind_File then
 466             if Length <= 4
 467               or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 468             then
 469                Fail ("output file name should have .adb extension");
 470             end if;
 471
 472          else
 473             if Length <= 2
 474               or else Output_File_Name (Last - 1 .. Last) /= ".c"
 475             then
 476                Fail ("output file name should have .c extension");
 477             end if;
 478          end if;
 479       end Check_Extensions;
 480    end if;
 481
 482    Osint.Add_Default_Search_Dirs;
 483
 484    --  Carry out package initializations. These are initializations which
 485    --  might logically be performed at elaboration time, but Namet at least
 486    --  can't be done that way (because it is used in the Compiler), and we
 487    --  decide to be consistent. Like elaboration, the order in which these
 488    --  calls are made is in some cases important.
 489
 490    Csets.Initialize;
 491    Namet.Initialize;
 492    Snames.Initialize;
 493
 494    --  Acquire target parameters
 495
 496    Targparm.Get_Target_Parameters;
 497
 498    --  Initialize Cumulative_Restrictions with the restrictions on the target
 499    --  scanned from the system.ads file. Then as we read ALI files, we will
 500    --  accumulate additional restrictions specified in other files.
 501
 502    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 503
 504    --  On OpenVMS, when -L is used, all external names used in pragmas Export
 505    --  are in upper case. The reason is that on OpenVMS, the macro-assembler
 506    --  MACASM-32, used to build Stand-Alone Libraries, only understands
 507    --  uppercase.
 508
 509    if L_Switch_Seen and then OpenVMS_On_Target then
 510       To_Upper (Opt.Ada_Init_Name.all);
 511       To_Upper (Opt.Ada_Final_Name.all);
 512       To_Upper (Opt.Ada_Main_Name.all);
 513    end if;
 514
 515    --  Acquire configurable run-time mode
 516
 517    if Configurable_Run_Time_On_Target then
 518       Configurable_Run_Time_Mode := True;
 519    end if;
 520
 521    --  Output copyright notice if in verbose mode
 522
 523    if Verbose_Mode then
 524       Write_Eol;
 525       Write_Str ("GNATBIND ");
 526       Write_Str (Gnat_Version_String);
 527       Write_Eol;
 528       Write_Str ("Copyright 1995-2005 Free Software Foundation, Inc.");
 529       Write_Eol;
 530    end if;
 531
 532    --  Output usage information if no files
 533
 534    if not More_Lib_Files then
 535       Bindusg;
 536       Exit_Program (E_Fatal);
 537    end if;
 538
 539    --  If a mapping file was specified, initialize the file mapping
 540
 541    if Mapping_File /= null then
 542       Fmap.Initialize (Mapping_File.all);
 543    end if;
 544
 545    --  The block here is to catch the Unrecoverable_Error exception in the
 546    --  case where we exceed the maximum number of permissible errors or some
 547    --  other unrecoverable error occurs.
 548
 549    begin
 550       --  Initialize binder packages
 551
 552       Initialize_Binderr;
 553       Initialize_ALI;
 554       Initialize_ALI_Source;
 555
 556       if Verbose_Mode then
 557          Write_Eol;
 558       end if;
 559
 560       --  Input ALI files
 561
 562       while More_Lib_Files loop
 563          Main_Lib_File := Next_Main_Lib_File;
 564
 565          if Verbose_Mode then
 566             if Check_Only then
 567                Write_Str ("Checking: ");
 568             else
 569                Write_Str ("Binding: ");
 570             end if;
 571
 572             Write_Name (Main_Lib_File);
 573             Write_Eol;
 574          end if;
 575
 576          Text := Read_Library_Info (Main_Lib_File, True);
 577
 578          declare
 579             Id : ALI_Id;
 580             pragma Warnings (Off, Id);
 581
 582          begin
 583             Id := Scan_ALI
 584                     (F             => Main_Lib_File,
 585                      T             => Text,
 586                      Ignore_ED     => False,
 587                      Err           => False,
 588                      Ignore_Errors => Debug_Flag_I);
 589          end;
 590
 591          Free (Text);
 592       end loop;
 593
 594       --  No_Run_Time mode
 595
 596       if No_Run_Time_Mode then
 597
 598          --  Set standard configuration parameters
 599
 600          Suppress_Standard_Library_On_Target            := True;
 601          Configurable_Run_Time_Mode                     := True;
 602       end if;
 603
 604       --  For main ALI files, even if they are interfaces, we get their
 605       --  dependencies. To be sure, we reset the Interface flag for all main
 606       --  ALI files.
 607
 608       for Index in ALIs.First .. ALIs.Last loop
 609          ALIs.Table (Index).SAL_Interface := False;
 610       end loop;
 611
 612       --  Add System.Standard_Library to list to ensure that these files are
 613       --  included in the bind, even if not directly referenced from Ada code
 614       --  This is suppressed if the appropriate targparm switch is set.
 615
 616       if not Suppress_Standard_Library_On_Target then
 617          Name_Buffer (1 .. 12) := "s-stalib.ali";
 618          Name_Len := 12;
 619          Std_Lib_File := Name_Find;
 620          Text := Read_Library_Info (Std_Lib_File, True);
 621
 622          declare
 623             Id : ALI_Id;
 624             pragma Warnings (Off, Id);
 625
 626          begin
 627             Id :=
 628               Scan_ALI
 629                 (F             => Std_Lib_File,
 630                  T             => Text,
 631                  Ignore_ED     => False,
 632                  Err           => False,
 633                  Ignore_Errors => Debug_Flag_I);
 634          end;
 635
 636          Free (Text);
 637       end if;
 638
 639       --  Acquire all information in ALI files that have been read in
 640
 641       for Index in ALIs.First .. ALIs.Last loop
 642          Read_ALI (Index);
 643       end loop;
 644
 645       --  Quit if some file needs compiling
 646
 647       if No_Object_Specified then
 648          raise Unrecoverable_Error;
 649       end if;
 650
 651       --  Build source file table from the ALI files we have read in
 652
 653       Set_Source_Table;
 654
 655       --  Check that main library file is a suitable main program
 656
 657       if Bind_Main_Program
 658         and then ALIs.Table (ALIs.First).Main_Program = None
 659         and then not No_Main_Subprogram
 660       then
 661          Error_Msg_Name_1 := Main_Lib_File;
 662          Error_Msg ("% does not contain a unit that can be a main program");
 663       end if;
 664
 665       --  Perform consistency and correctness checks
 666
 667       Check_Duplicated_Subunits;
 668       Check_Versions;
 669       Check_Consistency;
 670       Check_Configuration_Consistency;
 671
 672       --  List restrictions that could be applied to this partition
 673
 674       if List_Restrictions then
 675          List_Applicable_Restrictions;
 676       end if;
 677
 678       --  Complete bind if no errors
 679
 680       if Errors_Detected = 0 then
 681          Find_Elab_Order;
 682
 683          if Errors_Detected = 0 then
 684             if Elab_Order_Output then
 685                Write_Eol;
 686                Write_Str ("ELABORATION ORDER");
 687                Write_Eol;
 688
 689                for J in Elab_Order.First .. Elab_Order.Last loop
 690                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 691                      Write_Str ("   ");
 692                      Write_Unit_Name
 693                        (Units.Table (Elab_Order.Table (J)).Uname);
 694                      Write_Eol;
 695                   end if;
 696                end loop;
 697
 698                Write_Eol;
 699             end if;
 700
 701             if not Check_Only then
 702                Gen_Output_File (Output_File_Name.all);
 703             end if;
 704          end if;
 705       end if;
 706
 707       Total_Errors := Total_Errors + Errors_Detected;
 708       Total_Warnings := Total_Warnings + Warnings_Detected;
 709
 710    exception
 711       when Unrecoverable_Error =>
 712          Total_Errors := Total_Errors + Errors_Detected;
 713          Total_Warnings := Total_Warnings + Warnings_Detected;
 714    end;
 715
 716    --  All done. Set proper exit status
 717
 718    Finalize_Binderr;
 719    Namet.Finalize;
 720
 721    if Total_Errors > 0 then
 722       Exit_Program (E_Errors);
 723    elsif Total_Warnings > 0 then
 724       Exit_Program (E_Warnings);
 725    else
 726       Exit_Program (E_Success);
 727    end if;
 728
 729 end Gnatbind;