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