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