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-2005 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 by
 341          --  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 least
 442    --  can't be done that way (because it is used in the Compiler), and we
 443    --  decide to be consistent. Like elaboration, the order in which these
 444    --  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_Eol;
 484       Write_Str ("Copyright 1995-2005 Free Software Foundation, Inc.");
 485       Write_Eol;
 486    end if;
 487
 488    --  Output usage information if no files
 489
 490    if not More_Lib_Files then
 491       Bindusg;
 492       Exit_Program (E_Fatal);
 493    end if;
 494
 495    --  If a mapping file was specified, initialize the file mapping
 496
 497    if Mapping_File /= null then
 498       Fmap.Initialize (Mapping_File.all);
 499    end if;
 500
 501    --  The block here is to catch the Unrecoverable_Error exception in the
 502    --  case where we exceed the maximum number of permissible errors or some
 503    --  other unrecoverable error occurs.
 504
 505    begin
 506       --  Initialize binder packages
 507
 508       Initialize_Binderr;
 509       Initialize_ALI;
 510       Initialize_ALI_Source;
 511
 512       if Verbose_Mode then
 513          Write_Eol;
 514       end if;
 515
 516       --  Input ALI files
 517
 518       while More_Lib_Files loop
 519          Main_Lib_File := Next_Main_Lib_File;
 520
 521          if Verbose_Mode then
 522             if Check_Only then
 523                Write_Str ("Checking: ");
 524             else
 525                Write_Str ("Binding: ");
 526             end if;
 527
 528             Write_Name (Main_Lib_File);
 529             Write_Eol;
 530          end if;
 531
 532          Text := Read_Library_Info (Main_Lib_File, True);
 533
 534          declare
 535             Id : ALI_Id;
 536             pragma Warnings (Off, Id);
 537
 538          begin
 539             Id := Scan_ALI
 540                     (F             => Main_Lib_File,
 541                      T             => Text,
 542                      Ignore_ED     => Force_RM_Elaboration_Order,
 543                      Err           => False,
 544                      Ignore_Errors => Debug_Flag_I);
 545          end;
 546
 547          Free (Text);
 548       end loop;
 549
 550       --  No_Run_Time mode
 551
 552       if No_Run_Time_Mode then
 553
 554          --  Set standard configuration parameters
 555
 556          Suppress_Standard_Library_On_Target            := True;
 557          Configurable_Run_Time_Mode                     := True;
 558       end if;
 559
 560       --  For main ALI files, even if they are interfaces, we get their
 561       --  dependencies. To be sure, we reset the Interface flag for all main
 562       --  ALI files.
 563
 564       for Index in ALIs.First .. ALIs.Last loop
 565          ALIs.Table (Index).SAL_Interface := False;
 566       end loop;
 567
 568       --  Add System.Standard_Library to list to ensure that these files are
 569       --  included in the bind, even if not directly referenced from Ada code
 570       --  This is suppressed if the appropriate targparm switch is set.
 571
 572       if not Suppress_Standard_Library_On_Target then
 573          Name_Buffer (1 .. 12) := "s-stalib.ali";
 574          Name_Len := 12;
 575          Std_Lib_File := Name_Find;
 576          Text := Read_Library_Info (Std_Lib_File, True);
 577
 578          declare
 579             Id : ALI_Id;
 580             pragma Warnings (Off, Id);
 581
 582          begin
 583             Id :=
 584               Scan_ALI
 585                 (F             => Std_Lib_File,
 586                  T             => Text,
 587                  Ignore_ED     => Force_RM_Elaboration_Order,
 588                  Err           => False,
 589                  Ignore_Errors => Debug_Flag_I);
 590          end;
 591
 592          Free (Text);
 593       end if;
 594
 595       --  Acquire all information in ALI files that have been read in
 596
 597       for Index in ALIs.First .. ALIs.Last loop
 598          Read_ALI (Index);
 599       end loop;
 600
 601       --  Warn if -f switch used
 602
 603       if Force_RM_Elaboration_Order then
 604          Error_Msg
 605            ("?-f is obsolescent and should not be used");
 606          Error_Msg
 607            ("?may result in missing run-time elaboration checks");
 608          Error_Msg
 609            ("?use -gnatE, pragma Suppress (Elaboration_Check) instead");
 610       end if;
 611
 612       --  Quit if some file needs compiling
 613
 614       if No_Object_Specified then
 615          raise Unrecoverable_Error;
 616       end if;
 617
 618       --  Build source file table from the ALI files we have read in
 619
 620       Set_Source_Table;
 621
 622       --  Check that main library file is a suitable main program
 623
 624       if Bind_Main_Program
 625         and then ALIs.Table (ALIs.First).Main_Program = None
 626         and then not No_Main_Subprogram
 627       then
 628          Error_Msg_Name_1 := Main_Lib_File;
 629          Error_Msg ("% does not contain a unit that can be a main program");
 630       end if;
 631
 632       --  Perform consistency and correctness checks
 633
 634       Check_Duplicated_Subunits;
 635       Check_Versions;
 636       Check_Consistency;
 637       Check_Configuration_Consistency;
 638
 639       --  List restrictions that could be applied to this partition
 640
 641       if List_Restrictions then
 642          List_Applicable_Restrictions;
 643       end if;
 644
 645       --  Complete bind if no errors
 646
 647       if Errors_Detected = 0 then
 648          Find_Elab_Order;
 649
 650          if Errors_Detected = 0 then
 651             if Elab_Order_Output then
 652                Write_Eol;
 653                Write_Str ("ELABORATION ORDER");
 654                Write_Eol;
 655
 656                for J in Elab_Order.First .. Elab_Order.Last loop
 657                   if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
 658                      Write_Str ("   ");
 659                      Write_Unit_Name
 660                        (Units.Table (Elab_Order.Table (J)).Uname);
 661                      Write_Eol;
 662                   end if;
 663                end loop;
 664
 665                Write_Eol;
 666             end if;
 667
 668             if not Check_Only then
 669                Gen_Output_File (Output_File_Name.all);
 670             end if;
 671          end if;
 672       end if;
 673
 674       Total_Errors := Total_Errors + Errors_Detected;
 675       Total_Warnings := Total_Warnings + Warnings_Detected;
 676
 677    exception
 678       when Unrecoverable_Error =>
 679          Total_Errors := Total_Errors + Errors_Detected;
 680          Total_Warnings := Total_Warnings + Warnings_Detected;
 681    end;
 682
 683    --  All done. Set proper exit status
 684
 685    Finalize_Binderr;
 686    Namet.Finalize;
 687
 688    if Total_Errors > 0 then
 689       Exit_Program (E_Errors);
 690    elsif Total_Warnings > 0 then
 691       Exit_Program (E_Warnings);
 692    else
 693       Exit_Program (E_Success);
 694    end if;
 695
 696 end Gnatbind;