gcc/ada/osint.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                O S I N T                                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2006, 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 Fmap;     use Fmap;
  28 with Gnatvsn;  use Gnatvsn;
  29 with Hostparm;
  30 with Namet;    use Namet;
  31 with Opt;      use Opt;
  32 with Output;   use Output;
  33 with Sdefault; use Sdefault;
  34 with Table;
  35 with Targparm; use Targparm;
  36
  37 with System.Case_Util; use System.Case_Util;
  38
  39 with Unchecked_Conversion;
  40
  41 with GNAT.HTable;
  42
  43 package body Osint is
  44
  45    Running_Program : Program_Type := Unspecified;
  46    --  comment required here ???
  47
  48    Program_Set : Boolean := False;
  49    --  comment required here ???
  50
  51    Std_Prefix : String_Ptr;
  52    --  Standard prefix, computed dynamically the first time Relocate_Path
  53    --  is called, and cached for subsequent calls.
  54
  55    Empty  : aliased String := "";
  56    No_Dir : constant String_Ptr := Empty'Access;
  57    --  Used in Locate_File as a fake directory when Name is already an
  58    --  absolute path.
  59
  60    -------------------------------------
  61    -- Use of Name_Find and Name_Enter --
  62    -------------------------------------
  63
  64    --  This package creates a number of source, ALI and object file names
  65    --  that are used to locate the actual file and for the purpose of
  66    --  message construction. These names need not be accessible by Name_Find,
  67    --  and can be therefore created by using routine Name_Enter. The files in
  68    --  question are file names with a prefix directory (ie the files not
  69    --  in the current directory). File names without a prefix directory are
  70    --  entered with Name_Find because special values might be attached to
  71    --  the various Info fields of the corresponding name table entry.
  72
  73    -----------------------
  74    -- Local Subprograms --
  75    -----------------------
  76
  77    function Append_Suffix_To_File_Name
  78      (Name   : Name_Id;
  79       Suffix : String) return Name_Id;
  80    --  Appends Suffix to Name and returns the new name
  81
  82    function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
  83    --  Convert OS format time to GNAT format time stamp
  84
  85    function Executable_Prefix return String_Ptr;
  86    --  Returns the name of the root directory where the executable is stored.
  87    --  The executable must be located in a directory called "bin", or
  88    --  under root/lib/gcc-lib/..., or under root/libexec/gcc/... Thus, if
  89    --  the executable is stored in directory "/foo/bar/bin", this routine
  90    --  returns "/foo/bar/".  Return "" if the location is not recognized
  91    --  as described above.
  92
  93    function Update_Path (Path : String_Ptr) return String_Ptr;
  94    --  Update the specified path to replace the prefix with the location
  95    --  where GNAT is installed. See the file prefix.c in GCC for details.
  96
  97    function Locate_File
  98      (N    : File_Name_Type;
  99       T    : File_Type;
 100       Dir  : Natural;
 101       Name : String) return File_Name_Type;
 102    --  See if the file N whose name is Name exists in directory Dir. Dir is
 103    --  an index into the Lib_Search_Directories table if T = Library.
 104    --  Otherwise if T = Source, Dir is an index into the
 105    --  Src_Search_Directories table. Returns the File_Name_Type of the
 106    --  full file name if file found, or No_File if not found.
 107
 108    function C_String_Length (S : Address) return Integer;
 109    --  Returns length of a C string. Returns zero for a null address
 110
 111    function To_Path_String_Access
 112      (Path_Addr : Address;
 113       Path_Len  : Integer) return String_Access;
 114    --  Converts a C String to an Ada String. Are we doing this to avoid
 115    --  withing Interfaces.C.Strings ???
 116
 117    ------------------------------
 118    -- Other Local Declarations --
 119    ------------------------------
 120
 121    EOL : constant Character := ASCII.LF;
 122    --  End of line character
 123
 124    Number_File_Names : Int := 0;
 125    --  The total number of file names found on command line and placed in
 126    --  File_Names.
 127
 128    Look_In_Primary_Directory_For_Current_Main : Boolean := False;
 129    --  When this variable is True, Find_File will only look in
 130    --  the Primary_Directory for the Current_Main file.
 131    --  This variable is always True for the compiler.
 132    --  It is also True for gnatmake, when the soucr name given
 133    --  on the command line has directory information.
 134
 135    Current_Full_Source_Name  : File_Name_Type  := No_File;
 136    Current_Full_Source_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
 137    Current_Full_Lib_Name     : File_Name_Type  := No_File;
 138    Current_Full_Lib_Stamp    : Time_Stamp_Type := Empty_Time_Stamp;
 139    Current_Full_Obj_Name     : File_Name_Type  := No_File;
 140    Current_Full_Obj_Stamp    : Time_Stamp_Type := Empty_Time_Stamp;
 141    --  Respectively full name (with directory info) and time stamp of
 142    --  the latest source, library and object files opened by Read_Source_File
 143    --  and Read_Library_Info.
 144
 145    ------------------
 146    -- Search Paths --
 147    ------------------
 148
 149    Primary_Directory : constant := 0;
 150    --  This is index in the tables created below for the first directory to
 151    --  search in for source or library information files. This is the
 152    --  directory containing the latest main input file (a source file for
 153    --  the compiler or a library file for the binder).
 154
 155    package Src_Search_Directories is new Table.Table (
 156      Table_Component_Type => String_Ptr,
 157      Table_Index_Type     => Natural,
 158      Table_Low_Bound      => Primary_Directory,
 159      Table_Initial        => 10,
 160      Table_Increment      => 100,
 161      Table_Name           => "Osint.Src_Search_Directories");
 162    --  Table of names of directories in which to search for source (Compiler)
 163    --  files. This table is filled in the order in which the directories are
 164    --  to be searched, and then used in that order.
 165
 166    package Lib_Search_Directories is new Table.Table (
 167      Table_Component_Type => String_Ptr,
 168      Table_Index_Type     => Natural,
 169      Table_Low_Bound      => Primary_Directory,
 170      Table_Initial        => 10,
 171      Table_Increment      => 100,
 172      Table_Name           => "Osint.Lib_Search_Directories");
 173    --  Table of names of directories in which to search for library (Binder)
 174    --  files. This table is filled in the order in which the directories are
 175    --  to be searched and then used in that order. The reason for having two
 176    --  distinct tables is that we need them both in gnatmake.
 177
 178    ---------------------
 179    -- File Hash Table --
 180    ---------------------
 181
 182    --  The file hash table is provided to free the programmer from any
 183    --  efficiency concern when retrieving full file names or time stamps of
 184    --  source files. If the programmer calls Source_File_Data (Cache => True)
 185    --  he is guaranteed that the price to retrieve the full name (ie with
 186    --  directory info) or time stamp of the file will be payed only once,
 187    --  the first time the full name is actually searched (or the first time
 188    --  the time stamp is actually retrieved). This is achieved by employing
 189    --  a hash table that stores as a key the File_Name_Type of the file and
 190    --  associates to that File_Name_Type the full file name of the file and its
 191    --  time stamp.
 192
 193    File_Cache_Enabled : Boolean := False;
 194    --  Set to true if you want the enable the file data caching mechanism
 195
 196    type File_Hash_Num is range 0 .. 1020;
 197
 198    function File_Hash (F : File_Name_Type) return File_Hash_Num;
 199    --  Compute hash index for use by Simple_HTable
 200
 201    package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
 202      Header_Num => File_Hash_Num,
 203      Element    => File_Name_Type,
 204      No_Element => No_File,
 205      Key        => File_Name_Type,
 206      Hash       => File_Hash,
 207      Equal      => "=");
 208
 209    package File_Stamp_Hash_Table is new GNAT.HTable.Simple_HTable (
 210      Header_Num => File_Hash_Num,
 211      Element    => Time_Stamp_Type,
 212      No_Element => Empty_Time_Stamp,
 213      Key        => File_Name_Type,
 214      Hash       => File_Hash,
 215      Equal      => "=");
 216
 217    function Smart_Find_File
 218      (N : File_Name_Type;
 219       T : File_Type) return File_Name_Type;
 220    --  Exactly like Find_File except that if File_Cache_Enabled is True this
 221    --  routine looks first in the hash table to see if the full name of the
 222    --  file is already available.
 223
 224    function Smart_File_Stamp
 225      (N : File_Name_Type;
 226       T : File_Type) return Time_Stamp_Type;
 227    --  Takes the same parameter as the routine above (N is a file name
 228    --  without any prefix directory information) and behaves like File_Stamp
 229    --  except that if File_Cache_Enabled is True this routine looks first in
 230    --  the hash table to see if the file stamp of the file is already
 231    --  available.
 232
 233    -----------------------------
 234    -- Add_Default_Search_Dirs --
 235    -----------------------------
 236
 237    procedure Add_Default_Search_Dirs is
 238       Search_Dir     : String_Access;
 239       Search_Path    : String_Access;
 240       Path_File_Name : String_Access;
 241
 242       procedure Add_Search_Dir
 243         (Search_Dir            : String;
 244          Additional_Source_Dir : Boolean);
 245       procedure Add_Search_Dir
 246         (Search_Dir            : String_Access;
 247          Additional_Source_Dir : Boolean);
 248       --  Add a source search dir or a library search dir, depending on the
 249       --  value of Additional_Source_Dir.
 250
 251       procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean);
 252       --  Open a path file and read the directory to search, one per line
 253
 254       function Get_Libraries_From_Registry return String_Ptr;
 255       --  On Windows systems, get the list of installed standard libraries
 256       --  from the registry key:
 257       --
 258       --  HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\
 259       --                             GNAT\Standard Libraries
 260       --  Return an empty string on other systems
 261
 262       --------------------
 263       -- Add_Search_Dir --
 264       --------------------
 265
 266       procedure Add_Search_Dir
 267         (Search_Dir            : String;
 268          Additional_Source_Dir : Boolean)
 269       is
 270       begin
 271          if Additional_Source_Dir then
 272             Add_Src_Search_Dir (Search_Dir);
 273          else
 274             Add_Lib_Search_Dir (Search_Dir);
 275          end if;
 276       end Add_Search_Dir;
 277
 278       procedure Add_Search_Dir
 279         (Search_Dir            : String_Access;
 280          Additional_Source_Dir : Boolean)
 281       is
 282       begin
 283          if Additional_Source_Dir then
 284             Add_Src_Search_Dir (Search_Dir.all);
 285          else
 286             Add_Lib_Search_Dir (Search_Dir.all);
 287          end if;
 288       end Add_Search_Dir;
 289
 290       ------------------------
 291       -- Get_Dirs_From_File --
 292       ------------------------
 293
 294       procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean) is
 295          File_FD    : File_Descriptor;
 296          Buffer     : constant String := Path_File_Name.all & ASCII.NUL;
 297          Len        : Natural;
 298          Actual_Len : Natural;
 299          S          : String_Access;
 300          Curr       : Natural;
 301          First      : Natural;
 302          Ch         : Character;
 303
 304          Status : Boolean;
 305          --  For the call to Close
 306
 307       begin
 308          File_FD := Open_Read (Buffer'Address, Binary);
 309
 310          --  If we cannot open the file, we ignore it, we don't fail
 311
 312          if File_FD = Invalid_FD then
 313             return;
 314          end if;
 315
 316          Len := Integer (File_Length (File_FD));
 317
 318          S := new String (1 .. Len);
 319
 320          --  Read the file. Note that the loop is not necessary since the
 321          --  whole file is read at once except on VMS.
 322
 323          Curr := 1;
 324          Actual_Len := Len;
 325          while Curr <= Len and then Actual_Len /= 0 loop
 326             Actual_Len := Read (File_FD, S (Curr)'Address, Len);
 327             Curr := Curr + Actual_Len;
 328          end loop;
 329
 330          --  We are done with the file, so we close it
 331
 332          Close (File_FD, Status);
 333          --  We ignore any error here, because we have successfully read the
 334          --  file.
 335
 336          --  Now, we read line by line
 337
 338          First := 1;
 339          Curr := 0;
 340
 341          while Curr < Len loop
 342             Ch := S (Curr + 1);
 343
 344             if Ch = ASCII.CR or else Ch = ASCII.LF
 345               or else Ch = ASCII.FF or else Ch = ASCII.VT
 346             then
 347                if First <= Curr then
 348                   Add_Search_Dir (S (First .. Curr), Additional_Source_Dir);
 349                end if;
 350
 351                First := Curr + 2;
 352             end if;
 353
 354             Curr := Curr + 1;
 355          end loop;
 356
 357          --  Last line is a special case, if the file does not end with
 358          --  an end of line mark.
 359
 360          if First <= S'Last then
 361             Add_Search_Dir (S (First .. S'Last), Additional_Source_Dir);
 362          end if;
 363       end Get_Dirs_From_File;
 364
 365       ---------------------------------
 366       -- Get_Libraries_From_Registry --
 367       ---------------------------------
 368
 369       function Get_Libraries_From_Registry return String_Ptr is
 370          function C_Get_Libraries_From_Registry return Address;
 371          pragma Import (C, C_Get_Libraries_From_Registry,
 372                         "__gnat_get_libraries_from_registry");
 373
 374          function Strlen (Str : Address) return Integer;
 375          pragma Import (C, Strlen, "strlen");
 376
 377          procedure Strncpy (X : Address; Y : Address; Length : Integer);
 378          pragma Import (C, Strncpy, "strncpy");
 379
 380          Result_Ptr    : Address;
 381          Result_Length : Integer;
 382          Out_String    : String_Ptr;
 383
 384       begin
 385          Result_Ptr := C_Get_Libraries_From_Registry;
 386          Result_Length := Strlen (Result_Ptr);
 387
 388          Out_String := new String (1 .. Result_Length);
 389          Strncpy (Out_String.all'Address, Result_Ptr, Result_Length);
 390          return Out_String;
 391       end Get_Libraries_From_Registry;
 392
 393    --  Start of processing for Add_Default_Search_Dirs
 394
 395    begin
 396       --  After the locations specified on the command line, the next places
 397       --  to look for files are the directories specified by the appropriate
 398       --  environment variable. Get this value, extract the directory names
 399       --  and store in the tables.
 400
 401       --  Check for eventual project path file env vars
 402
 403       Path_File_Name := Getenv (Project_Include_Path_File);
 404
 405       if Path_File_Name'Length > 0 then
 406          Get_Dirs_From_File (Additional_Source_Dir => True);
 407       end if;
 408
 409       Path_File_Name := Getenv (Project_Objects_Path_File);
 410
 411       if Path_File_Name'Length > 0 then
 412          Get_Dirs_From_File (Additional_Source_Dir => False);
 413       end if;
 414
 415       --  On VMS, don't expand the logical name (e.g. environment variable),
 416       --  just put it into Unix (e.g. canonical) format. System services
 417       --  will handle the expansion as part of the file processing.
 418
 419       for Additional_Source_Dir in False .. True loop
 420          if Additional_Source_Dir then
 421             Search_Path := Getenv (Ada_Include_Path);
 422
 423             if Search_Path'Length > 0 then
 424                if Hostparm.OpenVMS then
 425                   Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:");
 426                else
 427                   Search_Path := To_Canonical_Path_Spec (Search_Path.all);
 428                end if;
 429             end if;
 430
 431          else
 432             Search_Path := Getenv (Ada_Objects_Path);
 433
 434             if Search_Path'Length > 0 then
 435                if Hostparm.OpenVMS then
 436                   Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:");
 437                else
 438                   Search_Path := To_Canonical_Path_Spec (Search_Path.all);
 439                end if;
 440             end if;
 441          end if;
 442
 443          Get_Next_Dir_In_Path_Init (Search_Path);
 444          loop
 445             Search_Dir := Get_Next_Dir_In_Path (Search_Path);
 446             exit when Search_Dir = null;
 447             Add_Search_Dir (Search_Dir, Additional_Source_Dir);
 448          end loop;
 449       end loop;
 450
 451       --  For the compiler, if --RTS= was specified, add the runtime
 452       --  directories.
 453
 454       if RTS_Src_Path_Name /= null and then
 455          RTS_Lib_Path_Name /= null
 456       then
 457          Add_Search_Dirs (RTS_Src_Path_Name, Include);
 458          Add_Search_Dirs (RTS_Lib_Path_Name, Objects);
 459
 460       else
 461          if not Opt.No_Stdinc then
 462
 463             --  For WIN32 systems, look for any system libraries defined in
 464             --  the registry. These are added to both source and object
 465             --  directories.
 466
 467             Search_Path := String_Access (Get_Libraries_From_Registry);
 468
 469             Get_Next_Dir_In_Path_Init (Search_Path);
 470             loop
 471                Search_Dir := Get_Next_Dir_In_Path (Search_Path);
 472                exit when Search_Dir = null;
 473                Add_Search_Dir (Search_Dir, False);
 474                Add_Search_Dir (Search_Dir, True);
 475             end loop;
 476
 477             --  The last place to look are the defaults
 478
 479             Search_Path :=
 480               Read_Default_Search_Dirs
 481                 (String_Access (Update_Path (Search_Dir_Prefix)),
 482                  Include_Search_File,
 483                  String_Access (Update_Path (Include_Dir_Default_Name)));
 484
 485             Get_Next_Dir_In_Path_Init (Search_Path);
 486             loop
 487                Search_Dir := Get_Next_Dir_In_Path (Search_Path);
 488                exit when Search_Dir = null;
 489                Add_Search_Dir (Search_Dir, True);
 490             end loop;
 491          end if;
 492
 493          if not Opt.No_Stdlib and not Opt.RTS_Switch then
 494             Search_Path :=
 495               Read_Default_Search_Dirs
 496                 (String_Access (Update_Path (Search_Dir_Prefix)),
 497                  Objects_Search_File,
 498                  String_Access (Update_Path (Object_Dir_Default_Name)));
 499
 500             Get_Next_Dir_In_Path_Init (Search_Path);
 501             loop
 502                Search_Dir := Get_Next_Dir_In_Path (Search_Path);
 503                exit when Search_Dir = null;
 504                Add_Search_Dir (Search_Dir, False);
 505             end loop;
 506          end if;
 507       end if;
 508    end Add_Default_Search_Dirs;
 509
 510    --------------
 511    -- Add_File --
 512    --------------
 513
 514    procedure Add_File (File_Name : String; Index : Int := No_Index) is
 515    begin
 516       Number_File_Names := Number_File_Names + 1;
 517
 518       --  As Add_File may be called for mains specified inside
 519       --  a project file, File_Names may be too short and needs
 520       --  to be extended.
 521
 522       if Number_File_Names > File_Names'Last then
 523          File_Names := new File_Name_Array'(File_Names.all & File_Names.all);
 524          File_Indexes :=
 525            new File_Index_Array'(File_Indexes.all & File_Indexes.all);
 526       end if;
 527
 528       File_Names   (Number_File_Names) := new String'(File_Name);
 529       File_Indexes (Number_File_Names) := Index;
 530    end Add_File;
 531
 532    ------------------------
 533    -- Add_Lib_Search_Dir --
 534    ------------------------
 535
 536    procedure Add_Lib_Search_Dir (Dir : String) is
 537    begin
 538       if Dir'Length = 0 then
 539          Fail ("missing library directory name");
 540       end if;
 541
 542       Lib_Search_Directories.Increment_Last;
 543       Lib_Search_Directories.Table (Lib_Search_Directories.Last) :=
 544         Normalize_Directory_Name (Dir);
 545    end Add_Lib_Search_Dir;
 546
 547    ---------------------
 548    -- Add_Search_Dirs --
 549    ---------------------
 550
 551    procedure Add_Search_Dirs
 552      (Search_Path : String_Ptr;
 553       Path_Type   : Search_File_Type)
 554    is
 555       Current_Search_Path : String_Access;
 556
 557    begin
 558       Get_Next_Dir_In_Path_Init (String_Access (Search_Path));
 559       loop
 560          Current_Search_Path :=
 561            Get_Next_Dir_In_Path (String_Access (Search_Path));
 562          exit when Current_Search_Path = null;
 563
 564          if Path_Type = Include then
 565             Add_Src_Search_Dir (Current_Search_Path.all);
 566          else
 567             Add_Lib_Search_Dir (Current_Search_Path.all);
 568          end if;
 569       end loop;
 570    end Add_Search_Dirs;
 571
 572    ------------------------
 573    -- Add_Src_Search_Dir --
 574    ------------------------
 575
 576    procedure Add_Src_Search_Dir (Dir : String) is
 577    begin
 578       if Dir'Length = 0 then
 579          Fail ("missing source directory name");
 580       end if;
 581
 582       Src_Search_Directories.Increment_Last;
 583       Src_Search_Directories.Table (Src_Search_Directories.Last) :=
 584         Normalize_Directory_Name (Dir);
 585    end Add_Src_Search_Dir;
 586
 587    --------------------------------
 588    -- Append_Suffix_To_File_Name --
 589    --------------------------------
 590
 591    function Append_Suffix_To_File_Name
 592      (Name   : Name_Id;
 593       Suffix : String) return Name_Id
 594    is
 595    begin
 596       Get_Name_String (Name);
 597       Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
 598       Name_Len := Name_Len + Suffix'Length;
 599       return Name_Find;
 600    end Append_Suffix_To_File_Name;
 601
 602    ---------------------
 603    -- C_String_Length --
 604    ---------------------
 605
 606    function C_String_Length (S : Address) return Integer is
 607       function Strlen (S : Address) return Integer;
 608       pragma Import (C, Strlen, "strlen");
 609    begin
 610       if S = Null_Address then
 611          return 0;
 612       else
 613          return Strlen (S);
 614       end if;
 615    end C_String_Length;
 616
 617    ------------------------------
 618    -- Canonical_Case_File_Name --
 619    ------------------------------
 620
 621    --  For now, we only deal with the case of a-z. Eventually we should
 622    --  worry about other Latin-1 letters on systems that support this ???
 623
 624    procedure Canonical_Case_File_Name (S : in out String) is
 625    begin
 626       if not File_Names_Case_Sensitive then
 627          for J in S'Range loop
 628             if S (J) in 'A' .. 'Z' then
 629                S (J) := Character'Val (
 630                           Character'Pos (S (J)) +
 631                           Character'Pos ('a')   -
 632                           Character'Pos ('A'));
 633             end if;
 634          end loop;
 635       end if;
 636    end Canonical_Case_File_Name;
 637
 638    ---------------------------
 639    -- Create_File_And_Check --
 640    ---------------------------
 641
 642    procedure Create_File_And_Check
 643      (Fdesc : out File_Descriptor;
 644       Fmode : Mode)
 645    is
 646    begin
 647       Output_File_Name := Name_Enter;
 648       Fdesc := Create_File (Name_Buffer'Address, Fmode);
 649
 650       if Fdesc = Invalid_FD then
 651          Fail ("Cannot create: ", Name_Buffer (1 .. Name_Len));
 652       end if;
 653    end Create_File_And_Check;
 654
 655    ------------------------
 656    -- Current_File_Index --
 657    ------------------------
 658
 659    function Current_File_Index return Int is
 660    begin
 661       return File_Indexes (Current_File_Name_Index);
 662    end Current_File_Index;
 663
 664    --------------------------------
 665    -- Current_Library_File_Stamp --
 666    --------------------------------
 667
 668    function Current_Library_File_Stamp return Time_Stamp_Type is
 669    begin
 670       return Current_Full_Lib_Stamp;
 671    end Current_Library_File_Stamp;
 672
 673    -------------------------------
 674    -- Current_Object_File_Stamp --
 675    -------------------------------
 676
 677    function Current_Object_File_Stamp return Time_Stamp_Type is
 678    begin
 679       return Current_Full_Obj_Stamp;
 680    end Current_Object_File_Stamp;
 681
 682    -------------------------------
 683    -- Current_Source_File_Stamp --
 684    -------------------------------
 685
 686    function Current_Source_File_Stamp return Time_Stamp_Type is
 687    begin
 688       return Current_Full_Source_Stamp;
 689    end Current_Source_File_Stamp;
 690
 691    ----------------------------
 692    -- Dir_In_Obj_Search_Path --
 693    ----------------------------
 694
 695    function Dir_In_Obj_Search_Path (Position : Natural) return String_Ptr is
 696    begin
 697       if Opt.Look_In_Primary_Dir then
 698          return
 699            Lib_Search_Directories.Table (Primary_Directory + Position - 1);
 700       else
 701          return Lib_Search_Directories.Table (Primary_Directory + Position);
 702       end if;
 703    end Dir_In_Obj_Search_Path;
 704
 705    ----------------------------
 706    -- Dir_In_Src_Search_Path --
 707    ----------------------------
 708
 709    function Dir_In_Src_Search_Path (Position : Natural) return String_Ptr is
 710    begin
 711       if Opt.Look_In_Primary_Dir then
 712          return
 713            Src_Search_Directories.Table (Primary_Directory + Position - 1);
 714       else
 715          return Src_Search_Directories.Table (Primary_Directory + Position);
 716       end if;
 717    end Dir_In_Src_Search_Path;
 718
 719    ---------------------
 720    -- Executable_Name --
 721    ---------------------
 722
 723    function Executable_Name (Name : File_Name_Type) return File_Name_Type is
 724       Exec_Suffix : String_Access;
 725    begin
 726       if Name = No_File then
 727          return No_File;
 728       end if;
 729
 730       if Executable_Extension_On_Target = No_Name then
 731          Exec_Suffix := Get_Target_Executable_Suffix;
 732       else
 733          Get_Name_String (Executable_Extension_On_Target);
 734          Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
 735       end if;
 736
 737       Get_Name_String (Name);
 738
 739       if Exec_Suffix'Length /= 0 then
 740          declare
 741             Buffer : String := Name_Buffer (1 .. Name_Len);
 742
 743          begin
 744             --  Get the file name in canonical case to accept as is
 745             --  names ending with ".EXE" on VMS and Windows.
 746
 747             Canonical_Case_File_Name (Buffer);
 748
 749             --  If the Executable does not end with the executable
 750             --  suffix, add it.
 751
 752             if Buffer'Length <= Exec_Suffix'Length
 753               or else
 754                 Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
 755                   /= Exec_Suffix.all
 756             then
 757                Name_Buffer (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
 758                  Exec_Suffix.all;
 759                Name_Len := Name_Len + Exec_Suffix'Length;
 760                Free (Exec_Suffix);
 761                return Name_Find;
 762             end if;
 763          end;
 764       end if;
 765
 766       Free (Exec_Suffix);
 767       return Name;
 768    end Executable_Name;
 769
 770    function Executable_Name (Name : String) return String is
 771       Exec_Suffix    : String_Access;
 772       Canonical_Name : String := Name;
 773
 774    begin
 775       if Executable_Extension_On_Target = No_Name then
 776          Exec_Suffix := Get_Target_Executable_Suffix;
 777       else
 778          Get_Name_String (Executable_Extension_On_Target);
 779          Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
 780       end if;
 781
 782       declare
 783          Suffix : constant String := Exec_Suffix.all;
 784
 785       begin
 786          Free (Exec_Suffix);
 787          Canonical_Case_File_Name (Canonical_Name);
 788
 789          if Suffix'Length /= 0
 790            and then
 791              (Canonical_Name'Length <= Suffix'Length
 792                or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
 793                                          .. Canonical_Name'Last) /= Suffix)
 794          then
 795             declare
 796                Result : String (1 .. Name'Length + Suffix'Length);
 797             begin
 798                Result (1 .. Name'Length) := Name;
 799                Result (Name'Length + 1 .. Result'Last) := Suffix;
 800                return Result;
 801             end;
 802          else
 803             return Name;
 804          end if;
 805       end;
 806    end Executable_Name;
 807
 808    -----------------------
 809    -- Executable_Prefix --
 810    -----------------------
 811
 812    function Executable_Prefix return String_Ptr is
 813       function Get_Install_Dir (Exec : String) return String_Ptr;
 814       --  S is the executable name preceeded by the absolute or relative
 815       --  path, e.g. "c:\usr\bin\gcc.exe" or "..\bin\gcc".
 816
 817       ---------------------
 818       -- Get_Install_Dir --
 819       ---------------------
 820
 821       function Get_Install_Dir (Exec : String) return String_Ptr is
 822          Full_Path : constant String := Normalize_Pathname (Exec);
 823          --  Use the full path, so that we find "lib" or "bin", even when
 824          --  the tool has been invoked with a relative path, as in
 825          --  "./gnatls -v" invoked in the GNAT bin directory.
 826
 827       begin
 828          for J in reverse Full_Path'Range loop
 829             if Is_Directory_Separator (Full_Path (J)) then
 830                if J < Full_Path'Last - 5 then
 831                   if (To_Lower (Full_Path (J + 1)) = 'l'
 832                       and then To_Lower (Full_Path (J + 2)) = 'i'
 833                       and then To_Lower (Full_Path (J + 3)) = 'b')
 834                     or else
 835                       (To_Lower (Full_Path (J + 1)) = 'b'
 836                        and then To_Lower (Full_Path (J + 2)) = 'i'
 837                        and then To_Lower (Full_Path (J + 3)) = 'n')
 838                   then
 839                      return new String'(Full_Path (Full_Path'First .. J));
 840                   end if;
 841                end if;
 842             end if;
 843          end loop;
 844
 845          return new String'("");
 846       end Get_Install_Dir;
 847
 848    --  Start of processing for Executable_Prefix
 849
 850    begin
 851       if Exec_Name = null then
 852          Exec_Name := new String (1 .. Len_Arg (0));
 853          Osint.Fill_Arg (Exec_Name (1)'Address, 0);
 854       end if;
 855
 856       --  First determine if a path prefix was placed in front of the
 857       --  executable name.
 858
 859       for J in reverse Exec_Name'Range loop
 860          if Is_Directory_Separator (Exec_Name (J)) then
 861             return Get_Install_Dir (Exec_Name.all);
 862          end if;
 863       end loop;
 864
 865       --  If we come here, the user has typed the executable name with no
 866       --  directory prefix.
 867
 868       return Get_Install_Dir
 869         (GNAT.OS_Lib.Locate_Exec_On_Path (Exec_Name.all).all);
 870    end Executable_Prefix;
 871
 872    ------------------
 873    -- Exit_Program --
 874    ------------------
 875
 876    procedure Exit_Program (Exit_Code : Exit_Code_Type) is
 877    begin
 878       --  The program will exit with the following status:
 879
 880       --    0 if the object file has been generated (with or without warnings)
 881       --    1 if recompilation was not needed (smart recompilation)
 882       --    2 if gnat1 has been killed by a signal (detected by GCC)
 883       --    4 for a fatal error
 884       --    5 if there were errors
 885       --    6 if no code has been generated (spec)
 886
 887       --  Note that exit code 3 is not used and must not be used as this is
 888       --  the code returned by a program aborted via C abort() routine on
 889       --  Windows. GCC checks for that case and thinks that the child process
 890       --  has been aborted. This code (exit code 3) used to be the code used
 891       --  for E_No_Code, but E_No_Code was changed to 6 for this reason.
 892
 893       case Exit_Code is
 894          when E_Success    => OS_Exit (0);
 895          when E_Warnings   => OS_Exit (0);
 896          when E_No_Compile => OS_Exit (1);
 897          when E_Fatal      => OS_Exit (4);
 898          when E_Errors     => OS_Exit (5);
 899          when E_No_Code    => OS_Exit (6);
 900          when E_Abort      => OS_Abort;
 901       end case;
 902    end Exit_Program;
 903
 904    ----------
 905    -- Fail --
 906    ----------
 907
 908    procedure Fail (S1 : String; S2 : String := ""; S3 : String := "") is
 909    begin
 910       --  We use Output in case there is a special output set up.
 911       --  In this case Set_Standard_Error will have no immediate effect.
 912
 913       Set_Standard_Error;
 914       Osint.Write_Program_Name;
 915       Write_Str (": ");
 916       Write_Str (S1);
 917       Write_Str (S2);
 918       Write_Str (S3);
 919       Write_Eol;
 920
 921       Exit_Program (E_Fatal);
 922    end Fail;
 923
 924    ---------------
 925    -- File_Hash --
 926    ---------------
 927
 928    function File_Hash (F : File_Name_Type) return File_Hash_Num is
 929    begin
 930       return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length);
 931    end File_Hash;
 932
 933    ----------------
 934    -- File_Stamp --
 935    ----------------
 936
 937    function File_Stamp (Name : File_Name_Type) return Time_Stamp_Type is
 938    begin
 939       if Name = No_File then
 940          return Empty_Time_Stamp;
 941       end if;
 942
 943       Get_Name_String (Name);
 944
 945       if not Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
 946          return Empty_Time_Stamp;
 947       else
 948          Name_Buffer (Name_Len + 1) := ASCII.NUL;
 949          return OS_Time_To_GNAT_Time (File_Time_Stamp (Name_Buffer));
 950       end if;
 951    end File_Stamp;
 952
 953    ---------------
 954    -- Find_File --
 955    ---------------
 956
 957    function Find_File
 958      (N : File_Name_Type;
 959       T : File_Type) return File_Name_Type
 960    is
 961    begin
 962       Get_Name_String (N);
 963
 964       declare
 965          File_Name : String renames Name_Buffer (1 .. Name_Len);
 966          File      : File_Name_Type := No_File;
 967          Last_Dir  : Natural;
 968
 969       begin
 970          --  If we are looking for a config file, look only in the current
 971          --  directory, i.e. return input argument unchanged. Also look
 972          --  only in the current directory if we are looking for a .dg
 973          --  file (happens in -gnatD mode)
 974
 975          if T = Config
 976            or else (Debug_Generated_Code
 977                       and then Name_Len > 3
 978                       and then
 979                       (Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg"
 980                        or else
 981                        (Hostparm.OpenVMS and then
 982                         Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
 983          then
 984             return N;
 985
 986          --  If we are trying to find the current main file just look in the
 987          --  directory where the user said it was.
 988
 989          elsif Look_In_Primary_Directory_For_Current_Main
 990            and then Current_Main = N
 991          then
 992             return Locate_File (N, T, Primary_Directory, File_Name);
 993
 994          --  Otherwise do standard search for source file
 995
 996          else
 997             --  Check the mapping of this file name
 998
 999             File := Mapped_Path_Name (N);
1000
1001             --  If the file name is mapped to a path name, return the
1002             --  corresponding path name
1003
1004             if File /= No_File then
1005                --  For locally removed file, Error_Name is returned; then
1006                --  return No_File, indicating the file is not a source.
1007
1008                if File = Error_Name then
1009                   return No_File;
1010
1011                else
1012                   return File;
1013                end if;
1014             end if;
1015
1016             --  First place to look is in the primary directory (i.e. the same
1017             --  directory as the source) unless this has been disabled with -I-
1018
1019             if Opt.Look_In_Primary_Dir then
1020                File := Locate_File (N, T, Primary_Directory, File_Name);
1021
1022                if File /= No_File then
1023                   return File;
1024                end if;
1025             end if;
1026
1027             --  Finally look in directories specified with switches -I/-aI/-aO
1028
1029             if T = Library then
1030                Last_Dir := Lib_Search_Directories.Last;
1031             else
1032                Last_Dir := Src_Search_Directories.Last;
1033             end if;
1034
1035             for D in Primary_Directory + 1 .. Last_Dir loop
1036                File := Locate_File (N, T, D, File_Name);
1037
1038                if File /= No_File then
1039                   return File;
1040                end if;
1041             end loop;
1042
1043             return No_File;
1044          end if;
1045       end;
1046    end Find_File;
1047
1048    -----------------------
1049    -- Find_Program_Name --
1050    -----------------------
1051
1052    procedure Find_Program_Name is
1053       Command_Name : String (1 .. Len_Arg (0));
1054       Cindex1 : Integer := Command_Name'First;
1055       Cindex2 : Integer := Command_Name'Last;
1056
1057    begin
1058       Fill_Arg (Command_Name'Address, 0);
1059
1060       --  The program name might be specified by a full path name. However,
1061       --  we don't want to print that all out in an error message, so the
1062       --  path might need to be stripped away.
1063
1064       for J in reverse Cindex1 .. Cindex2 loop
1065          if Is_Directory_Separator (Command_Name (J)) then
1066             Cindex1 := J + 1;
1067             exit;
1068          end if;
1069       end loop;
1070
1071       --  Command_Name(Cindex1 .. Cindex2) is now the equivalent of the
1072       --  POSIX command "basename argv[0]"
1073
1074       --  Strip off any versioning information such as found on VMS.
1075       --  This would take the form of TOOL.exe followed by a ";" or "."
1076       --  and a sequence of one or more numbers.
1077
1078       if Command_Name (Cindex2) in '0' .. '9' then
1079          for J in reverse Cindex1 .. Cindex2 loop
1080             if Command_Name (J) = '.' or Command_Name (J) = ';' then
1081                Cindex2 := J - 1;
1082                exit;
1083             end if;
1084
1085             exit when Command_Name (J) not in '0' .. '9';
1086          end loop;
1087       end if;
1088
1089       --  Strip off any executable extension (usually nothing or .exe)
1090       --  but formally reported by autoconf in the variable EXEEXT
1091
1092       if Cindex2 - Cindex1 >= 4 then
1093          if To_Lower (Command_Name (Cindex2 - 3)) = '.'
1094             and then To_Lower (Command_Name (Cindex2 - 2)) = 'e'
1095             and then To_Lower (Command_Name (Cindex2 - 1)) = 'x'
1096             and then To_Lower (Command_Name (Cindex2)) = 'e'
1097          then
1098             Cindex2 := Cindex2 - 4;
1099          end if;
1100       end if;
1101
1102       Name_Len := Cindex2 - Cindex1 + 1;
1103       Name_Buffer (1 .. Name_Len) := Command_Name (Cindex1 .. Cindex2);
1104    end Find_Program_Name;
1105
1106    ------------------------
1107    -- Full_Lib_File_Name --
1108    ------------------------
1109
1110    function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type is
1111    begin
1112       return Find_File (N, Library);
1113    end Full_Lib_File_Name;
1114
1115    ----------------------------
1116    -- Full_Library_Info_Name --
1117    ----------------------------
1118
1119    function Full_Library_Info_Name return File_Name_Type is
1120    begin
1121       return Current_Full_Lib_Name;
1122    end Full_Library_Info_Name;
1123
1124    ---------------------------
1125    -- Full_Object_File_Name --
1126    ---------------------------
1127
1128    function Full_Object_File_Name return File_Name_Type is
1129    begin
1130       return Current_Full_Obj_Name;
1131    end Full_Object_File_Name;
1132
1133    ----------------------
1134    -- Full_Source_Name --
1135    ----------------------
1136
1137    function Full_Source_Name return File_Name_Type is
1138    begin
1139       return Current_Full_Source_Name;
1140    end Full_Source_Name;
1141
1142    ----------------------
1143    -- Full_Source_Name --
1144    ----------------------
1145
1146    function Full_Source_Name (N : File_Name_Type) return File_Name_Type is
1147    begin
1148       return Smart_Find_File (N, Source);
1149    end Full_Source_Name;
1150
1151    -------------------
1152    -- Get_Directory --
1153    -------------------
1154
1155    function Get_Directory (Name : File_Name_Type) return File_Name_Type is
1156    begin
1157       Get_Name_String (Name);
1158
1159       for J in reverse 1 .. Name_Len loop
1160          if Is_Directory_Separator (Name_Buffer (J)) then
1161             Name_Len := J;
1162             return Name_Find;
1163          end if;
1164       end loop;
1165
1166       Name_Len := Hostparm.Normalized_CWD'Length;
1167       Name_Buffer (1 .. Name_Len) := Hostparm.Normalized_CWD;
1168       return Name_Find;
1169    end Get_Directory;
1170
1171    --------------------------
1172    -- Get_Next_Dir_In_Path --
1173    --------------------------
1174
1175    Search_Path_Pos : Integer;
1176    --  Keeps track of current position in search path. Initialized by the
1177    --  call to Get_Next_Dir_In_Path_Init, updated by Get_Next_Dir_In_Path.
1178
1179    function Get_Next_Dir_In_Path
1180      (Search_Path : String_Access) return String_Access
1181    is
1182       Lower_Bound : Positive := Search_Path_Pos;
1183       Upper_Bound : Positive;
1184
1185    begin
1186       loop
1187          while Lower_Bound <= Search_Path'Last
1188            and then Search_Path.all (Lower_Bound) = Path_Separator
1189          loop
1190             Lower_Bound := Lower_Bound + 1;
1191          end loop;
1192
1193          exit when Lower_Bound > Search_Path'Last;
1194
1195          Upper_Bound := Lower_Bound;
1196          while Upper_Bound <= Search_Path'Last
1197            and then Search_Path.all (Upper_Bound) /= Path_Separator
1198          loop
1199             Upper_Bound := Upper_Bound + 1;
1200          end loop;
1201
1202          Search_Path_Pos := Upper_Bound;
1203          return new String'(Search_Path.all (Lower_Bound .. Upper_Bound - 1));
1204       end loop;
1205
1206       return null;
1207    end Get_Next_Dir_In_Path;
1208
1209    -------------------------------
1210    -- Get_Next_Dir_In_Path_Init --
1211    -------------------------------
1212
1213    procedure Get_Next_Dir_In_Path_Init (Search_Path : String_Access) is
1214    begin
1215       Search_Path_Pos := Search_Path'First;
1216    end Get_Next_Dir_In_Path_Init;
1217
1218    --------------------------------------
1219    -- Get_Primary_Src_Search_Directory --
1220    --------------------------------------
1221
1222    function Get_Primary_Src_Search_Directory return String_Ptr is
1223    begin
1224       return Src_Search_Directories.Table (Primary_Directory);
1225    end Get_Primary_Src_Search_Directory;
1226
1227    ------------------------
1228    -- Get_RTS_Search_Dir --
1229    ------------------------
1230
1231    function Get_RTS_Search_Dir
1232      (Search_Dir : String;
1233       File_Type  : Search_File_Type) return String_Ptr
1234    is
1235       procedure Get_Current_Dir
1236         (Dir    : System.Address;
1237          Length : System.Address);
1238       pragma Import (C, Get_Current_Dir, "__gnat_get_current_dir");
1239
1240       Max_Path : Integer;
1241       pragma Import (C, Max_Path, "__gnat_max_path_len");
1242       --  Maximum length of a path name
1243
1244       Current_Dir        : String_Ptr;
1245       Default_Search_Dir : String_Access;
1246       Default_Suffix_Dir : String_Access;
1247       Local_Search_Dir   : String_Access;
1248       Norm_Search_Dir    : String_Access;
1249       Result_Search_Dir  : String_Access;
1250       Search_File        : String_Access;
1251       Temp_String        : String_Ptr;
1252
1253    begin
1254       --  Add a directory separator at the end of the directory if necessary
1255       --  so that we can directly append a file to the directory
1256
1257       if Search_Dir (Search_Dir'Last) /= Directory_Separator then
1258          Local_Search_Dir :=
1259            new String'(Search_Dir & String'(1 => Directory_Separator));
1260       else
1261          Local_Search_Dir := new String'(Search_Dir);
1262       end if;
1263
1264       if File_Type = Include then
1265          Search_File := Include_Search_File;
1266          Default_Suffix_Dir := new String'("adainclude");
1267       else
1268          Search_File := Objects_Search_File;
1269          Default_Suffix_Dir := new String'("adalib");
1270       end if;
1271
1272       Norm_Search_Dir := To_Canonical_Path_Spec (Local_Search_Dir.all);
1273
1274       if Is_Absolute_Path (Norm_Search_Dir.all) then
1275
1276          --  We first verify if there is a directory Include_Search_Dir
1277          --  containing default search directories
1278
1279          Result_Search_Dir
1280            := Read_Default_Search_Dirs (Norm_Search_Dir,
1281                                         Search_File,
1282                                         null);
1283          Default_Search_Dir :=
1284            new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1285          Free (Norm_Search_Dir);
1286
1287          if Result_Search_Dir /= null then
1288             return String_Ptr (Result_Search_Dir);
1289          elsif Is_Directory (Default_Search_Dir.all) then
1290             return String_Ptr (Default_Search_Dir);
1291          else
1292             return null;
1293          end if;
1294
1295       --  Search in the current directory
1296
1297       else
1298          --  Get the current directory
1299
1300          declare
1301             Buffer   : String (1 .. Max_Path + 2);
1302             Path_Len : Natural := Max_Path;
1303
1304          begin
1305             Get_Current_Dir (Buffer'Address, Path_Len'Address);
1306
1307             if Buffer (Path_Len) /= Directory_Separator then
1308                Path_Len := Path_Len + 1;
1309                Buffer (Path_Len) := Directory_Separator;
1310             end if;
1311
1312             Current_Dir := new String'(Buffer (1 .. Path_Len));
1313          end;
1314
1315          Norm_Search_Dir :=
1316            new String'(Current_Dir.all & Local_Search_Dir.all);
1317
1318          Result_Search_Dir :=
1319            Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1320
1321          Default_Search_Dir :=
1322            new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1323
1324          Free (Norm_Search_Dir);
1325
1326          if Result_Search_Dir /= null then
1327             return String_Ptr (Result_Search_Dir);
1328
1329          elsif Is_Directory (Default_Search_Dir.all) then
1330             return String_Ptr (Default_Search_Dir);
1331
1332          else
1333             --  Search in Search_Dir_Prefix/Search_Dir
1334
1335             Norm_Search_Dir :=
1336               new String'
1337                (Update_Path (Search_Dir_Prefix).all & Local_Search_Dir.all);
1338
1339             Result_Search_Dir :=
1340               Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1341
1342             Default_Search_Dir :=
1343               new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1344
1345             Free (Norm_Search_Dir);
1346
1347             if Result_Search_Dir /= null then
1348                return String_Ptr (Result_Search_Dir);
1349
1350             elsif Is_Directory (Default_Search_Dir.all) then
1351                return String_Ptr (Default_Search_Dir);
1352
1353             else
1354                --  We finally search in Search_Dir_Prefix/rts-Search_Dir
1355
1356                Temp_String :=
1357                  new String'(Update_Path (Search_Dir_Prefix).all & "rts-");
1358
1359                Norm_Search_Dir :=
1360                  new String'(Temp_String.all & Local_Search_Dir.all);
1361
1362                Result_Search_Dir :=
1363                  Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1364
1365                Default_Search_Dir :=
1366                  new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
1367                Free (Norm_Search_Dir);
1368
1369                if Result_Search_Dir /= null then
1370                   return String_Ptr (Result_Search_Dir);
1371
1372                elsif Is_Directory (Default_Search_Dir.all) then
1373                   return String_Ptr (Default_Search_Dir);
1374
1375                else
1376                   return null;
1377                end if;
1378             end if;
1379          end if;
1380       end if;
1381    end Get_RTS_Search_Dir;
1382
1383    --------------------------------
1384    -- Include_Dir_Default_Prefix --
1385    --------------------------------
1386
1387    function Include_Dir_Default_Prefix return String is
1388       Include_Dir : String_Access :=
1389                       String_Access (Update_Path (Include_Dir_Default_Name));
1390
1391    begin
1392       if Include_Dir = null then
1393          return "";
1394
1395       else
1396          declare
1397             Result : constant String := Include_Dir.all;
1398          begin
1399             Free (Include_Dir);
1400             return Result;
1401          end;
1402       end if;
1403    end Include_Dir_Default_Prefix;
1404
1405    ----------------
1406    -- Initialize --
1407    ----------------
1408
1409    procedure Initialize is
1410    begin
1411       Number_File_Names       := 0;
1412       Current_File_Name_Index := 0;
1413
1414       Src_Search_Directories.Init;
1415       Lib_Search_Directories.Init;
1416
1417       --  Start off by setting all suppress options to False, these will
1418       --  be reset later (turning some on if -gnato is not specified, and
1419       --  turning all of them on if -gnatp is specified).
1420
1421       Suppress_Options := (others => False);
1422
1423       --  Reserve the first slot in the search paths table. This is the
1424       --  directory of the main source file or main library file and is
1425       --  filled in by each call to Next_Main_Source/Next_Main_Lib_File with
1426       --  the directory specified for this main source or library file. This
1427       --  is the directory which is searched first by default. This default
1428       --  search is inhibited by the option -I- for both source and library
1429       --  files.
1430
1431       Src_Search_Directories.Set_Last (Primary_Directory);
1432       Src_Search_Directories.Table (Primary_Directory) := new String'("");
1433
1434       Lib_Search_Directories.Set_Last (Primary_Directory);
1435       Lib_Search_Directories.Table (Primary_Directory) := new String'("");
1436    end Initialize;
1437
1438    ----------------------------
1439    -- Is_Directory_Separator --
1440    ----------------------------
1441
1442    function Is_Directory_Separator (C : Character) return Boolean is
1443    begin
1444       --  In addition to the default directory_separator allow the '/' to
1445       --  act as separator since this is allowed in MS-DOS, Windows 95/NT,
1446       --  and OS2 ports. On VMS, the situation is more complicated because
1447       --  there are two characters to check for.
1448
1449       return
1450         C = Directory_Separator
1451           or else C = '/'
1452           or else (Hostparm.OpenVMS
1453                     and then (C = ']' or else C = ':'));
1454    end Is_Directory_Separator;
1455
1456    -------------------------
1457    -- Is_Readonly_Library --
1458    -------------------------
1459
1460    function Is_Readonly_Library (File : File_Name_Type) return Boolean is
1461    begin
1462       Get_Name_String (File);
1463
1464       pragma Assert (Name_Buffer (Name_Len - 3 .. Name_Len) = ".ali");
1465
1466       return not Is_Writable_File (Name_Buffer (1 .. Name_Len));
1467    end Is_Readonly_Library;
1468
1469    -------------------
1470    -- Lib_File_Name --
1471    -------------------
1472
1473    function Lib_File_Name
1474      (Source_File : File_Name_Type;
1475       Munit_Index : Nat := 0) return File_Name_Type
1476    is
1477    begin
1478       Get_Name_String (Source_File);
1479
1480       for J in reverse 2 .. Name_Len loop
1481          if Name_Buffer (J) = '.' then
1482             Name_Len := J - 1;
1483             exit;
1484          end if;
1485       end loop;
1486
1487       if Munit_Index /= 0 then
1488          Add_Char_To_Name_Buffer (Multi_Unit_Index_Character);
1489          Add_Nat_To_Name_Buffer (Munit_Index);
1490       end if;
1491
1492       Add_Char_To_Name_Buffer ('.');
1493       Add_Str_To_Name_Buffer (ALI_Suffix.all);
1494       return Name_Find;
1495    end Lib_File_Name;
1496
1497    ------------------------
1498    -- Library_File_Stamp --
1499    ------------------------
1500
1501    function Library_File_Stamp (N : File_Name_Type) return Time_Stamp_Type is
1502    begin
1503       return File_Stamp (Find_File (N, Library));
1504    end Library_File_Stamp;
1505
1506    -----------------
1507    -- Locate_File --
1508    -----------------
1509
1510    function Locate_File
1511      (N    : File_Name_Type;
1512       T    : File_Type;
1513       Dir  : Natural;
1514       Name : String) return File_Name_Type
1515    is
1516       Dir_Name : String_Ptr;
1517
1518    begin
1519       --  If Name is already an absolute path, do not look for a directory
1520
1521       if Is_Absolute_Path (Name) then
1522          Dir_Name := No_Dir;
1523
1524       elsif T = Library then
1525          Dir_Name := Lib_Search_Directories.Table (Dir);
1526
1527       else pragma Assert (T /= Config);
1528          Dir_Name := Src_Search_Directories.Table (Dir);
1529       end if;
1530
1531       declare
1532          Full_Name : String (1 .. Dir_Name'Length + Name'Length);
1533
1534       begin
1535          Full_Name (1 .. Dir_Name'Length) := Dir_Name.all;
1536          Full_Name (Dir_Name'Length + 1 .. Full_Name'Length) := Name;
1537
1538          if not Is_Regular_File (Full_Name) then
1539             return No_File;
1540
1541          else
1542             --  If the file is in the current directory then return N itself
1543
1544             if Dir_Name'Length = 0 then
1545                return N;
1546             else
1547                Name_Len := Full_Name'Length;
1548                Name_Buffer (1 .. Name_Len) := Full_Name;
1549                return Name_Enter;
1550             end if;
1551          end if;
1552       end;
1553    end Locate_File;
1554
1555    -------------------------------
1556    -- Matching_Full_Source_Name --
1557    -------------------------------
1558
1559    function Matching_Full_Source_Name
1560      (N : File_Name_Type;
1561       T : Time_Stamp_Type) return File_Name_Type
1562    is
1563    begin
1564       Get_Name_String (N);
1565
1566       declare
1567          File_Name : constant String := Name_Buffer (1 .. Name_Len);
1568          File      : File_Name_Type := No_File;
1569          Last_Dir  : Natural;
1570
1571       begin
1572          if Opt.Look_In_Primary_Dir then
1573             File := Locate_File (N, Source, Primary_Directory, File_Name);
1574
1575             if File /= No_File and then T = File_Stamp (N) then
1576                return File;
1577             end if;
1578          end if;
1579
1580          Last_Dir := Src_Search_Directories.Last;
1581
1582          for D in Primary_Directory + 1 .. Last_Dir loop
1583             File := Locate_File (N, Source, D, File_Name);
1584
1585             if File /= No_File and then T = File_Stamp (File) then
1586                return File;
1587             end if;
1588          end loop;
1589
1590          return No_File;
1591       end;
1592    end Matching_Full_Source_Name;
1593
1594    ----------------
1595    -- More_Files --
1596    ----------------
1597
1598    function More_Files return Boolean is
1599    begin
1600       return (Current_File_Name_Index < Number_File_Names);
1601    end More_Files;
1602
1603    -------------------------------
1604    -- Nb_Dir_In_Obj_Search_Path --
1605    -------------------------------
1606
1607    function Nb_Dir_In_Obj_Search_Path return Natural is
1608    begin
1609       if Opt.Look_In_Primary_Dir then
1610          return Lib_Search_Directories.Last -  Primary_Directory + 1;
1611       else
1612          return Lib_Search_Directories.Last -  Primary_Directory;
1613       end if;
1614    end Nb_Dir_In_Obj_Search_Path;
1615
1616    -------------------------------
1617    -- Nb_Dir_In_Src_Search_Path --
1618    -------------------------------
1619
1620    function Nb_Dir_In_Src_Search_Path return Natural is
1621    begin
1622       if Opt.Look_In_Primary_Dir then
1623          return Src_Search_Directories.Last -  Primary_Directory + 1;
1624       else
1625          return Src_Search_Directories.Last -  Primary_Directory;
1626       end if;
1627    end Nb_Dir_In_Src_Search_Path;
1628
1629    --------------------
1630    -- Next_Main_File --
1631    --------------------
1632
1633    function Next_Main_File return File_Name_Type is
1634       File_Name : String_Ptr;
1635       Dir_Name  : String_Ptr;
1636       Fptr      : Natural;
1637
1638    begin
1639       pragma Assert (More_Files);
1640
1641       Current_File_Name_Index := Current_File_Name_Index + 1;
1642
1643       --  Get the file and directory name
1644
1645       File_Name := File_Names (Current_File_Name_Index);
1646       Fptr := File_Name'First;
1647
1648       for J in reverse File_Name'Range loop
1649          if File_Name (J) = Directory_Separator
1650            or else File_Name (J) = '/'
1651          then
1652             if J = File_Name'Last then
1653                Fail ("File name missing");
1654             end if;
1655
1656             Fptr := J + 1;
1657             exit;
1658          end if;
1659       end loop;
1660
1661       --  Save name of directory in which main unit resides for use in
1662       --  locating other units
1663
1664       Dir_Name := new String'(File_Name (File_Name'First .. Fptr - 1));
1665
1666       case Running_Program is
1667
1668          when Compiler =>
1669             Src_Search_Directories.Table (Primary_Directory) := Dir_Name;
1670             Look_In_Primary_Directory_For_Current_Main := True;
1671
1672          when Make =>
1673             Src_Search_Directories.Table (Primary_Directory) := Dir_Name;
1674
1675             if Fptr > File_Name'First then
1676                Look_In_Primary_Directory_For_Current_Main := True;
1677             end if;
1678
1679          when Binder | Gnatls =>
1680             Dir_Name := Normalize_Directory_Name (Dir_Name.all);
1681             Lib_Search_Directories.Table (Primary_Directory) := Dir_Name;
1682
1683          when Unspecified =>
1684             null;
1685       end case;
1686
1687       Name_Len := File_Name'Last - Fptr + 1;
1688       Name_Buffer (1 .. Name_Len) := File_Name (Fptr .. File_Name'Last);
1689       Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1690       Current_Main := File_Name_Type (Name_Find);
1691
1692       --  In the gnatmake case, the main file may have not have the
1693       --  extension. Try ".adb" first then ".ads"
1694
1695       if Running_Program = Make then
1696          declare
1697             Orig_Main : constant File_Name_Type := Current_Main;
1698
1699          begin
1700             if Strip_Suffix (Orig_Main) = Orig_Main then
1701                Current_Main := Append_Suffix_To_File_Name (Orig_Main, ".adb");
1702
1703                if Full_Source_Name (Current_Main) = No_File then
1704                   Current_Main :=
1705                     Append_Suffix_To_File_Name (Orig_Main, ".ads");
1706
1707                   if Full_Source_Name (Current_Main) = No_File then
1708                      Current_Main := Orig_Main;
1709                   end if;
1710                end if;
1711             end if;
1712          end;
1713       end if;
1714
1715       return Current_Main;
1716    end Next_Main_File;
1717
1718    ------------------------------
1719    -- Normalize_Directory_Name --
1720    ------------------------------
1721
1722    function Normalize_Directory_Name (Directory : String) return String_Ptr is
1723
1724       function Is_Quoted (Path : String) return Boolean;
1725       pragma Inline (Is_Quoted);
1726       --  Returns true if Path is quoted (either double or single quotes)
1727
1728       ---------------
1729       -- Is_Quoted --
1730       ---------------
1731
1732       function Is_Quoted (Path : String) return Boolean is
1733          First : constant Character := Path (Path'First);
1734          Last  : constant Character := Path (Path'Last);
1735
1736       begin
1737          if (First = ''' and then Last = ''')
1738                or else
1739             (First = '"' and then Last = '"')
1740          then
1741             return True;
1742          else
1743             return False;
1744          end if;
1745       end Is_Quoted;
1746
1747       Result : String_Ptr;
1748
1749    --  Start of processing for Normalize_Directory_Name
1750
1751    begin
1752       if Directory'Length = 0 then
1753          Result := new String'(Hostparm.Normalized_CWD);
1754
1755       elsif Is_Directory_Separator (Directory (Directory'Last)) then
1756          Result := new String'(Directory);
1757
1758       elsif Is_Quoted (Directory) then
1759
1760          --  This is a quoted string, it certainly means that the directory
1761          --  contains some spaces for example. We can safely remove the quotes
1762          --  here as the OS_Lib.Normalize_Arguments will be called before any
1763          --  spawn routines. This ensure that quotes will be added when needed.
1764
1765          Result := new String (1 .. Directory'Length - 1);
1766          Result (1 .. Directory'Length - 2) :=
1767            Directory (Directory'First + 1 .. Directory'Last - 1);
1768          Result (Result'Last) := Directory_Separator;
1769
1770       else
1771          Result := new String (1 .. Directory'Length + 1);
1772          Result (1 .. Directory'Length) := Directory;
1773          Result (Directory'Length + 1) := Directory_Separator;
1774       end if;
1775
1776       return Result;
1777    end Normalize_Directory_Name;
1778
1779    ---------------------
1780    -- Number_Of_Files --
1781    ---------------------
1782
1783    function Number_Of_Files return Int is
1784    begin
1785       return Number_File_Names;
1786    end Number_Of_Files;
1787
1788    -------------------------------
1789    -- Object_Dir_Default_Prefix --
1790    -------------------------------
1791
1792    function Object_Dir_Default_Prefix return String is
1793       Object_Dir : String_Access :=
1794                      String_Access (Update_Path (Object_Dir_Default_Name));
1795
1796    begin
1797       if Object_Dir = null then
1798          return "";
1799
1800       else
1801          declare
1802             Result : constant String := Object_Dir.all;
1803          begin
1804             Free (Object_Dir);
1805             return Result;
1806          end;
1807       end if;
1808    end Object_Dir_Default_Prefix;
1809
1810    ----------------------
1811    -- Object_File_Name --
1812    ----------------------
1813
1814    function Object_File_Name (N : File_Name_Type) return File_Name_Type is
1815    begin
1816       if N = No_File then
1817          return No_File;
1818       end if;
1819
1820       Get_Name_String (N);
1821       Name_Len := Name_Len - ALI_Suffix'Length - 1;
1822
1823       for J in Target_Object_Suffix'Range loop
1824          Name_Len := Name_Len + 1;
1825          Name_Buffer (Name_Len) := Target_Object_Suffix (J);
1826       end loop;
1827
1828       return Name_Enter;
1829    end Object_File_Name;
1830
1831    --------------------------
1832    -- OS_Time_To_GNAT_Time --
1833    --------------------------
1834
1835    function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type is
1836       GNAT_Time : Time_Stamp_Type;
1837
1838       Y  : Year_Type;
1839       Mo : Month_Type;
1840       D  : Day_Type;
1841       H  : Hour_Type;
1842       Mn : Minute_Type;
1843       S  : Second_Type;
1844
1845    begin
1846       GM_Split (T, Y, Mo, D, H, Mn, S);
1847       Make_Time_Stamp
1848         (Year    => Nat (Y),
1849          Month   => Nat (Mo),
1850          Day     => Nat (D),
1851          Hour    => Nat (H),
1852          Minutes => Nat (Mn),
1853          Seconds => Nat (S),
1854          TS      => GNAT_Time);
1855
1856       return GNAT_Time;
1857    end OS_Time_To_GNAT_Time;
1858
1859    ------------------
1860    -- Program_Name --
1861    ------------------
1862
1863    function Program_Name (Nam : String) return String_Access is
1864       Res : String_Access;
1865
1866    begin
1867       --  Get the name of the current program being executed
1868
1869       Find_Program_Name;
1870
1871       --  Find the target prefix if any, for the cross compilation case
1872       --  for instance in "alpha-dec-vxworks-gcc" the target prefix is
1873       --  "alpha-dec-vxworks-"
1874
1875       while Name_Len > 0  loop
1876
1877          --  All done if we find the last hyphen
1878
1879          if Name_Buffer (Name_Len) = '-' then
1880             exit;
1881
1882          --  If directory separator found, we don't want to look further
1883          --  since in this case, no prefix has been found.
1884
1885          elsif Is_Directory_Separator (Name_Buffer (Name_Len)) then
1886             Name_Len := 0;
1887             exit;
1888          end if;
1889
1890          Name_Len := Name_Len - 1;
1891       end loop;
1892
1893       --  Create the new program name
1894
1895       Res := new String (1 .. Name_Len + Nam'Length);
1896       Res.all (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
1897       Res.all (Name_Len + 1 .. Name_Len + Nam'Length) := Nam;
1898       return Res;
1899    end Program_Name;
1900
1901    ------------------------------
1902    -- Read_Default_Search_Dirs --
1903    ------------------------------
1904
1905    function Read_Default_Search_Dirs
1906      (Search_Dir_Prefix       : String_Access;
1907       Search_File             : String_Access;
1908       Search_Dir_Default_Name : String_Access) return String_Access
1909    is
1910       Prefix_Len : constant Integer := Search_Dir_Prefix.all'Length;
1911       Buffer     : String (1 .. Prefix_Len + Search_File.all'Length + 1);
1912       File_FD    : File_Descriptor;
1913       S, S1      : String_Access;
1914       Len        : Integer;
1915       Curr       : Integer;
1916       Actual_Len : Integer;
1917       J1         : Integer;
1918
1919       Prev_Was_Separator : Boolean;
1920       Nb_Relative_Dir    : Integer;
1921
1922       function Is_Relative (S : String; K : Positive) return Boolean;
1923       pragma Inline (Is_Relative);
1924       --  Returns True if a relative directory specification is found
1925       --  in S at position K, False otherwise.
1926
1927       -----------------
1928       -- Is_Relative --
1929       -----------------
1930
1931       function Is_Relative (S : String; K : Positive) return Boolean is
1932       begin
1933          return not Is_Absolute_Path (S (K .. S'Last));
1934       end Is_Relative;
1935
1936    --  Start of processing for Read_Default_Search_Dirs
1937
1938    begin
1939       --  Construct a C compatible character string buffer
1940
1941       Buffer (1 .. Search_Dir_Prefix.all'Length)
1942         := Search_Dir_Prefix.all;
1943       Buffer (Search_Dir_Prefix.all'Length + 1 .. Buffer'Last - 1)
1944         := Search_File.all;
1945       Buffer (Buffer'Last) := ASCII.NUL;
1946
1947       File_FD := Open_Read (Buffer'Address, Binary);
1948       if File_FD = Invalid_FD then
1949          return Search_Dir_Default_Name;
1950       end if;
1951
1952       Len := Integer (File_Length (File_FD));
1953
1954       --  An extra character for a trailing Path_Separator is allocated
1955
1956       S := new String (1 .. Len + 1);
1957       S (Len + 1) := Path_Separator;
1958
1959       --  Read the file. Note that the loop is not necessary since the
1960       --  whole file is read at once except on VMS.
1961
1962       Curr := 1;
1963       Actual_Len := Len;
1964       while Actual_Len /= 0 loop
1965          Actual_Len := Read (File_FD, S (Curr)'Address, Len);
1966          Curr := Curr + Actual_Len;
1967       end loop;
1968
1969       --  Process the file, translating line and file ending
1970       --  control characters to a path separator character.
1971
1972       Prev_Was_Separator := True;
1973       Nb_Relative_Dir := 0;
1974       for J in 1 .. Len loop
1975          if S (J) in ASCII.NUL .. ASCII.US
1976            or else S (J) = ' '
1977          then
1978             S (J) := Path_Separator;
1979          end if;
1980
1981          if S (J) = Path_Separator then
1982             Prev_Was_Separator := True;
1983          else
1984             if Prev_Was_Separator and then Is_Relative (S.all, J) then
1985                Nb_Relative_Dir := Nb_Relative_Dir + 1;
1986             end if;
1987
1988             Prev_Was_Separator := False;
1989          end if;
1990       end loop;
1991
1992       if Nb_Relative_Dir = 0 then
1993          return S;
1994       end if;
1995
1996       --  Add the Search_Dir_Prefix to all relative paths
1997
1998       S1 := new String (1 .. S'Length + Nb_Relative_Dir * Prefix_Len);
1999       J1 := 1;
2000       Prev_Was_Separator := True;
2001       for J in 1 .. Len + 1 loop
2002          if S (J) = Path_Separator then
2003             Prev_Was_Separator := True;
2004
2005          else
2006             if Prev_Was_Separator and then Is_Relative (S.all, J) then
2007                S1 (J1 .. J1 + Prefix_Len - 1) := Search_Dir_Prefix.all;
2008                J1 := J1 + Prefix_Len;
2009             end if;
2010
2011             Prev_Was_Separator := False;
2012          end if;
2013          S1 (J1) := S (J);
2014          J1 := J1 + 1;
2015       end loop;
2016
2017       Free (S);
2018       return S1;
2019    end Read_Default_Search_Dirs;
2020
2021    -----------------------
2022    -- Read_Library_Info --
2023    -----------------------
2024
2025    function Read_Library_Info
2026      (Lib_File  : File_Name_Type;
2027       Fatal_Err : Boolean := False) return Text_Buffer_Ptr
2028    is
2029       Lib_FD : File_Descriptor;
2030       --  The file descriptor for the current library file. A negative value
2031       --  indicates failure to open the specified source file.
2032
2033       Text : Text_Buffer_Ptr;
2034       --  Allocated text buffer
2035
2036       Status : Boolean;
2037       --  For the calls to Close
2038
2039    begin
2040       Current_Full_Lib_Name := Find_File (Lib_File, Library);
2041       Current_Full_Obj_Name := Object_File_Name (Current_Full_Lib_Name);
2042
2043       if Current_Full_Lib_Name = No_File then
2044          if Fatal_Err then
2045             Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len));
2046          else
2047             Current_Full_Obj_Stamp := Empty_Time_Stamp;
2048             return null;
2049          end if;
2050       end if;
2051
2052       Get_Name_String (Current_Full_Lib_Name);
2053       Name_Buffer (Name_Len + 1) := ASCII.NUL;
2054
2055       --  Open the library FD, note that we open in binary mode, because as
2056       --  documented in the spec, the caller is expected to handle either
2057       --  DOS or Unix mode files, and there is no point in wasting time on
2058       --  text translation when it is not required.
2059
2060       Lib_FD := Open_Read (Name_Buffer'Address, Binary);
2061
2062       if Lib_FD = Invalid_FD then
2063          if Fatal_Err then
2064             Fail ("Cannot open: ",  Name_Buffer (1 .. Name_Len));
2065          else
2066             Current_Full_Obj_Stamp := Empty_Time_Stamp;
2067             return null;
2068          end if;
2069       end if;
2070
2071       --  Check for object file consistency if requested
2072
2073       if Opt.Check_Object_Consistency then
2074          Current_Full_Lib_Stamp := File_Stamp (Current_Full_Lib_Name);
2075          Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
2076
2077          if Current_Full_Obj_Stamp (1) = ' ' then
2078
2079             --  When the library is readonly, always assume that
2080             --  the object is consistent.
2081
2082             if Is_Readonly_Library (Current_Full_Lib_Name) then
2083                Current_Full_Obj_Stamp := Current_Full_Lib_Stamp;
2084
2085             elsif Fatal_Err then
2086                Get_Name_String (Current_Full_Obj_Name);
2087                Close (Lib_FD, Status);
2088                --  No need to check the status, we fail anyway
2089
2090                Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len));
2091
2092             else
2093                Current_Full_Obj_Stamp := Empty_Time_Stamp;
2094                Close (Lib_FD, Status);
2095
2096                --  No need to check the status, we return null anyway
2097
2098                return null;
2099             end if;
2100          end if;
2101       end if;
2102
2103       --  Read data from the file
2104
2105       declare
2106          Len : constant Integer := Integer (File_Length (Lib_FD));
2107          --  Length of source file text. If it doesn't fit in an integer
2108          --  we're probably stuck anyway (>2 gigs of source seems a lot!)
2109
2110          Actual_Len : Integer := 0;
2111
2112          Lo : constant Text_Ptr := 0;
2113          --  Low bound for allocated text buffer
2114
2115          Hi : Text_Ptr := Text_Ptr (Len);
2116          --  High bound for allocated text buffer. Note length is Len + 1
2117          --  which allows for extra EOF character at the end of the buffer.
2118
2119       begin
2120          --  Allocate text buffer. Note extra character at end for EOF
2121
2122          Text := new Text_Buffer (Lo .. Hi);
2123
2124          --  Some systems (e.g. VMS) have file types that require one
2125          --  read per line, so read until we get the Len bytes or until
2126          --  there are no more characters.
2127
2128          Hi := Lo;
2129          loop
2130             Actual_Len := Read (Lib_FD, Text (Hi)'Address, Len);
2131             Hi := Hi + Text_Ptr (Actual_Len);
2132             exit when Actual_Len = Len or Actual_Len <= 0;
2133          end loop;
2134
2135          Text (Hi) := EOF;
2136       end;
2137
2138       --  Read is complete, close file and we are done
2139
2140       Close (Lib_FD, Status);
2141       --  The status should never be False. But, if it is, what can we do?
2142       --  So, we don't test it.
2143
2144       return Text;
2145
2146    end Read_Library_Info;
2147
2148    ----------------------
2149    -- Read_Source_File --
2150    ----------------------
2151
2152    procedure Read_Source_File
2153      (N   : File_Name_Type;
2154       Lo  : Source_Ptr;
2155       Hi  : out Source_Ptr;
2156       Src : out Source_Buffer_Ptr;
2157       T   : File_Type := Source)
2158    is
2159       Source_File_FD : File_Descriptor;
2160       --  The file descriptor for the current source file. A negative value
2161       --  indicates failure to open the specified source file.
2162
2163       Len : Integer;
2164       --  Length of file. Assume no more than 2 gigabytes of source!
2165
2166       Actual_Len : Integer;
2167
2168       Status : Boolean;
2169       --  For the call to Close
2170
2171    begin
2172       Current_Full_Source_Name  := Find_File (N, T);
2173       Current_Full_Source_Stamp := File_Stamp (Current_Full_Source_Name);
2174
2175       if Current_Full_Source_Name = No_File then
2176
2177          --  If we were trying to access the main file and we could not
2178          --  find it we have an error.
2179
2180          if N = Current_Main then
2181             Get_Name_String (N);
2182             Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len));
2183          end if;
2184
2185          Src := null;
2186          Hi  := No_Location;
2187          return;
2188       end if;
2189
2190       Get_Name_String (Current_Full_Source_Name);
2191       Name_Buffer (Name_Len + 1) := ASCII.NUL;
2192
2193       --  Open the source FD, note that we open in binary mode, because as
2194       --  documented in the spec, the caller is expected to handle either
2195       --  DOS or Unix mode files, and there is no point in wasting time on
2196       --  text translation when it is not required.
2197
2198       Source_File_FD := Open_Read (Name_Buffer'Address, Binary);
2199
2200       if Source_File_FD = Invalid_FD then
2201          Src := null;
2202          Hi  := No_Location;
2203          return;
2204       end if;
2205
2206       --  Prepare to read data from the file
2207
2208       Len := Integer (File_Length (Source_File_FD));
2209
2210       --  Set Hi so that length is one more than the physical length,
2211       --  allowing for the extra EOF character at the end of the buffer
2212
2213       Hi := Lo + Source_Ptr (Len);
2214
2215       --  Do the actual read operation
2216
2217       declare
2218          subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
2219          --  Physical buffer allocated
2220
2221          type Actual_Source_Ptr is access Actual_Source_Buffer;
2222          --  This is the pointer type for the physical buffer allocated
2223
2224          Actual_Ptr : constant Actual_Source_Ptr := new Actual_Source_Buffer;
2225          --  And this is the actual physical buffer
2226
2227       begin
2228          --  Allocate source buffer, allowing extra character at end for EOF
2229
2230          --  Some systems (e.g. VMS) have file types that require one
2231          --  read per line, so read until we get the Len bytes or until
2232          --  there are no more characters.
2233
2234          Hi := Lo;
2235          loop
2236             Actual_Len := Read (Source_File_FD, Actual_Ptr (Hi)'Address, Len);
2237             Hi := Hi + Source_Ptr (Actual_Len);
2238             exit when Actual_Len = Len or Actual_Len <= 0;
2239          end loop;
2240
2241          Actual_Ptr (Hi) := EOF;
2242
2243          --  Now we need to work out the proper virtual origin pointer to
2244          --  return. This is exactly Actual_Ptr (0)'Address, but we have
2245          --  to be careful to suppress checks to compute this address.
2246
2247          declare
2248             pragma Suppress (All_Checks);
2249
2250             pragma Warnings (Off);
2251             --  This use of unchecked conversion is aliasing safe
2252
2253             function To_Source_Buffer_Ptr is new
2254               Unchecked_Conversion (Address, Source_Buffer_Ptr);
2255
2256             pragma Warnings (On);
2257
2258          begin
2259             Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
2260          end;
2261       end;
2262
2263       --  Read is complete, get time stamp and close file and we are done
2264
2265       Close (Source_File_FD, Status);
2266
2267       --  The status should never be False. But, if it is, what can we do?
2268       --  So, we don't test it.
2269
2270    end Read_Source_File;
2271
2272    -------------------
2273    -- Relocate_Path --
2274    -------------------
2275
2276    function Relocate_Path
2277      (Prefix : String;
2278       Path   : String) return String_Ptr
2279    is
2280       S : String_Ptr;
2281
2282       procedure set_std_prefix (S : String; Len : Integer);
2283       pragma Import (C, set_std_prefix);
2284
2285    begin
2286       if Std_Prefix = null then
2287          Std_Prefix := Executable_Prefix;
2288
2289          if Std_Prefix.all /= "" then
2290
2291             --  Remove trailing directory separator when calling set_std_prefix
2292
2293             set_std_prefix (Std_Prefix.all, Std_Prefix'Length - 1);
2294          end if;
2295       end if;
2296
2297       if Path (Prefix'Range) = Prefix then
2298          if Std_Prefix.all /= "" then
2299             S := new String
2300               (1 .. Std_Prefix'Length + Path'Last - Prefix'Last);
2301             S (1 .. Std_Prefix'Length) := Std_Prefix.all;
2302             S (Std_Prefix'Length + 1 .. S'Last) :=
2303               Path (Prefix'Last + 1 .. Path'Last);
2304             return S;
2305          end if;
2306       end if;
2307
2308       return new String'(Path);
2309    end Relocate_Path;
2310
2311    -----------------
2312    -- Set_Program --
2313    -----------------
2314
2315    procedure Set_Program (P : Program_Type) is
2316    begin
2317       if Program_Set then
2318          Fail ("Set_Program called twice");
2319       end if;
2320
2321       Program_Set := True;
2322       Running_Program := P;
2323    end Set_Program;
2324
2325    ----------------
2326    -- Shared_Lib --
2327    ----------------
2328
2329    function Shared_Lib (Name : String) return String is
2330       Library : String (1 .. Name'Length + Library_Version'Length + 3);
2331       --  3 = 2 for "-l" + 1 for "-" before lib version
2332
2333    begin
2334       Library (1 .. 2)                          := "-l";
2335       Library (3 .. 2 + Name'Length)            := Name;
2336       Library (3 + Name'Length)                 := '-';
2337       Library (4 + Name'Length .. Library'Last) := Library_Version;
2338
2339       if OpenVMS_On_Target then
2340          for K in Library'First + 2 .. Library'Last loop
2341             if Library (K) = '.' or else Library (K) = '-' then
2342                Library (K) := '_';
2343             end if;
2344          end loop;
2345       end if;
2346
2347       return Library;
2348    end Shared_Lib;
2349
2350    ----------------------
2351    -- Smart_File_Stamp --
2352    ----------------------
2353
2354    function Smart_File_Stamp
2355      (N : File_Name_Type;
2356       T : File_Type) return Time_Stamp_Type
2357    is
2358       Time_Stamp : Time_Stamp_Type;
2359
2360    begin
2361       if not File_Cache_Enabled then
2362          return File_Stamp (Find_File (N, T));
2363       end if;
2364
2365       Time_Stamp := File_Stamp_Hash_Table.Get (N);
2366
2367       if Time_Stamp (1) = ' ' then
2368          Time_Stamp := File_Stamp (Smart_Find_File (N, T));
2369          File_Stamp_Hash_Table.Set (N, Time_Stamp);
2370       end if;
2371
2372       return Time_Stamp;
2373    end Smart_File_Stamp;
2374
2375    ---------------------
2376    -- Smart_Find_File --
2377    ---------------------
2378
2379    function Smart_Find_File
2380      (N : File_Name_Type;
2381       T : File_Type) return File_Name_Type
2382    is
2383       Full_File_Name : File_Name_Type;
2384
2385    begin
2386       if not File_Cache_Enabled then
2387          return Find_File (N, T);
2388       end if;
2389
2390       Full_File_Name := File_Name_Hash_Table.Get (N);
2391
2392       if Full_File_Name = No_File then
2393          Full_File_Name := Find_File (N, T);
2394          File_Name_Hash_Table.Set (N, Full_File_Name);
2395       end if;
2396
2397       return Full_File_Name;
2398    end Smart_Find_File;
2399
2400    ----------------------
2401    -- Source_File_Data --
2402    ----------------------
2403
2404    procedure Source_File_Data (Cache : Boolean) is
2405    begin
2406       File_Cache_Enabled := Cache;
2407    end Source_File_Data;
2408
2409    -----------------------
2410    -- Source_File_Stamp --
2411    -----------------------
2412
2413    function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type is
2414    begin
2415       return Smart_File_Stamp (N, Source);
2416    end Source_File_Stamp;
2417
2418    ---------------------
2419    -- Strip_Directory --
2420    ---------------------
2421
2422    function Strip_Directory (Name : File_Name_Type) return File_Name_Type is
2423    begin
2424       Get_Name_String (Name);
2425
2426       for J in reverse 1 .. Name_Len - 1 loop
2427
2428          --  If we find the last directory separator
2429
2430          if Is_Directory_Separator (Name_Buffer (J)) then
2431
2432             --  Return the part of Name that follows this last directory
2433             --  separator.
2434
2435             Name_Buffer (1 .. Name_Len - J) := Name_Buffer (J + 1 .. Name_Len);
2436             Name_Len := Name_Len - J;
2437             return Name_Find;
2438          end if;
2439       end loop;
2440
2441       --  There were no directory separator, just return Name
2442
2443       return Name;
2444    end Strip_Directory;
2445
2446    ------------------
2447    -- Strip_Suffix --
2448    ------------------
2449
2450    function Strip_Suffix (Name : File_Name_Type) return File_Name_Type is
2451    begin
2452       Get_Name_String (Name);
2453
2454       for J in reverse 2 .. Name_Len loop
2455
2456          --  If we found the last '.', return part of Name that precedes it
2457
2458          if Name_Buffer (J) = '.' then
2459             Name_Len := J - 1;
2460             return Name_Enter;
2461          end if;
2462       end loop;
2463
2464       return Name;
2465    end Strip_Suffix;
2466
2467    ---------------------------
2468    -- To_Canonical_Dir_Spec --
2469    ---------------------------
2470
2471    function To_Canonical_Dir_Spec
2472      (Host_Dir     : String;
2473       Prefix_Style : Boolean) return String_Access
2474    is
2475       function To_Canonical_Dir_Spec
2476         (Host_Dir    : Address;
2477          Prefix_Flag : Integer) return Address;
2478       pragma Import (C, To_Canonical_Dir_Spec, "__gnat_to_canonical_dir_spec");
2479
2480       C_Host_Dir      : String (1 .. Host_Dir'Length + 1);
2481       Canonical_Dir_Addr : Address;
2482       Canonical_Dir_Len  : Integer;
2483
2484    begin
2485       C_Host_Dir (1 .. Host_Dir'Length) := Host_Dir;
2486       C_Host_Dir (C_Host_Dir'Last)      := ASCII.NUL;
2487
2488       if Prefix_Style then
2489          Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 1);
2490       else
2491          Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 0);
2492       end if;
2493       Canonical_Dir_Len := C_String_Length (Canonical_Dir_Addr);
2494
2495       if Canonical_Dir_Len = 0 then
2496          return null;
2497       else
2498          return To_Path_String_Access (Canonical_Dir_Addr, Canonical_Dir_Len);
2499       end if;
2500
2501    exception
2502       when others =>
2503          Fail ("erroneous directory spec: ", Host_Dir);
2504          return null;
2505    end To_Canonical_Dir_Spec;
2506
2507    ---------------------------
2508    -- To_Canonical_File_List --
2509    ---------------------------
2510
2511    function To_Canonical_File_List
2512      (Wildcard_Host_File : String;
2513       Only_Dirs          : Boolean) return String_Access_List_Access
2514    is
2515       function To_Canonical_File_List_Init
2516         (Host_File : Address;
2517          Only_Dirs : Integer) return Integer;
2518       pragma Import (C, To_Canonical_File_List_Init,
2519                      "__gnat_to_canonical_file_list_init");
2520
2521       function To_Canonical_File_List_Next return Address;
2522       pragma Import (C, To_Canonical_File_List_Next,
2523                      "__gnat_to_canonical_file_list_next");
2524
2525       procedure To_Canonical_File_List_Free;
2526       pragma Import (C, To_Canonical_File_List_Free,
2527                      "__gnat_to_canonical_file_list_free");
2528
2529       Num_Files            : Integer;
2530       C_Wildcard_Host_File : String (1 .. Wildcard_Host_File'Length + 1);
2531
2532    begin
2533       C_Wildcard_Host_File (1 .. Wildcard_Host_File'Length) :=
2534         Wildcard_Host_File;
2535       C_Wildcard_Host_File (C_Wildcard_Host_File'Last) := ASCII.NUL;
2536
2537       --  Do the expansion and say how many there are
2538
2539       Num_Files := To_Canonical_File_List_Init
2540          (C_Wildcard_Host_File'Address, Boolean'Pos (Only_Dirs));
2541
2542       declare
2543          Canonical_File_List : String_Access_List (1 .. Num_Files);
2544          Canonical_File_Addr : Address;
2545          Canonical_File_Len  : Integer;
2546
2547       begin
2548          --  Retrieve the expanded directoy names and build the list
2549
2550          for J in 1 .. Num_Files loop
2551             Canonical_File_Addr := To_Canonical_File_List_Next;
2552             Canonical_File_Len  := C_String_Length (Canonical_File_Addr);
2553             Canonical_File_List (J) := To_Path_String_Access
2554                   (Canonical_File_Addr, Canonical_File_Len);
2555          end loop;
2556
2557          --  Free up the storage
2558
2559          To_Canonical_File_List_Free;
2560
2561          return new String_Access_List'(Canonical_File_List);
2562       end;
2563    end To_Canonical_File_List;
2564
2565    ----------------------------
2566    -- To_Canonical_File_Spec --
2567    ----------------------------
2568
2569    function To_Canonical_File_Spec
2570      (Host_File : String) return String_Access
2571    is
2572       function To_Canonical_File_Spec (Host_File : Address) return Address;
2573       pragma Import
2574         (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
2575
2576       C_Host_File      : String (1 .. Host_File'Length + 1);
2577       Canonical_File_Addr : Address;
2578       Canonical_File_Len  : Integer;
2579
2580    begin
2581       C_Host_File (1 .. Host_File'Length) := Host_File;
2582       C_Host_File (C_Host_File'Last)      := ASCII.NUL;
2583
2584       Canonical_File_Addr := To_Canonical_File_Spec (C_Host_File'Address);
2585       Canonical_File_Len  := C_String_Length (Canonical_File_Addr);
2586
2587       if Canonical_File_Len = 0 then
2588          return null;
2589       else
2590          return To_Path_String_Access
2591                   (Canonical_File_Addr, Canonical_File_Len);
2592       end if;
2593
2594    exception
2595       when others =>
2596          Fail ("erroneous file spec: ", Host_File);
2597          return null;
2598    end To_Canonical_File_Spec;
2599
2600    ----------------------------
2601    -- To_Canonical_Path_Spec --
2602    ----------------------------
2603
2604    function To_Canonical_Path_Spec
2605      (Host_Path : String) return String_Access
2606    is
2607       function To_Canonical_Path_Spec (Host_Path : Address) return Address;
2608       pragma Import
2609         (C, To_Canonical_Path_Spec, "__gnat_to_canonical_path_spec");
2610
2611       C_Host_Path         : String (1 .. Host_Path'Length + 1);
2612       Canonical_Path_Addr : Address;
2613       Canonical_Path_Len  : Integer;
2614
2615    begin
2616       C_Host_Path (1 .. Host_Path'Length) := Host_Path;
2617       C_Host_Path (C_Host_Path'Last)      := ASCII.NUL;
2618
2619       Canonical_Path_Addr := To_Canonical_Path_Spec (C_Host_Path'Address);
2620       Canonical_Path_Len  := C_String_Length (Canonical_Path_Addr);
2621
2622       --  Return a null string (vice a null) for zero length paths, for
2623       --  compatibility with getenv().
2624
2625       return To_Path_String_Access (Canonical_Path_Addr, Canonical_Path_Len);
2626
2627    exception
2628       when others =>
2629          Fail ("erroneous path spec: ", Host_Path);
2630          return null;
2631    end To_Canonical_Path_Spec;
2632
2633    ---------------------------
2634    -- To_Host_Dir_Spec --
2635    ---------------------------
2636
2637    function To_Host_Dir_Spec
2638      (Canonical_Dir : String;
2639       Prefix_Style  : Boolean) return String_Access
2640    is
2641       function To_Host_Dir_Spec
2642         (Canonical_Dir : Address;
2643          Prefix_Flag   : Integer) return Address;
2644       pragma Import (C, To_Host_Dir_Spec, "__gnat_to_host_dir_spec");
2645
2646       C_Canonical_Dir : String (1 .. Canonical_Dir'Length + 1);
2647       Host_Dir_Addr   : Address;
2648       Host_Dir_Len    : Integer;
2649
2650    begin
2651       C_Canonical_Dir (1 .. Canonical_Dir'Length) := Canonical_Dir;
2652       C_Canonical_Dir (C_Canonical_Dir'Last)      := ASCII.NUL;
2653
2654       if Prefix_Style then
2655          Host_Dir_Addr := To_Host_Dir_Spec (C_Canonical_Dir'Address, 1);
2656       else
2657          Host_Dir_Addr := To_Host_Dir_Spec (C_Canonical_Dir'Address, 0);
2658       end if;
2659       Host_Dir_Len := C_String_Length (Host_Dir_Addr);
2660
2661       if Host_Dir_Len = 0 then
2662          return null;
2663       else
2664          return To_Path_String_Access (Host_Dir_Addr, Host_Dir_Len);
2665       end if;
2666    end To_Host_Dir_Spec;
2667
2668    ----------------------------
2669    -- To_Host_File_Spec --
2670    ----------------------------
2671
2672    function To_Host_File_Spec
2673      (Canonical_File : String) return String_Access
2674    is
2675       function To_Host_File_Spec (Canonical_File : Address) return Address;
2676       pragma Import (C, To_Host_File_Spec, "__gnat_to_host_file_spec");
2677
2678       C_Canonical_File      : String (1 .. Canonical_File'Length + 1);
2679       Host_File_Addr : Address;
2680       Host_File_Len  : Integer;
2681
2682    begin
2683       C_Canonical_File (1 .. Canonical_File'Length) := Canonical_File;
2684       C_Canonical_File (C_Canonical_File'Last)      := ASCII.NUL;
2685
2686       Host_File_Addr := To_Host_File_Spec (C_Canonical_File'Address);
2687       Host_File_Len  := C_String_Length (Host_File_Addr);
2688
2689       if Host_File_Len = 0 then
2690          return null;
2691       else
2692          return To_Path_String_Access
2693                   (Host_File_Addr, Host_File_Len);
2694       end if;
2695    end To_Host_File_Spec;
2696
2697    ---------------------------
2698    -- To_Path_String_Access --
2699    ---------------------------
2700
2701    function To_Path_String_Access
2702      (Path_Addr : Address;
2703       Path_Len  : Integer) return String_Access
2704    is
2705       subtype Path_String is String (1 .. Path_Len);
2706       type Path_String_Access is access Path_String;
2707
2708       function Address_To_Access is new
2709         Unchecked_Conversion (Source => Address,
2710                               Target => Path_String_Access);
2711
2712       Path_Access : constant Path_String_Access :=
2713                       Address_To_Access (Path_Addr);
2714
2715       Return_Val : String_Access;
2716
2717    begin
2718       Return_Val := new String (1 .. Path_Len);
2719
2720       for J in 1 .. Path_Len loop
2721          Return_Val (J) := Path_Access (J);
2722       end loop;
2723
2724       return Return_Val;
2725    end To_Path_String_Access;
2726
2727    -----------------
2728    -- Update_Path --
2729    -----------------
2730
2731    function Update_Path (Path : String_Ptr) return String_Ptr is
2732
2733       function C_Update_Path (Path, Component : Address) return Address;
2734       pragma Import (C, C_Update_Path, "update_path");
2735
2736       function Strlen (Str : Address) return Integer;
2737       pragma Import (C, Strlen, "strlen");
2738
2739       procedure Strncpy (X : Address; Y : Address; Length : Integer);
2740       pragma Import (C, Strncpy, "strncpy");
2741
2742       In_Length      : constant Integer := Path'Length;
2743       In_String      : String (1 .. In_Length + 1);
2744       Component_Name : aliased String := "GCC" & ASCII.NUL;
2745       Result_Ptr     : Address;
2746       Result_Length  : Integer;
2747       Out_String     : String_Ptr;
2748
2749    begin
2750       In_String (1 .. In_Length) := Path.all;
2751       In_String (In_Length + 1) := ASCII.NUL;
2752       Result_Ptr := C_Update_Path (In_String'Address,
2753                                    Component_Name'Address);
2754       Result_Length := Strlen (Result_Ptr);
2755
2756       Out_String := new String (1 .. Result_Length);
2757       Strncpy (Out_String.all'Address, Result_Ptr, Result_Length);
2758       return Out_String;
2759    end Update_Path;
2760
2761    ----------------
2762    -- Write_Info --
2763    ----------------
2764
2765    procedure Write_Info (Info : String) is
2766    begin
2767       Write_With_Check (Info'Address, Info'Length);
2768       Write_With_Check (EOL'Address, 1);
2769    end Write_Info;
2770
2771    ------------------------
2772    -- Write_Program_Name --
2773    ------------------------
2774
2775    procedure Write_Program_Name is
2776       Save_Buffer : constant String (1 .. Name_Len) :=
2777                       Name_Buffer (1 .. Name_Len);
2778
2779    begin
2780       Find_Program_Name;
2781
2782       --  Convert the name to lower case so error messages are the same on
2783       --  all systems.
2784
2785       for J in 1 .. Name_Len loop
2786          if Name_Buffer (J) in 'A' .. 'Z' then
2787             Name_Buffer (J) :=
2788               Character'Val (Character'Pos (Name_Buffer (J)) + 32);
2789          end if;
2790       end loop;
2791
2792       Write_Str (Name_Buffer (1 .. Name_Len));
2793
2794       --  Restore Name_Buffer which was clobbered by the call to
2795       --  Find_Program_Name
2796
2797       Name_Len := Save_Buffer'Last;
2798       Name_Buffer (1 .. Name_Len) := Save_Buffer;
2799    end Write_Program_Name;
2800
2801    ----------------------
2802    -- Write_With_Check --
2803    ----------------------
2804
2805    procedure Write_With_Check (A  : Address; N  : Integer) is
2806       Ignore : Boolean;
2807
2808    begin
2809       if N = Write (Output_FD, A, N) then
2810          return;
2811
2812       else
2813          Write_Str ("error: disk full writing ");
2814          Write_Name_Decoded (Output_File_Name);
2815          Write_Eol;
2816          Name_Len := Name_Len + 1;
2817          Name_Buffer (Name_Len) := ASCII.NUL;
2818          Delete_File (Name_Buffer'Address, Ignore);
2819          Exit_Program (E_Fatal);
2820       end if;
2821    end Write_With_Check;
2822
2823 ----------------------------
2824 -- Package Initialization --
2825 ----------------------------
2826
2827 begin
2828    Initialization : declare
2829
2830       function Get_Default_Identifier_Character_Set return Character;
2831       pragma Import (C, Get_Default_Identifier_Character_Set,
2832                        "__gnat_get_default_identifier_character_set");
2833       --  Function to determine the default identifier character set,
2834       --  which is system dependent. See Opt package spec for a list of
2835       --  the possible character codes and their interpretations.
2836
2837       function Get_Maximum_File_Name_Length return Int;
2838       pragma Import (C, Get_Maximum_File_Name_Length,
2839                     "__gnat_get_maximum_file_name_length");
2840       --  Function to get maximum file name length for system
2841
2842    begin
2843       Identifier_Character_Set := Get_Default_Identifier_Character_Set;
2844       Maximum_File_Name_Length := Get_Maximum_File_Name_Length;
2845
2846       --  Following should be removed by having above function return
2847       --  Integer'Last as indication of no maximum instead of -1 ???
2848
2849       if Maximum_File_Name_Length = -1 then
2850          Maximum_File_Name_Length := Int'Last;
2851       end if;
2852
2853       Src_Search_Directories.Set_Last (Primary_Directory);
2854       Src_Search_Directories.Table (Primary_Directory) := new String'("");
2855
2856       Lib_Search_Directories.Set_Last (Primary_Directory);
2857       Lib_Search_Directories.Table (Primary_Directory) := new String'("");
2858
2859       Osint.Initialize;
2860    end Initialization;
2861
2862 end Osint;