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 --                            $Revision: 1.2 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with ALI;      use ALI;
  30 with ALI.Util; use ALI.Util;
  31 with Bcheck;   use Bcheck;
  32 with Binde;    use Binde;
  33 with Binderr;  use Binderr;
  34 with Bindgen;  use Bindgen;
  35 with Bindusg;
  36 with Butil;    use Butil;
  37 with Csets;
  38 with Gnatvsn;  use Gnatvsn;
  39 with Namet;    use Namet;
  40 with Opt;      use Opt;
  41 with Osint;    use Osint;
  42 with Output;   use Output;
  43 with Switch;   use Switch;
  44 with Types;    use Types;
  45
  46 procedure Gnatbind is
  47
  48    Total_Errors : Nat := 0;
  49    --  Counts total errors in all files
  50
  51    Total_Warnings : Nat := 0;
  52    --  Total warnings in all files
  53
  54    Main_Lib_File : File_Name_Type;
  55    --  Current main library file
  56
  57    Std_Lib_File : File_Name_Type;
  58    --  Standard library
  59
  60    Text : Text_Buffer_Ptr;
  61    Id   : ALI_Id;
  62
  63    Next_Arg : Positive;
  64
  65    Output_File_Name_Seen : Boolean := False;
  66
  67    Output_File_Name : String_Ptr := new String'("");
  68
  69    procedure Scan_Bind_Arg (Argv : String);
  70    --  Scan and process binder specific arguments. Argv is a single argument.
  71    --  All the one character arguments are still handled by Switch. This
  72    --  routine handles -aO -aI and -I-.
  73
  74    -------------------
  75    -- Scan_Bind_Arg --
  76    -------------------
  77
  78    procedure Scan_Bind_Arg (Argv : String) is
  79    begin
  80       --  Now scan arguments that are specific to the binder and are not
  81       --  handled by the common circuitry in Switch.
  82
  83       if Opt.Output_File_Name_Present
  84         and then not Output_File_Name_Seen
  85       then
  86          Output_File_Name_Seen := True;
  87
  88          if Argv'Length = 0
  89            or else (Argv'Length >= 1
  90                      and then (Argv (1) = Switch_Character
  91                                 or else Argv (1) = '-'))
  92          then
  93             Fail ("output File_Name missing after -o");
  94
  95          else
  96             Output_File_Name := new String'(Argv);
  97          end if;
  98
  99       elsif Argv'Length >= 2
 100         and then (Argv (1) = Switch_Character
 101                    or else Argv (1) = '-')
 102       then
 103          --  -I-
 104
 105          if Argv (2 .. Argv'Last) = "I-" then
 106             Opt.Look_In_Primary_Dir := False;
 107
 108          --  -Idir
 109
 110          elsif Argv (2) = 'I' then
 111             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
 112             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
 113
 114          --  -Ldir
 115
 116          elsif Argv (2) = 'L' then
 117             if Argv'Length >= 3 then
 118                Opt.Bind_For_Library := True;
 119                Opt.Ada_Init_Name :=
 120                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
 121                Opt.Ada_Final_Name :=
 122                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
 123                Opt.Ada_Main_Name :=
 124                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
 125
 126                --  This option (-Lxxx) implies -n
 127
 128                Opt.Bind_Main_Program := False;
 129             else
 130                Fail
 131                  ("Prefix of initialization and finalization " &
 132                   "procedure names missing in -L");
 133             end if;
 134
 135          --  -Sin -Slo -Shi -Sxx
 136
 137          elsif Argv'Length = 4
 138            and then Argv (2) = 'S'
 139          then
 140             declare
 141                C1 : Character := Argv (3);
 142                C2 : Character := Argv (4);
 143
 144             begin
 145                if C1 in 'a' .. 'z' then
 146                   C1 := Character'Val (Character'Pos (C1) - 32);
 147                end if;
 148
 149                if C2 in 'a' .. 'z' then
 150                   C2 := Character'Val (Character'Pos (C2) - 32);
 151                end if;
 152
 153                if C1 = 'I' and then C2 = 'N' then
 154                   Initialize_Scalars_Mode := 'I';
 155
 156                elsif C1 = 'L' and then C2 = 'O' then
 157                   Initialize_Scalars_Mode := 'L';
 158
 159                elsif C1 = 'H' and then C2 = 'I' then
 160                   Initialize_Scalars_Mode := 'H';
 161
 162                elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
 163                        and then
 164                      (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
 165                then
 166                   Initialize_Scalars_Mode := 'X';
 167                   Initialize_Scalars_Val (1) := C1;
 168                   Initialize_Scalars_Val (2) := C2;
 169
 170                --  Invalid -S switch, let Switch give error
 171
 172                else
 173                   Scan_Binder_Switches (Argv);
 174                end if;
 175             end;
 176
 177          --  -aIdir
 178
 179          elsif Argv'Length >= 3
 180            and then Argv (2 .. 3) = "aI"
 181          then
 182             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
 183
 184          --  -aOdir
 185
 186          elsif Argv'Length >= 3
 187            and then Argv (2 .. 3) = "aO"
 188          then
 189             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
 190
 191          --  -nostdlib
 192
 193          elsif Argv (2 .. Argv'Last) = "nostdlib" then
 194             Opt.No_Stdlib := True;
 195
 196          --  -nostdinc
 197
 198          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 199             Opt.No_Stdinc := True;
 200
 201          --  -static
 202
 203          elsif Argv (2 .. Argv'Last) = "static" then
 204             Opt.Shared_Libgnat := False;
 205
 206          --  -shared
 207
 208          elsif Argv (2 .. Argv'Last) = "shared" then
 209             Opt.Shared_Libgnat := True;
 210
 211          --  -Mname
 212
 213          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 214             Opt.Bind_Alternate_Main_Name := True;
 215             Opt.Alternate_Main_Name := new String '(Argv (3 .. Argv'Last));
 216
 217          --  All other options are single character and are handled
 218          --  by Scan_Binder_Switches.
 219
 220          else
 221             Scan_Binder_Switches (Argv);
 222          end if;
 223
 224       --  Not a switch, so must be a file name (if non-empty)
 225
 226       elsif Argv'Length /= 0 then
 227          if Argv'Length > 4
 228            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 229          then
 230             Set_Main_File_Name (Argv);
 231          else
 232             Set_Main_File_Name (Argv & ".ali");
 233          end if;
 234       end if;
 235    end Scan_Bind_Arg;
 236
 237 --  Start of processing for Gnatbind
 238
 239 begin
 240    Osint.Initialize (Binder);
 241
 242    --  Set default for Shared_Libgnat option
 243
 244    declare
 245       Shared_Libgnat_Default : Character;
 246       pragma Import (C, Shared_Libgnat_Default, "shared_libgnat_default");
 247
 248       SHARED : constant Character := 'H';
 249       STATIC : constant Character := 'T';
 250
 251    begin
 252       pragma Assert
 253         (Shared_Libgnat_Default = SHARED
 254          or else
 255         Shared_Libgnat_Default = STATIC);
 256       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 257    end;
 258
 259    --  Use low level argument routines to avoid dragging in the secondary stack
 260
 261    Next_Arg := 1;
 262    Scan_Args : while Next_Arg < Arg_Count loop
 263       declare
 264          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 265
 266       begin
 267          Fill_Arg (Next_Argv'Address, Next_Arg);
 268          Scan_Bind_Arg (Next_Argv);
 269       end;
 270       Next_Arg := Next_Arg + 1;
 271    end loop Scan_Args;
 272
 273    --  Test for trailing -o switch
 274
 275    if Opt.Output_File_Name_Present
 276      and then not Output_File_Name_Seen
 277    then
 278       Fail ("output file name missing after -o");
 279    end if;
 280
 281    --  Output usage if requested
 282
 283    if Usage_Requested then
 284       Bindusg;
 285    end if;
 286
 287    --  Check that the Ada binder file specified has extension .adb and that
 288    --  the C binder file has extension .c
 289
 290    if Opt.Output_File_Name_Present
 291      and then Output_File_Name_Seen
 292    then
 293       Check_Extensions : declare
 294          Length : constant Natural := Output_File_Name'Length;
 295          Last   : constant Natural := Output_File_Name'Last;
 296
 297       begin
 298          if Ada_Bind_File then
 299             if Length <= 4
 300               or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 301             then
 302                Fail ("output file name should have .adb extension");
 303             end if;
 304
 305          else
 306             if Length <= 2
 307               or else Output_File_Name (Last - 1 .. Last) /= ".c"
 308             then
 309                Fail ("output file name should have .c extension");
 310             end if;
 311          end if;
 312       end Check_Extensions;
 313    end if;
 314
 315    Osint.Add_Default_Search_Dirs;
 316
 317    if Verbose_Mode then
 318       Write_Eol;
 319       Write_Str ("GNATBIND ");
 320       Write_Str (Gnat_Version_String);
 321       Write_Str (" Copyright 1995-2001 Free Software Foundation, Inc.");
 322       Write_Eol;
 323    end if;
 324
 325    --  Output usage information if no files
 326
 327    if not More_Lib_Files then
 328       Bindusg;
 329       Exit_Program (E_Fatal);
 330    end if;
 331
 332    --  The block here is to catch the Unrecoverable_Error exception in the
 333    --  case where we exceed the maximum number of permissible errors or some
 334    --  other unrecoverable error occurs.
 335
 336    begin
 337       --  Carry out package initializations. These are initializations which
 338       --  might logically be performed at elaboration time, but Namet at
 339       --  least can't be done that way (because it is used in the Compiler),
 340       --  and we decide to be consistent. Like elaboration, the order in
 341       --  which these calls are made is in some cases important.
 342
 343       Csets.Initialize;
 344       Namet.Initialize;
 345       Initialize_Binderr;
 346       Initialize_ALI;
 347       Initialize_ALI_Source;
 348
 349       if Verbose_Mode then
 350          Write_Eol;
 351       end if;
 352
 353       --  Input ALI files
 354
 355       while More_Lib_Files loop
 356          Main_Lib_File := Next_Main_Lib_File;
 357
 358          if Verbose_Mode then
 359             if Check_Only then
 360                Write_Str ("Checking: ");
 361             else
 362                Write_Str ("Binding: ");
 363             end if;
 364
 365             Write_Name (Main_Lib_File);
 366             Write_Eol;
 367          end if;
 368
 369          Text := Read_Library_Info (Main_Lib_File, True);
 370          Id := Scan_ALI
 371                  (F         => Main_Lib_File,
 372                   T         => Text,
 373                   Ignore_ED => Force_RM_Elaboration_Order,
 374                   Err       => False);
 375          Free (Text);
 376       end loop;
 377
 378       --  Add System.Standard_Library to list to ensure that these files are
 379       --  included in the bind, even if not directly referenced from Ada code
 380       --  This is of course omitted in No_Run_Time mode
 381
 382       if not No_Run_Time_Specified then
 383          Name_Buffer (1 .. 12) := "s-stalib.ali";
 384          Name_Len := 12;
 385          Std_Lib_File := Name_Find;
 386          Text := Read_Library_Info (Std_Lib_File, True);
 387          Id :=
 388            Scan_ALI
 389              (F         => Std_Lib_File,
 390               T         => Text,
 391               Ignore_ED => Force_RM_Elaboration_Order,
 392               Err       => False);
 393          Free (Text);
 394       end if;
 395
 396       --  Acquire all information in ALI files that have been read in
 397
 398       for Index in ALIs.First .. ALIs.Last loop
 399          Read_ALI (Index);
 400       end loop;
 401
 402       --  Warn if -f switch used
 403
 404       if Force_RM_Elaboration_Order then
 405          Error_Msg
 406            ("?-f is obsolescent and should not be used");
 407          Error_Msg
 408            ("?may result in missing run-time elaboration checks");
 409          Error_Msg
 410            ("?use -gnatE, pragma Suppress (Elaboration_Checks) instead");
 411       end if;
 412
 413       --  Quit if some file needs compiling
 414
 415       if No_Object_Specified then
 416          raise Unrecoverable_Error;
 417       end if;
 418
 419       --  Build source file table from the ALI files we have read in
 420
 421       Set_Source_Table;
 422
 423       --  Check that main library file is a suitable main program
 424
 425       if Bind_Main_Program
 426         and then ALIs.Table (ALIs.First).Main_Program = None
 427         and then not No_Main_Subprogram
 428       then
 429          Error_Msg_Name_1 := Main_Lib_File;
 430          Error_Msg ("% does not contain a unit that can be a main program");
 431       end if;
 432
 433       --  Perform consistency and correctness checks
 434
 435       Check_Duplicated_Subunits;
 436       Check_Versions;
 437       Check_Consistency;
 438       Check_Configuration_Consistency;
 439
 440       --  Complete bind if no errors
 441
 442       if Errors_Detected = 0 then
 443          Find_Elab_Order;
 444
 445          if Errors_Detected = 0 then
 446             if Elab_Order_Output then
 447                Write_Eol;
 448                Write_Str ("ELABORATION ORDER");
 449                Write_Eol;
 450
 451                for J in Elab_Order.First .. Elab_Order.Last loop
 452                   Write_Str ("   ");
 453                   Write_Unit_Name (Units.Table (Elab_Order.Table (J)).Uname);
 454                   Write_Eol;
 455                end loop;
 456
 457                Write_Eol;
 458             end if;
 459
 460             if not Check_Only then
 461                Gen_Output_File (Output_File_Name.all);
 462             end if;
 463          end if;
 464       end if;
 465
 466       Total_Errors := Total_Errors + Errors_Detected;
 467       Total_Warnings := Total_Warnings + Warnings_Detected;
 468
 469    exception
 470       when Unrecoverable_Error =>
 471          Total_Errors := Total_Errors + Errors_Detected;
 472          Total_Warnings := Total_Warnings + Warnings_Detected;
 473    end;
 474
 475    --  All done. Set proper exit status.
 476
 477    Finalize_Binderr;
 478    Namet.Finalize;
 479
 480    if Total_Errors > 0 then
 481       Exit_Program (E_Errors);
 482    elsif Total_Warnings > 0 then
 483       Exit_Program (E_Warnings);
 484    else
 485       Exit_Program (E_Success);
 486    end if;
 487
 488 end Gnatbind;