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