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