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