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