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-.
  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 not Is_Cross_Compiler then
 368                Write_Line
 369                  ("gnatbind: -M not expected to be used on native platforms");
 370             end if;
 371
 372             Opt.Bind_Alternate_Main_Name := True;
 373             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 374
 375          --  All other options are single character and are handled by
 376          --  Scan_Binder_Switches.
 377
 378          else
 379             Scan_Binder_Switches (Argv);
 380          end if;
 381
 382       --  Not a switch, so must be a file name (if non-empty)
 383
 384       elsif Argv'Length /= 0 then
 385          if Argv'Length > 4
 386            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 387          then
 388             Add_File (Argv);
 389          else
 390             Add_File (Argv & ".ali");
 391          end if;
 392       end if;
 393    end Scan_Bind_Arg;
 394
 395 --  Start of processing for Gnatbind
 396
 397 begin
 398
 399    --  Set default for Shared_Libgnat option
 400
 401    declare
 402       Shared_Libgnat_Default : Character;
 403       pragma Import
 404         (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
 405
 406       SHARED : constant Character := 'H';
 407       STATIC : constant Character := 'T';
 408
 409    begin
 410       pragma Assert
 411         (Shared_Libgnat_Default = SHARED
 412          or else
 413         Shared_Libgnat_Default = STATIC);
 414       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 415    end;
 416
 417    --  Use low level argument routines to avoid dragging in the secondary stack
 418
 419    Next_Arg := 1;
 420    Scan_Args : while Next_Arg < Arg_Count loop
 421       declare
 422          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 423
 424       begin
 425          Fill_Arg (Next_Argv'Address, Next_Arg);
 426          Scan_Bind_Arg (Next_Argv);
 427       end;
 428       Next_Arg := Next_Arg + 1;
 429    end loop Scan_Args;
 430
 431    if Use_Pragma_Linker_Constructor then
 432       if Bind_Main_Program then
 433          Fail ("switch -a must be used in conjunction with -n or -Lxxx");
 434
 435       elsif not Gnatbind_Supports_Auto_Init then
 436          Fail ("automatic initialisation of elaboration " &
 437                "not supported on this platform");
 438       end if;
 439    end if;
 440
 441    --  Test for trailing -o switch
 442
 443    if Opt.Output_File_Name_Present
 444      and then not Output_File_Name_Seen
 445    then
 446       Fail ("output file name missing after -o");
 447    end if;
 448
 449    --  Output usage if requested
 450
 451    if Usage_Requested then
 452       Bindusg;
 453    end if;
 454
 455    --  Check that the Ada binder file specified has extension .adb and that
 456    --  the C binder file has extension .c
 457
 458    if Opt.Output_File_Name_Present
 459      and then Output_File_Name_Seen
 460    then
 461       Check_Extensions : declare
 462          Length : constant Natural := Output_File_Name'Length;
 463          Last   : constant Natural := Output_File_Name'Last;
 464
 465       begin
 466          if Ada_Bind_File then
 467             if Length <= 4
 468               or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 469             then
 470                Fail ("output file name should have .adb extension");
 471             end if;
 472
 473          else
 474             if Length <= 2
 475               or else Output_File_Name (Last - 1 .. Last) /= ".c"
 476             then
 477                Fail ("output file name should have .c extension");
 478             end if;
 479          end if;
 480       end Check_Extensions;
 481    end if;
 482
 483    Osint.Add_Default_Search_Dirs;
 484
 485    --  Carry out package initializations. These are initializations which
 486    --  might logically be performed at elaboration time, but Namet at least
 487    --  can't be done that way (because it is used in the Compiler), and we
 488    --  decide to be consistent. Like elaboration, the order in which these
 489    --  calls are made is in some cases important.
 490
 491    Csets.Initialize;
 492    Namet.Initialize;
 493    Snames.Initialize;
 494
 495    --  Acquire target parameters
 496
 497    Targparm.Get_Target_Parameters;
 498
 499    --  Initialize Cumulative_Restrictions with the restrictions on the target
 500    --  scanned from the system.ads file. Then as we read ALI files, we will
 501    --  accumulate additional restrictions specified in other files.
 502
 503    Cumulative_Restrictions := Targparm.Restrictions_On_Target;
 504
 505    --  On OpenVMS, when -L is used, all external names used in pragmas Export
 506    --  are in upper case. The reason is that on OpenVMS, the macro-assembler
 507    --  MACASM-32, used to build Stand-Alone Libraries, only understands
 508    --  uppercase.
 509
 510    if L_Switch_Seen and then OpenVMS_On_Target then
 511       To_Upper (Opt.Ada_Init_Name.all);
 512       To_Upper (Opt.Ada_Final_Name.all);
 513       To_Upper (Opt.Ada_Main_Name.all);
 514    end if;
 515
 516    --  Acquire configurable run-time mode
 517
 518    if Configurable_Run_Time_On_Target then
 519       Configurable_Run_Time_Mode := True;
 520    end if;
 521
 522    --  Output copyright notice if in verbose mode
 523
 524    if Verbose_Mode then
 525       Write_Eol;
 526       Write_Str ("GNATBIND ");
 527       Write_Str (Gnat_Version_String);
 528       Write_Eol;
 529       Write_Str ("Copyright 1995-" &
 530                  Current_Year &
 531                  ", Free Software Foundation, Inc.");
 532       Write_Eol;
 533    end if;
 534
 535    --  Output usage information if no files
 536
 537    if not More_Lib_Files then
 538       Bindusg;
 539       Exit_Program (E_Fatal);
 540    end if;
 541
 542    --  If a mapping file was specified, initialize the file mapping
 543
 544    if Mapping_File /= null then
 545       Fmap.Initialize (Mapping_File.all);
 546    end if;
 547
 548    --  The block here is to catch the Unrecoverable_Error exception in the
 549    --  case where we exceed the maximum number of permissible errors or some
 550    --  other unrecoverable error occurs.
 551
 552    begin
 553       --  Initialize binder packages
 554
 555       Initialize_Binderr;
 556       Initialize_ALI;
 557       Initialize_ALI_Source;
 558
 559       if Verbose_Mode then
 560          Write_Eol;
 561       end if;
 562
 563       --  Input ALI files
 564
 565       while More_Lib_Files loop
 566          Main_Lib_File := Next_Main_Lib_File;
 567
 568          if Verbose_Mode then
 569             if Check_Only then
 570                Write_Str ("Checking: ");
 571             else
 572                Write_Str ("Binding: ");
 573             end if;
 574
 575             Write_Name (Main_Lib_File);
 576             Write_Eol;
 577          end if;
 578
 579          Text := Read_Library_Info (Main_Lib_File, True);
 580
 581          declare
 582             Id : ALI_Id;
 583             pragma Warnings (Off, Id);
 584
 585          begin
 586             Id := Scan_ALI
 587                     (F             => Main_Lib_File,
 588                      T             => Text,
 589                      Ignore_ED     => False,
 590                      Err           => False,
 591                      Ignore_Errors => Debug_Flag_I);
 592          end;
 593
 594          Free (Text);
 595       end loop;
 596
 597       --  No_Run_Time mode
 598
 599       if No_Run_Time_Mode then
 600
 601          --  Set standard configuration parameters
 602
 603          Suppress_Standard_Library_On_Target            := True;
 604          Configurable_Run_Time_Mode                     := True;
 605       end if;
 606
 607       --  For main ALI files, even if they are interfaces, we get their
 608       --  dependencies. To be sure, we reset the Interface flag for all main
 609       --  ALI files.
 610
 611       for Index in ALIs.First .. ALIs.Last loop
 612          ALIs.Table (Index).SAL_Interface := False;
 613       end loop;
 614
 615       --  Add System.Standard_Library to list to ensure that these files are
 616       --  included in the bind, even if not directly referenced from Ada code
 617       --  This is suppressed if the appropriate targparm switch is set.
 618
 619       if not Suppress_Standard_Library_On_Target then
 620          Name_Buffer (1 .. 12) := "s-stalib.ali";
 621          Name_Len := 12;
 622          Std_Lib_File := Name_Find;
 623          Text := Read_Library_Info (Std_Lib_File, True);
 624
 625          declare
 626             Id : ALI_Id;
 627             pragma Warnings (Off, Id);
 628
 629          begin
 630             Id :=
 631               Scan_ALI
 632                 (F             => Std_Lib_File,
 633                  T             => Text,
 634                  Ignore_ED     => False,
 635                  Err           => False,
 636                  Ignore_Errors => Debug_Flag_I);
 637          end;
 638
 639          Free (Text);
 640       end if;
 641
 642       --  Acquire all information in ALI files that have been read in
 643
 644       for Index in ALIs.First .. ALIs.Last loop
 645          Read_ALI (Index);
 646       end loop;
 647
 648       --  Quit if some file needs compiling
 649
 650       if No_Object_Specified then
 651          raise Unrecoverable_Error;
 652       end if;
 653
 654       --  Build source file table from the ALI files we have read in
 655
 656       Set_Source_Table;
 657
 658       --  Check that main library file is a suitable main program
 659
 660       if Bind_Main_Program
 661         and then ALIs.Table (ALIs.First).Main_Program = None
 662         and then not No_Main_Subprogram
 663       then
 664          Error_Msg_Name_1 := Main_Lib_File;
 665          Error_Msg ("% does not contain a unit that can be a main program");
 666       end if;
 667
 668       --  Perform consistency and correctness checks
 669
 670       Check_Duplicated_Subunits;
 671       Check_Versions;
 672       Check_Consistency;
 673       Check_Configuration_Consistency;
 674
 675       --  List restrictions that could be applied to this partition
 676
 677       if List_Restrictions then
 678          List_Applicable_Restrictions;
 679       end if;
 680
 681       --  Complete bind if no errors
 682
 683       if Errors_Detected = 0 then
 684          Find_Elab_Order;
 685
 686          if Errors_Detected = 0 then
 687             if Elab_Order_Output then
 688                Write_Eol;
 689                Write_Str ("ELABORATION ORDER");
 690                Write_Eol;
 691
 692                for J in Elab_Order.First .. Elab_Order.Last loop
 693                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 694                      Write_Str ("   ");
 695                      Write_Unit_Name
 696                        (Units.Table (Elab_Order.Table (J)).Uname);
 697                      Write_Eol;
 698                   end if;
 699                end loop;
 700
 701                Write_Eol;
 702             end if;
 703
 704             if not Check_Only then
 705                Gen_Output_File (Output_File_Name.all);
 706             end if;
 707          end if;
 708       end if;
 709
 710       Total_Errors := Total_Errors + Errors_Detected;
 711       Total_Warnings := Total_Warnings + Warnings_Detected;
 712
 713    exception
 714       when Unrecoverable_Error =>
 715          Total_Errors := Total_Errors + Errors_Detected;
 716          Total_Warnings := Total_Warnings + Warnings_Detected;
 717    end;
 718
 719    --  All done. Set proper exit status
 720
 721    Finalize_Binderr;
 722    Namet.Finalize;
 723
 724    if Total_Errors > 0 then
 725       Exit_Program (E_Errors);
 726
 727    elsif Total_Warnings > 0 then
 728       Exit_Program (E_Warnings);
 729
 730    else
 731       --  Do not call Exit_Program (E_Success), so that finalization occurs
 732       --  normally.
 733
 734       null;
 735    end if;
 736
 737 end Gnatbind;