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