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