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-2003 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 Fmap;
  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 Rident;   use Rident;
  44 with Switch;   use Switch;
  45 with Switch.B; use Switch.B;
  46 with Targparm; use Targparm;
  47 with Types;    use Types;
  48 with Uintp;    use Uintp;
  49
  50 with System.Case_Util; use System.Case_Util;
  51
  52 procedure Gnatbind is
  53
  54    Total_Errors : Nat := 0;
  55    --  Counts total errors in all files
  56
  57    Total_Warnings : Nat := 0;
  58    --  Total warnings in all files
  59
  60    Main_Lib_File : File_Name_Type;
  61    --  Current main library file
  62
  63    Std_Lib_File : File_Name_Type;
  64    --  Standard library
  65
  66    Text     : Text_Buffer_Ptr;
  67    Next_Arg : Positive;
  68
  69    Output_File_Name_Seen : Boolean := False;
  70    Output_File_Name      : String_Ptr := new String'("");
  71
  72    L_Switch_Seen         : Boolean := False;
  73
  74    Mapping_File          : String_Ptr := null;
  75
  76    procedure Scan_Bind_Arg (Argv : String);
  77    --  Scan and process binder specific arguments. Argv is a single argument.
  78    --  All the one character arguments are still handled by Switch. This
  79    --  routine handles -aO -aI and -I-.
  80
  81    -------------------
  82    -- Scan_Bind_Arg --
  83    -------------------
  84
  85    procedure Scan_Bind_Arg (Argv : String) is
  86    begin
  87       --  Now scan arguments that are specific to the binder and are not
  88       --  handled by the common circuitry in Switch.
  89
  90       if Opt.Output_File_Name_Present
  91         and then not Output_File_Name_Seen
  92       then
  93          Output_File_Name_Seen := True;
  94
  95          if Argv'Length = 0
  96            or else (Argv'Length >= 1 and then Argv (1) = '-')
  97          then
  98             Fail ("output File_Name missing after -o");
  99
 100          else
 101             Output_File_Name := new String'(Argv);
 102          end if;
 103
 104       elsif Argv'Length >= 2 and then Argv (1) = '-' then
 105
 106          --  -I-
 107
 108          if Argv (2 .. Argv'Last) = "I-" then
 109             Opt.Look_In_Primary_Dir := False;
 110
 111          --  -Idir
 112
 113          elsif Argv (2) = 'I' then
 114             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
 115             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
 116
 117          --  -Ldir
 118
 119          elsif Argv (2) = 'L' then
 120             if Argv'Length >= 3 then
 121
 122                --  Remember that the -L switch was specified, so that if this
 123                --  is on OpenVMS, the export names are put in uppercase.
 124                --  This is not known before the target parameters are read.
 125
 126                L_Switch_Seen := True;
 127
 128                Opt.Bind_For_Library := True;
 129                Opt.Ada_Init_Name :=
 130                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
 131                Opt.Ada_Final_Name :=
 132                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
 133                Opt.Ada_Main_Name :=
 134                  new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
 135
 136                --  This option (-Lxxx) implies -n
 137
 138                Opt.Bind_Main_Program := False;
 139
 140             else
 141                Fail
 142                  ("Prefix of initialization and finalization " &
 143                   "procedure names missing in -L");
 144             end if;
 145
 146          --  -Sin -Slo -Shi -Sxx
 147
 148          elsif Argv'Length = 4
 149            and then Argv (2) = 'S'
 150          then
 151             declare
 152                C1 : Character := Argv (3);
 153                C2 : Character := Argv (4);
 154
 155             begin
 156                --  Fold to upper case
 157
 158                if C1 in 'a' .. 'z' then
 159                   C1 := Character'Val (Character'Pos (C1) - 32);
 160                end if;
 161
 162                if C2 in 'a' .. 'z' then
 163                   C2 := Character'Val (Character'Pos (C2) - 32);
 164                end if;
 165
 166                --  Test valid option and set mode accordingly
 167
 168                if C1 = 'E' and then C2 = 'V' then
 169                   null;
 170
 171                elsif C1 = 'I' and then C2 = 'N' then
 172                   null;
 173
 174                elsif C1 = 'L' and then C2 = 'O' then
 175                   null;
 176
 177                elsif C1 = 'H' and then C2 = 'I' then
 178                   null;
 179
 180                elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
 181                        and then
 182                      (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
 183                then
 184                   null;
 185
 186                --  Invalid -S switch, let Switch give error, set defalut of IN
 187
 188                else
 189                   Scan_Binder_Switches (Argv);
 190                   C1 := 'I';
 191                   C2 := 'N';
 192                end if;
 193
 194                Initialize_Scalars_Mode1 := C1;
 195                Initialize_Scalars_Mode2 := C2;
 196             end;
 197
 198          --  -aIdir
 199
 200          elsif Argv'Length >= 3
 201            and then Argv (2 .. 3) = "aI"
 202          then
 203             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
 204
 205          --  -aOdir
 206
 207          elsif Argv'Length >= 3
 208            and then Argv (2 .. 3) = "aO"
 209          then
 210             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
 211
 212          --  -nostdlib
 213
 214          elsif Argv (2 .. Argv'Last) = "nostdlib" then
 215             Opt.No_Stdlib := True;
 216
 217          --  -nostdinc
 218
 219          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 220             Opt.No_Stdinc := True;
 221
 222          --  -static
 223
 224          elsif Argv (2 .. Argv'Last) = "static" then
 225             Opt.Shared_Libgnat := False;
 226
 227          --  -shared
 228
 229          elsif Argv (2 .. Argv'Last) = "shared" then
 230             Opt.Shared_Libgnat := True;
 231
 232          --  -F=mapping_file
 233
 234          elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
 235             if Mapping_File /= null then
 236                Fail ("cannot specify several mapping files");
 237             end if;
 238
 239             Mapping_File := new String'(Argv (4 .. Argv'Last));
 240
 241          --  -Mname
 242
 243          elsif Argv'Length >= 3 and then Argv (2) = 'M' then
 244             Opt.Bind_Alternate_Main_Name := True;
 245             Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
 246
 247          --  All other options are single character and are handled
 248          --  by Scan_Binder_Switches.
 249
 250          else
 251             Scan_Binder_Switches (Argv);
 252          end if;
 253
 254       --  Not a switch, so must be a file name (if non-empty)
 255
 256       elsif Argv'Length /= 0 then
 257          if Argv'Length > 4
 258            and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
 259          then
 260             Add_File (Argv);
 261          else
 262             Add_File (Argv & ".ali");
 263          end if;
 264       end if;
 265    end Scan_Bind_Arg;
 266
 267 --  Start of processing for Gnatbind
 268
 269 begin
 270
 271    --  Set default for Shared_Libgnat option
 272
 273    declare
 274       Shared_Libgnat_Default : Character;
 275       pragma Import (C, Shared_Libgnat_Default, "shared_libgnat_default");
 276
 277       SHARED : constant Character := 'H';
 278       STATIC : constant Character := 'T';
 279
 280    begin
 281       pragma Assert
 282         (Shared_Libgnat_Default = SHARED
 283          or else
 284         Shared_Libgnat_Default = STATIC);
 285       Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
 286    end;
 287
 288    --  Use low level argument routines to avoid dragging in the secondary stack
 289
 290    Next_Arg := 1;
 291    Scan_Args : while Next_Arg < Arg_Count loop
 292       declare
 293          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 294
 295       begin
 296          Fill_Arg (Next_Argv'Address, Next_Arg);
 297          Scan_Bind_Arg (Next_Argv);
 298       end;
 299       Next_Arg := Next_Arg + 1;
 300    end loop Scan_Args;
 301
 302    --  Test for trailing -o switch
 303
 304    if Opt.Output_File_Name_Present
 305      and then not Output_File_Name_Seen
 306    then
 307       Fail ("output file name missing after -o");
 308    end if;
 309
 310    --  Output usage if requested
 311
 312    if Usage_Requested then
 313       Bindusg;
 314    end if;
 315
 316    --  Check that the Ada binder file specified has extension .adb and that
 317    --  the C binder file has extension .c
 318
 319    if Opt.Output_File_Name_Present
 320      and then Output_File_Name_Seen
 321    then
 322       Check_Extensions : declare
 323          Length : constant Natural := Output_File_Name'Length;
 324          Last   : constant Natural := Output_File_Name'Last;
 325
 326       begin
 327          if Ada_Bind_File then
 328             if Length <= 4
 329               or else Output_File_Name (Last - 3 .. Last) /= ".adb"
 330             then
 331                Fail ("output file name should have .adb extension");
 332             end if;
 333
 334          else
 335             if Length <= 2
 336               or else Output_File_Name (Last - 1 .. Last) /= ".c"
 337             then
 338                Fail ("output file name should have .c extension");
 339             end if;
 340          end if;
 341       end Check_Extensions;
 342    end if;
 343
 344    Osint.Add_Default_Search_Dirs;
 345
 346    --  Carry out package initializations. These are initializations which
 347    --  might logically be performed at elaboration time, but Namet at
 348    --  least can't be done that way (because it is used in the Compiler),
 349    --  and we decide to be consistent. Like elaboration, the order in
 350    --  which these calls are made is in some cases important.
 351
 352    Csets.Initialize;
 353    Namet.Initialize;
 354
 355    --  Acquire target parameters
 356
 357    Targparm.Get_Target_Parameters;
 358
 359    --  On OpenVMS, when -L is used, all external names used in pragmas Export
 360    --  are in upper case. The reason is that on OpenVMS, the macro-assembler
 361    --  MACASM-32, used to build Stand-Alone Libraries, only understands
 362    --  uppercase.
 363
 364    if L_Switch_Seen and then OpenVMS_On_Target then
 365       To_Upper (Opt.Ada_Init_Name.all);
 366       To_Upper (Opt.Ada_Final_Name.all);
 367       To_Upper (Opt.Ada_Main_Name.all);
 368    end if;
 369
 370    --  Acquire configurable run-time mode
 371
 372    if Configurable_Run_Time_On_Target then
 373       Configurable_Run_Time_Mode := True;
 374    end if;
 375
 376    --  Output copyright notice if in verbose mode
 377
 378    if Verbose_Mode then
 379       Write_Eol;
 380       Write_Str ("GNATBIND ");
 381       Write_Str (Gnat_Version_String);
 382       Write_Str (" Copyright 1995-2003 Free Software Foundation, Inc.");
 383       Write_Eol;
 384    end if;
 385
 386    --  Output usage information if no files
 387
 388    if not More_Lib_Files then
 389       Bindusg;
 390       Exit_Program (E_Fatal);
 391    end if;
 392
 393    --  If a mapping file was specified, initialize the file mapping
 394
 395    if Mapping_File /= null then
 396       Fmap.Initialize (Mapping_File.all);
 397    end if;
 398
 399    --  The block here is to catch the Unrecoverable_Error exception in the
 400    --  case where we exceed the maximum number of permissible errors or some
 401    --  other unrecoverable error occurs.
 402
 403    begin
 404       --  Initialize binder packages
 405
 406       Initialize_Binderr;
 407       Initialize_ALI;
 408       Initialize_ALI_Source;
 409
 410       if Verbose_Mode then
 411          Write_Eol;
 412       end if;
 413
 414       --  Input ALI files
 415
 416       while More_Lib_Files loop
 417          Main_Lib_File := Next_Main_Lib_File;
 418
 419          if Verbose_Mode then
 420             if Check_Only then
 421                Write_Str ("Checking: ");
 422             else
 423                Write_Str ("Binding: ");
 424             end if;
 425
 426             Write_Name (Main_Lib_File);
 427             Write_Eol;
 428          end if;
 429
 430          Text := Read_Library_Info (Main_Lib_File, True);
 431
 432          declare
 433             Id : ALI_Id;
 434             pragma Warnings (Off, Id);
 435
 436          begin
 437             Id := Scan_ALI
 438                     (F         => Main_Lib_File,
 439                      T         => Text,
 440                      Ignore_ED => Force_RM_Elaboration_Order,
 441                      Err       => False);
 442          end;
 443
 444          Free (Text);
 445       end loop;
 446
 447       --  No_Run_Time mode
 448
 449       if No_Run_Time_Mode then
 450
 451          --  Set standard restrictions
 452
 453          Restrictions_On_Target (No_Finalization)       := True;
 454          Restrictions_On_Target (No_Exception_Handlers) := True;
 455          Restrictions_On_Target (No_Tasking)            := True;
 456          Restriction_Parameters_On_Target (Max_Tasks)   := Uint_0;
 457
 458          --  Set standard configuration parameters
 459
 460          Suppress_Standard_Library_On_Target            := True;
 461          Configurable_Run_Time_Mode                     := True;
 462       end if;
 463
 464       --  For main ALI files, even if they are interfaces, we get their
 465       --  dependencies. To be sure, we reset the Interface flag for all main
 466       --  ALI files.
 467
 468       for Index in ALIs.First .. ALIs.Last loop
 469          ALIs.Table (Index).Interface := False;
 470       end loop;
 471
 472       --  Add System.Standard_Library to list to ensure that these files are
 473       --  included in the bind, even if not directly referenced from Ada code
 474       --  This is suppressed if the configurable run-time requests it.
 475
 476       if not Suppress_Standard_Library_On_Target then
 477          Name_Buffer (1 .. 12) := "s-stalib.ali";
 478          Name_Len := 12;
 479          Std_Lib_File := Name_Find;
 480          Text := Read_Library_Info (Std_Lib_File, True);
 481
 482          declare
 483             Id : ALI_Id;
 484             pragma Warnings (Off, Id);
 485
 486          begin
 487             Id :=
 488               Scan_ALI
 489                 (F         => Std_Lib_File,
 490                  T         => Text,
 491                  Ignore_ED => Force_RM_Elaboration_Order,
 492                  Err       => False);
 493          end;
 494
 495          Free (Text);
 496       end if;
 497
 498       --  Acquire all information in ALI files that have been read in
 499
 500       for Index in ALIs.First .. ALIs.Last loop
 501          Read_ALI (Index);
 502       end loop;
 503
 504       --  Warn if -f switch used
 505
 506       if Force_RM_Elaboration_Order then
 507          Error_Msg
 508            ("?-f is obsolescent and should not be used");
 509          Error_Msg
 510            ("?may result in missing run-time elaboration checks");
 511          Error_Msg
 512            ("?use -gnatE, pragma Suppress (Elaboration_Checks) instead");
 513       end if;
 514
 515       --  Quit if some file needs compiling
 516
 517       if No_Object_Specified then
 518          raise Unrecoverable_Error;
 519       end if;
 520
 521       --  Build source file table from the ALI files we have read in
 522
 523       Set_Source_Table;
 524
 525       --  Check that main library file is a suitable main program
 526
 527       if Bind_Main_Program
 528         and then ALIs.Table (ALIs.First).Main_Program = None
 529         and then not No_Main_Subprogram
 530       then
 531          Error_Msg_Name_1 := Main_Lib_File;
 532          Error_Msg ("% does not contain a unit that can be a main program");
 533       end if;
 534
 535       --  Perform consistency and correctness checks
 536
 537       Check_Duplicated_Subunits;
 538       Check_Versions;
 539       Check_Consistency;
 540       Check_Configuration_Consistency;
 541
 542       --  Acquire restrictions and add them to target restrictions. After
 543       --  this loop, Restrictions_On_Target entries will be set True for
 544       --  all partition-wide restrictions specified in the partition.
 545
 546       for J in Partition_Restrictions loop
 547          if Restrictions (J) = 'r' then
 548             Restrictions_On_Target (J) := True;
 549          end if;
 550       end loop;
 551
 552       --  Complete bind if no errors
 553
 554       if Errors_Detected = 0 then
 555          Find_Elab_Order;
 556
 557          if Errors_Detected = 0 then
 558             if Elab_Order_Output then
 559                Write_Eol;
 560                Write_Str ("ELABORATION ORDER");
 561                Write_Eol;
 562
 563                for J in Elab_Order.First .. Elab_Order.Last loop
 564                   if not Units.Table (Elab_Order.Table (J)).Interface then
 565                      Write_Str ("   ");
 566                      Write_Unit_Name
 567                        (Units.Table (Elab_Order.Table (J)).Uname);
 568                      Write_Eol;
 569                   end if;
 570                end loop;
 571
 572                Write_Eol;
 573             end if;
 574
 575             if not Check_Only then
 576                Gen_Output_File (Output_File_Name.all);
 577             end if;
 578          end if;
 579       end if;
 580
 581       Total_Errors := Total_Errors + Errors_Detected;
 582       Total_Warnings := Total_Warnings + Warnings_Detected;
 583
 584    exception
 585       when Unrecoverable_Error =>
 586          Total_Errors := Total_Errors + Errors_Detected;
 587          Total_Warnings := Total_Warnings + Warnings_Detected;
 588    end;
 589
 590    --  All done. Set proper exit status.
 591
 592    Finalize_Binderr;
 593    Namet.Finalize;
 594
 595    if Total_Errors > 0 then
 596       Exit_Program (E_Errors);
 597    elsif Total_Warnings > 0 then
 598       Exit_Program (E_Warnings);
 599    else
 600       Exit_Program (E_Success);
 601    end if;
 602
 603 end Gnatbind;