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