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