1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
29 with Namet; use Namet;
31 with Output; use Output;
32 with Sdefault; use Sdefault;
33 with System.Case_Util; use System.Case_Util;
36 with Unchecked_Conversion;
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
43 Running_Program : Program_Type := Unspecified;
44 -- comment required here ???
46 Program_Set : Boolean := False;
47 -- comment required here ???
49 Std_Prefix : String_Ptr;
50 -- Standard prefix, computed dynamically the first time Relocate_Path
51 -- is called, and cached for subsequent calls.
53 -------------------------------------
54 -- Use of Name_Find and Name_Enter --
55 -------------------------------------
57 -- This package creates a number of source, ALI and object file names
58 -- that are used to locate the actual file and for the purpose of
59 -- message construction. These names need not be accessible by Name_Find,
60 -- and can be therefore created by using routine Name_Enter. The files in
61 -- question are file names with a prefix directory (ie the files not
62 -- in the current directory). File names without a prefix directory are
63 -- entered with Name_Find because special values might be attached to
64 -- the various Info fields of the corresponding name table entry.
66 -----------------------
67 -- Local Subprograms --
68 -----------------------
70 function Append_Suffix_To_File_Name
72 Suffix : String) return Name_Id;
73 -- Appends Suffix to Name and returns the new name.
75 function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
76 -- Convert OS format time to GNAT format time stamp
78 function Concat (String_One : String; String_Two : String) return String;
79 -- Concatenates 2 strings and returns the result of the concatenation
81 function Executable_Prefix return String_Ptr;
82 -- Returns the name of the root directory where the executable is stored.
83 -- The executable must be located in a directory called "bin", or
84 -- under root/lib/gcc-lib/..., or under root/libexec/gcc/... Thus, if
85 -- the executable is stored in directory "/foo/bar/bin", this routine
86 -- returns "/foo/bar/". Return "" if the location is not recognized
87 -- as described above.
89 function Update_Path (Path : String_Ptr) return String_Ptr;
90 -- Update the specified path to replace the prefix with the location
91 -- where GNAT is installed. See the file prefix.c in GCC for details.
93 procedure Write_With_Check (A : Address; N : Integer);
94 -- Writes N bytes from buffer starting at address A to file whose FD is
95 -- stored in Output_FD, and whose file name is stored as a File_Name_Type
96 -- in Output_File_Name. A check is made for disk full, and if this is
97 -- detected, the file being written is deleted, and a fatal error is
104 Name : String) return File_Name_Type;
105 -- See if the file N whose name is Name exists in directory Dir. Dir is
106 -- an index into the Lib_Search_Directories table if T = Library.
107 -- Otherwise if T = Source, Dir is an index into the
108 -- Src_Search_Directories table. Returns the File_Name_Type of the
109 -- full file name if file found, or No_File if not found.
111 function C_String_Length (S : Address) return Integer;
112 -- Returns length of a C string. Returns zero for a null address.
114 function To_Path_String_Access
115 (Path_Addr : Address;
116 Path_Len : Integer) return String_Access;
117 -- Converts a C String to an Ada String. Are we doing this to avoid
118 -- withing Interfaces.C.Strings ???
120 ------------------------------
121 -- Other Local Declarations --
122 ------------------------------
124 EOL : constant Character := ASCII.LF;
125 -- End of line character
127 Number_File_Names : Int := 0;
128 -- The total number of file names found on command line and placed in
131 Look_In_Primary_Directory_For_Current_Main : Boolean := False;
132 -- When this variable is True, Find_File will only look in
133 -- the Primary_Directory for the Current_Main file.
134 -- This variable is always True for the compiler.
135 -- It is also True for gnatmake, when the soucr name given
136 -- on the command line has directory information.
138 Current_Full_Source_Name : File_Name_Type := No_File;
139 Current_Full_Source_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
140 Current_Full_Lib_Name : File_Name_Type := No_File;
141 Current_Full_Lib_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
142 Current_Full_Obj_Name : File_Name_Type := No_File;
143 Current_Full_Obj_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
144 -- Respectively full name (with directory info) and time stamp of
145 -- the latest source, library and object files opened by Read_Source_File
146 -- and Read_Library_Info.
152 Primary_Directory : constant := 0;
153 -- This is index in the tables created below for the first directory to
154 -- search in for source or library information files. This is the
155 -- directory containing the latest main input file (a source file for
156 -- the compiler or a library file for the binder).
158 package Src_Search_Directories is new Table.Table (
159 Table_Component_Type => String_Ptr,
160 Table_Index_Type => Natural,
161 Table_Low_Bound => Primary_Directory,
163 Table_Increment => 100,
164 Table_Name => "Osint.Src_Search_Directories");
165 -- Table of names of directories in which to search for source (Compiler)
166 -- files. This table is filled in the order in which the directories are
167 -- to be searched, and then used in that order.
169 package Lib_Search_Directories is new Table.Table (
170 Table_Component_Type => String_Ptr,
171 Table_Index_Type => Natural,
172 Table_Low_Bound => Primary_Directory,
174 Table_Increment => 100,
175 Table_Name => "Osint.Lib_Search_Directories");
176 -- Table of names of directories in which to search for library (Binder)
177 -- files. This table is filled in the order in which the directories are
178 -- to be searched and then used in that order. The reason for having two
179 -- distinct tables is that we need them both in gnatmake.
181 ---------------------
182 -- File Hash Table --
183 ---------------------
185 -- The file hash table is provided to free the programmer from any
186 -- efficiency concern when retrieving full file names or time stamps of
187 -- source files. If the programmer calls Source_File_Data (Cache => True)
188 -- he is guaranteed that the price to retrieve the full name (ie with
189 -- directory info) or time stamp of the file will be payed only once,
190 -- the first time the full name is actually searched (or the first time
191 -- the time stamp is actually retrieved). This is achieved by employing
192 -- a hash table that stores as a key the File_Name_Type of the file and
193 -- associates to that File_Name_Type the full file name of the file and its
196 File_Cache_Enabled : Boolean := False;
197 -- Set to true if you want the enable the file data caching mechanism.
199 type File_Hash_Num is range 0 .. 1020;
201 function File_Hash (F : File_Name_Type) return File_Hash_Num;
202 -- Compute hash index for use by Simple_HTable
204 package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
205 Header_Num => File_Hash_Num,
206 Element => File_Name_Type,
207 No_Element => No_File,
208 Key => File_Name_Type,
212 package File_Stamp_Hash_Table is new GNAT.HTable.Simple_HTable (
213 Header_Num => File_Hash_Num,
214 Element => Time_Stamp_Type,
215 No_Element => Empty_Time_Stamp,
216 Key => File_Name_Type,
220 function Smart_Find_File
222 T : File_Type) return File_Name_Type;
223 -- Exactly like Find_File except that if File_Cache_Enabled is True this
224 -- routine looks first in the hash table to see if the full name of the
225 -- file is already available.
227 function Smart_File_Stamp
229 T : File_Type) return Time_Stamp_Type;
230 -- Takes the same parameter as the routine above (N is a file name
231 -- without any prefix directory information) and behaves like File_Stamp
232 -- except that if File_Cache_Enabled is True this routine looks first in
233 -- the hash table to see if the file stamp of the file is already
236 -----------------------------
237 -- Add_Default_Search_Dirs --
238 -----------------------------
240 procedure Add_Default_Search_Dirs is
241 Search_Dir : String_Access;
242 Search_Path : String_Access;
243 Path_File_Name : String_Access;
245 procedure Add_Search_Dir
246 (Search_Dir : String;
247 Additional_Source_Dir : Boolean);
248 procedure Add_Search_Dir
249 (Search_Dir : String_Access;
250 Additional_Source_Dir : Boolean);
251 -- Add a source search dir or a library search dir, depending on the
252 -- value of Additional_Source_Dir.
254 procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean);
255 -- Open a path file and read the directory to search, one per line
257 function Get_Libraries_From_Registry return String_Ptr;
258 -- On Windows systems, get the list of installed standard libraries
259 -- from the registry key:
260 -- HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\
261 -- GNAT\Standard Libraries
262 -- Return an empty string on other systems
268 procedure Add_Search_Dir
269 (Search_Dir : String;
270 Additional_Source_Dir : Boolean)
273 if Additional_Source_Dir then
274 Add_Src_Search_Dir (Search_Dir);
276 Add_Lib_Search_Dir (Search_Dir);
280 procedure Add_Search_Dir
281 (Search_Dir : String_Access;
282 Additional_Source_Dir : Boolean)
285 if Additional_Source_Dir then
286 Add_Src_Search_Dir (Search_Dir.all);
288 Add_Lib_Search_Dir (Search_Dir.all);
292 ------------------------
293 -- Get_Dirs_From_File --
294 ------------------------
296 procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean) is
297 File_FD : File_Descriptor;
298 Buffer : String (1 .. Path_File_Name'Length + 1);
300 Actual_Len : Natural;
307 -- For the call to Close
310 -- Construct a C compatible character string buffer.
312 Buffer (1 .. Buffer'Last - 1) := Path_File_Name.all;
313 Buffer (Buffer'Last) := ASCII.NUL;
315 File_FD := Open_Read (Buffer'Address, Binary);
317 -- If we cannot open the file, we ignore it, we don't fail
319 if File_FD = Invalid_FD then
323 Len := Integer (File_Length (File_FD));
325 S := new String (1 .. Len);
327 -- Read the file. Note that the loop is not necessary since the
328 -- whole file is read at once except on VMS.
332 while Curr <= Len and then Actual_Len /= 0 loop
333 Actual_Len := Read (File_FD, S (Curr)'Address, Len);
334 Curr := Curr + Actual_Len;
337 -- We are done with the file, so we close it
339 Close (File_FD, Status);
340 -- We ignore any error here, because we have successfully read the
343 -- Now, we read line by line
348 while Curr < Len loop
351 if Ch = ASCII.CR or else Ch = ASCII.LF
352 or else Ch = ASCII.FF or else Ch = ASCII.VT
354 if First <= Curr then
355 Add_Search_Dir (S (First .. Curr), Additional_Source_Dir);
364 -- Last line is a special case, if the file does not end with
365 -- an end of line mark.
367 if First <= S'Last then
368 Add_Search_Dir (S (First .. S'Last), Additional_Source_Dir);
370 end Get_Dirs_From_File;
372 ---------------------------------
373 -- Get_Libraries_From_Registry --
374 ---------------------------------
376 function Get_Libraries_From_Registry return String_Ptr is
377 function C_Get_Libraries_From_Registry return Address;
378 pragma Import (C, C_Get_Libraries_From_Registry,
379 "__gnat_get_libraries_from_registry");
380 function Strlen (Str : Address) return Integer;
381 pragma Import (C, Strlen, "strlen");
382 procedure Strncpy (X : Address; Y : Address; Length : Integer);
383 pragma Import (C, Strncpy, "strncpy");
384 Result_Ptr : Address;
385 Result_Length : Integer;
386 Out_String : String_Ptr;
389 Result_Ptr := C_Get_Libraries_From_Registry;
390 Result_Length := Strlen (Result_Ptr);
392 Out_String := new String (1 .. Result_Length);
393 Strncpy (Out_String.all'Address, Result_Ptr, Result_Length);
395 end Get_Libraries_From_Registry;
397 -- Start of processing for Add_Default_Search_Dirs
400 -- After the locations specified on the command line, the next places
401 -- to look for files are the directories specified by the appropriate
402 -- environment variable. Get this value, extract the directory names
403 -- and store in the tables.
405 -- On VMS, don't expand the logical name (e.g. environment variable),
406 -- just put it into Unix (e.g. canonical) format. System services
407 -- will handle the expansion as part of the file processing.
409 for Additional_Source_Dir in False .. True loop
411 if Additional_Source_Dir then
412 Search_Path := Getenv (Ada_Include_Path);
413 if Search_Path'Length > 0 then
414 if Hostparm.OpenVMS then
415 Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:");
417 Search_Path := To_Canonical_Path_Spec (Search_Path.all);
421 Search_Path := Getenv (Ada_Objects_Path);
422 if Search_Path'Length > 0 then
423 if Hostparm.OpenVMS then
424 Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:");
426 Search_Path := To_Canonical_Path_Spec (Search_Path.all);
431 Get_Next_Dir_In_Path_Init (Search_Path);
433 Search_Dir := Get_Next_Dir_In_Path (Search_Path);
434 exit when Search_Dir = null;
435 Add_Search_Dir (Search_Dir, Additional_Source_Dir);
439 -- Check for eventual project path file env vars
441 Path_File_Name := Getenv (Project_Include_Path_File);
443 if Path_File_Name'Length > 0 then
444 Get_Dirs_From_File (Additional_Source_Dir => True);
447 Path_File_Name := Getenv (Project_Objects_Path_File);
449 if Path_File_Name'Length > 0 then
450 Get_Dirs_From_File (Additional_Source_Dir => False);
453 -- For the compiler, if --RTS= was apecified, add the runtime
456 if RTS_Src_Path_Name /= null and then
457 RTS_Lib_Path_Name /= null
459 Add_Search_Dirs (RTS_Src_Path_Name, Include);
460 Add_Search_Dirs (RTS_Lib_Path_Name, Objects);
463 if not Opt.No_Stdinc then
465 -- For WIN32 systems, look for any system libraries defined in
466 -- the registry. These are added to both source and object
469 Search_Path := String_Access (Get_Libraries_From_Registry);
471 Get_Next_Dir_In_Path_Init (Search_Path);
473 Search_Dir := Get_Next_Dir_In_Path (Search_Path);
474 exit when Search_Dir = null;
475 Add_Search_Dir (Search_Dir, False);
476 Add_Search_Dir (Search_Dir, True);
479 -- The last place to look are the defaults
482 Read_Default_Search_Dirs
483 (String_Access (Update_Path (Search_Dir_Prefix)),
485 String_Access (Update_Path (Include_Dir_Default_Name)));
487 Get_Next_Dir_In_Path_Init (Search_Path);
489 Search_Dir := Get_Next_Dir_In_Path (Search_Path);
490 exit when Search_Dir = null;
491 Add_Search_Dir (Search_Dir, True);
495 if not Opt.No_Stdlib and not Opt.RTS_Switch then
497 Read_Default_Search_Dirs
498 (String_Access (Update_Path (Search_Dir_Prefix)),
500 String_Access (Update_Path (Object_Dir_Default_Name)));
502 Get_Next_Dir_In_Path_Init (Search_Path);
504 Search_Dir := Get_Next_Dir_In_Path (Search_Path);
505 exit when Search_Dir = null;
506 Add_Search_Dir (Search_Dir, False);
510 end Add_Default_Search_Dirs;
516 procedure Add_File (File_Name : String) is
518 Number_File_Names := Number_File_Names + 1;
520 -- As Add_File may be called for mains specified inside
521 -- a project file, File_Names may be too short and needs
524 if Number_File_Names > File_Names'Last then
525 File_Names := new File_Name_Array'(File_Names.all & File_Names.all);
528 File_Names (Number_File_Names) := new String'(File_Name);
531 ------------------------
532 -- Add_Lib_Search_Dir --
533 ------------------------
535 procedure Add_Lib_Search_Dir (Dir : String) is
537 if Dir'Length = 0 then
538 Fail ("missing library directory name");
541 Lib_Search_Directories.Increment_Last;
542 Lib_Search_Directories.Table (Lib_Search_Directories.Last) :=
543 Normalize_Directory_Name (Dir);
544 end Add_Lib_Search_Dir;
546 ---------------------
547 -- Add_Search_Dirs --
548 ---------------------
550 procedure Add_Search_Dirs
551 (Search_Path : String_Ptr;
552 Path_Type : Search_File_Type)
554 Current_Search_Path : String_Access;
557 Get_Next_Dir_In_Path_Init (String_Access (Search_Path));
559 Current_Search_Path :=
560 Get_Next_Dir_In_Path (String_Access (Search_Path));
561 exit when Current_Search_Path = null;
563 if Path_Type = Include then
564 Add_Src_Search_Dir (Current_Search_Path.all);
566 Add_Lib_Search_Dir (Current_Search_Path.all);
571 ------------------------
572 -- Add_Src_Search_Dir --
573 ------------------------
575 procedure Add_Src_Search_Dir (Dir : String) is
577 if Dir'Length = 0 then
578 Fail ("missing source directory name");
581 Src_Search_Directories.Increment_Last;
582 Src_Search_Directories.Table (Src_Search_Directories.Last) :=
583 Normalize_Directory_Name (Dir);
584 end Add_Src_Search_Dir;
586 --------------------------------
587 -- Append_Suffix_To_File_Name --
588 --------------------------------
590 function Append_Suffix_To_File_Name
592 Suffix : String) return Name_Id
595 Get_Name_String (Name);
596 Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
597 Name_Len := Name_Len + Suffix'Length;
599 end Append_Suffix_To_File_Name;
601 ---------------------
602 -- C_String_Length --
603 ---------------------
605 function C_String_Length (S : Address) return Integer is
606 function Strlen (S : Address) return Integer;
607 pragma Import (C, Strlen, "strlen");
610 if S = Null_Address then
617 ------------------------------
618 -- Canonical_Case_File_Name --
619 ------------------------------
621 -- For now, we only deal with the case of a-z. Eventually we should
622 -- worry about other Latin-1 letters on systems that support this ???
624 procedure Canonical_Case_File_Name (S : in out String) is
626 if not File_Names_Case_Sensitive then
627 for J in S'Range loop
628 if S (J) in 'A' .. 'Z' then
629 S (J) := Character'Val (
630 Character'Pos (S (J)) +
631 Character'Pos ('a') -
632 Character'Pos ('A'));
636 end Canonical_Case_File_Name;
642 function Concat (String_One : String; String_Two : String) return String is
643 Buffer : String (1 .. String_One'Length + String_Two'Length);
646 Buffer (1 .. String_One'Length) := String_One;
647 Buffer (String_One'Length + 1 .. Buffer'Last) := String_Two;
651 ---------------------------
652 -- Create_File_And_Check --
653 ---------------------------
655 procedure Create_File_And_Check
656 (Fdesc : out File_Descriptor;
660 Output_File_Name := Name_Enter;
661 Fdesc := Create_File (Name_Buffer'Address, Fmode);
663 if Fdesc = Invalid_FD then
664 Fail ("Cannot create: ", Name_Buffer (1 .. Name_Len));
666 end Create_File_And_Check;
668 --------------------------------
669 -- Current_Library_File_Stamp --
670 --------------------------------
672 function Current_Library_File_Stamp return Time_Stamp_Type is
674 return Current_Full_Lib_Stamp;
675 end Current_Library_File_Stamp;
677 -------------------------------
678 -- Current_Object_File_Stamp --
679 -------------------------------
681 function Current_Object_File_Stamp return Time_Stamp_Type is
683 return Current_Full_Obj_Stamp;
684 end Current_Object_File_Stamp;
686 -------------------------------
687 -- Current_Source_File_Stamp --
688 -------------------------------
690 function Current_Source_File_Stamp return Time_Stamp_Type is
692 return Current_Full_Source_Stamp;
693 end Current_Source_File_Stamp;
695 ----------------------------
696 -- Dir_In_Obj_Search_Path --
697 ----------------------------
699 function Dir_In_Obj_Search_Path (Position : Natural) return String_Ptr is
701 if Opt.Look_In_Primary_Dir then
703 Lib_Search_Directories.Table (Primary_Directory + Position - 1);
705 return Lib_Search_Directories.Table (Primary_Directory + Position);
707 end Dir_In_Obj_Search_Path;
709 ----------------------------
710 -- Dir_In_Src_Search_Path --
711 ----------------------------
713 function Dir_In_Src_Search_Path (Position : Natural) return String_Ptr is
715 if Opt.Look_In_Primary_Dir then
717 Src_Search_Directories.Table (Primary_Directory + Position - 1);
719 return Src_Search_Directories.Table (Primary_Directory + Position);
721 end Dir_In_Src_Search_Path;
723 ---------------------
724 -- Executable_Name --
725 ---------------------
727 function Executable_Name (Name : File_Name_Type) return File_Name_Type is
728 Exec_Suffix : String_Access;
731 if Name = No_File then
735 Get_Name_String (Name);
736 Exec_Suffix := Get_Executable_Suffix;
738 for J in Exec_Suffix'Range loop
739 Name_Len := Name_Len + 1;
740 Name_Buffer (Name_Len) := Exec_Suffix (J);
748 -------------------------
749 -- Executable_Prefix --
750 -------------------------
752 function Executable_Prefix return String_Ptr is
753 Exec_Name : String (1 .. Len_Arg (0));
755 function Get_Install_Dir (Exec : String) return String_Ptr;
756 -- S is the executable name preceeded by the absolute or relative
757 -- path, e.g. "c:\usr\bin\gcc.exe" or "..\bin\gcc".
759 ---------------------
760 -- Get_Install_Dir --
761 ---------------------
763 function Get_Install_Dir (Exec : String) return String_Ptr is
765 for J in reverse Exec'Range loop
766 if Is_Directory_Separator (Exec (J)) then
767 if J < Exec'Last - 5 then
768 if (To_Lower (Exec (J + 1)) = 'l'
769 and then To_Lower (Exec (J + 2)) = 'i'
770 and then To_Lower (Exec (J + 3)) = 'b')
772 (To_Lower (Exec (J + 1)) = 'b'
773 and then To_Lower (Exec (J + 2)) = 'i'
774 and then To_Lower (Exec (J + 3)) = 'n')
776 return new String'(Exec (Exec'First .. J));
782 return new String'("");
785 -- Start of processing for Executable_Prefix
788 Osint.Fill_Arg (Exec_Name'Address, 0);
790 -- First determine if a path prefix was placed in front of the
793 for J in reverse Exec_Name'Range loop
794 if Is_Directory_Separator (Exec_Name (J)) then
795 return Get_Install_Dir (Exec_Name);
799 -- If we come here, the user has typed the executable name with no
802 return Get_Install_Dir (GNAT.OS_Lib.Locate_Exec_On_Path (Exec_Name).all);
803 end Executable_Prefix;
809 procedure Exit_Program (Exit_Code : Exit_Code_Type) is
811 -- The program will exit with the following status:
812 -- 0 if the object file has been generated (with or without warnings)
813 -- 1 if recompilation was not needed (smart recompilation)
814 -- 2 if gnat1 has been killed by a signal (detected by GCC)
815 -- 4 for a fatal error
816 -- 5 if there were errors
817 -- 6 if no code has been generated (spec)
819 -- Note that exit code 3 is not used and must not be used as this is
820 -- the code returned by a program aborted via C abort() routine on
821 -- Windows. GCC checks for that case and thinks that the child process
822 -- has been aborted. This code (exit code 3) used to be the code used
823 -- for E_No_Code, but E_No_Code was changed to 6 for this reason.
826 when E_Success => OS_Exit (0);
827 when E_Warnings => OS_Exit (0);
828 when E_No_Compile => OS_Exit (1);
829 when E_Fatal => OS_Exit (4);
830 when E_Errors => OS_Exit (5);
831 when E_No_Code => OS_Exit (6);
832 when E_Abort => OS_Abort;
840 procedure Fail (S1 : String; S2 : String := ""; S3 : String := "") is
842 -- We use Output in case there is a special output set up.
843 -- In this case Set_Standard_Error will have no immediate effect.
846 Osint.Write_Program_Name;
853 Exit_Program (E_Fatal);
860 function File_Hash (F : File_Name_Type) return File_Hash_Num is
862 return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length);
869 function File_Stamp (Name : File_Name_Type) return Time_Stamp_Type is
871 if Name = No_File then
872 return Empty_Time_Stamp;
875 Get_Name_String (Name);
877 if not Is_Regular_File (Name_Buffer (1 .. Name_Len)) then
878 return Empty_Time_Stamp;
880 Name_Buffer (Name_Len + 1) := ASCII.NUL;
881 return OS_Time_To_GNAT_Time (File_Time_Stamp (Name_Buffer));
891 T : File_Type) return File_Name_Type
897 File_Name : String renames Name_Buffer (1 .. Name_Len);
898 File : File_Name_Type := No_File;
902 -- If we are looking for a config file, look only in the current
903 -- directory, i.e. return input argument unchanged. Also look
904 -- only in the current directory if we are looking for a .dg
905 -- file (happens in -gnatD mode)
908 or else (Debug_Generated_Code
909 and then Name_Len > 3
911 (Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg"
913 (Hostparm.OpenVMS and then
914 Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
918 -- If we are trying to find the current main file just look in the
919 -- directory where the user said it was.
921 elsif Look_In_Primary_Directory_For_Current_Main
922 and then Current_Main = N
924 return Locate_File (N, T, Primary_Directory, File_Name);
926 -- Otherwise do standard search for source file
929 -- Check the mapping of this file name
931 File := Mapped_Path_Name (N);
933 -- If the file name is mapped to a path name, return the
934 -- corresponding path name
936 if File /= No_File then
937 -- For locally removed file, Error_Name is returned; then
938 -- return No_File, indicating the file is not a source.
940 if File = Error_Name then
948 -- First place to look is in the primary directory (i.e. the same
949 -- directory as the source) unless this has been disabled with -I-
951 if Opt.Look_In_Primary_Dir then
952 File := Locate_File (N, T, Primary_Directory, File_Name);
954 if File /= No_File then
959 -- Finally look in directories specified with switches -I/-aI/-aO
962 Last_Dir := Lib_Search_Directories.Last;
964 Last_Dir := Src_Search_Directories.Last;
967 for D in Primary_Directory + 1 .. Last_Dir loop
968 File := Locate_File (N, T, D, File_Name);
970 if File /= No_File then
980 -----------------------
981 -- Find_Program_Name --
982 -----------------------
984 procedure Find_Program_Name is
985 Command_Name : String (1 .. Len_Arg (0));
986 Cindex1 : Integer := Command_Name'First;
987 Cindex2 : Integer := Command_Name'Last;
990 Fill_Arg (Command_Name'Address, 0);
992 -- The program name might be specified by a full path name. However,
993 -- we don't want to print that all out in an error message, so the
994 -- path might need to be stripped away.
996 for J in reverse Cindex1 .. Cindex2 loop
997 if Is_Directory_Separator (Command_Name (J)) then
1003 for J in reverse Cindex1 .. Cindex2 loop
1004 if Command_Name (J) = '.' then
1010 Name_Len := Cindex2 - Cindex1 + 1;
1011 Name_Buffer (1 .. Name_Len) := Command_Name (Cindex1 .. Cindex2);
1012 end Find_Program_Name;
1014 ------------------------
1015 -- Full_Lib_File_Name --
1016 ------------------------
1018 function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type is
1020 return Find_File (N, Library);
1021 end Full_Lib_File_Name;
1023 ----------------------------
1024 -- Full_Library_Info_Name --
1025 ----------------------------
1027 function Full_Library_Info_Name return File_Name_Type is
1029 return Current_Full_Lib_Name;
1030 end Full_Library_Info_Name;
1032 ---------------------------
1033 -- Full_Object_File_Name --
1034 ---------------------------
1036 function Full_Object_File_Name return File_Name_Type is
1038 return Current_Full_Obj_Name;
1039 end Full_Object_File_Name;
1041 ----------------------
1042 -- Full_Source_Name --
1043 ----------------------
1045 function Full_Source_Name return File_Name_Type is
1047 return Current_Full_Source_Name;
1048 end Full_Source_Name;
1050 ----------------------
1051 -- Full_Source_Name --
1052 ----------------------
1054 function Full_Source_Name (N : File_Name_Type) return File_Name_Type is
1056 return Smart_Find_File (N, Source);
1057 end Full_Source_Name;
1063 function Get_Directory (Name : File_Name_Type) return File_Name_Type is
1065 Get_Name_String (Name);
1067 for J in reverse 1 .. Name_Len loop
1068 if Is_Directory_Separator (Name_Buffer (J)) then
1074 Name_Len := Hostparm.Normalized_CWD'Length;
1075 Name_Buffer (1 .. Name_Len) := Hostparm.Normalized_CWD;
1079 --------------------------
1080 -- Get_Next_Dir_In_Path --
1081 --------------------------
1083 Search_Path_Pos : Integer;
1084 -- Keeps track of current position in search path. Initialized by the
1085 -- call to Get_Next_Dir_In_Path_Init, updated by Get_Next_Dir_In_Path.
1087 function Get_Next_Dir_In_Path
1088 (Search_Path : String_Access) return String_Access
1090 Lower_Bound : Positive := Search_Path_Pos;
1091 Upper_Bound : Positive;
1095 while Lower_Bound <= Search_Path'Last
1096 and then Search_Path.all (Lower_Bound) = Path_Separator
1098 Lower_Bound := Lower_Bound + 1;
1101 exit when Lower_Bound > Search_Path'Last;
1103 Upper_Bound := Lower_Bound;
1104 while Upper_Bound <= Search_Path'Last
1105 and then Search_Path.all (Upper_Bound) /= Path_Separator
1107 Upper_Bound := Upper_Bound + 1;
1110 Search_Path_Pos := Upper_Bound;
1111 return new String'(Search_Path.all (Lower_Bound .. Upper_Bound - 1));
1115 end Get_Next_Dir_In_Path;
1117 -------------------------------
1118 -- Get_Next_Dir_In_Path_Init --
1119 -------------------------------
1121 procedure Get_Next_Dir_In_Path_Init (Search_Path : String_Access) is
1123 Search_Path_Pos := Search_Path'First;
1124 end Get_Next_Dir_In_Path_Init;
1126 --------------------------------------
1127 -- Get_Primary_Src_Search_Directory --
1128 --------------------------------------
1130 function Get_Primary_Src_Search_Directory return String_Ptr is
1132 return Src_Search_Directories.Table (Primary_Directory);
1133 end Get_Primary_Src_Search_Directory;
1135 -------------------------
1136 -- Get_RTS_Search_Dir --
1137 -------------------------
1139 function Get_RTS_Search_Dir
1140 (Search_Dir : String;
1141 File_Type : Search_File_Type) return String_Ptr
1143 procedure Get_Current_Dir
1144 (Dir : System.Address;
1145 Length : System.Address);
1146 pragma Import (C, Get_Current_Dir, "__gnat_get_current_dir");
1149 pragma Import (C, Max_Path, "__gnat_max_path_len");
1150 -- Maximum length of a path name
1152 Current_Dir : String_Ptr;
1153 Default_Search_Dir : String_Access;
1154 Default_Suffix_Dir : String_Access;
1155 Local_Search_Dir : String_Access;
1156 Norm_Search_Dir : String_Access;
1157 Result_Search_Dir : String_Access;
1158 Search_File : String_Access;
1159 Temp_String : String_Ptr;
1162 -- Add a directory separator at the end of the directory if necessary
1163 -- so that we can directly append a file to the directory
1165 if Search_Dir (Search_Dir'Last) /= Directory_Separator then
1166 Local_Search_Dir := new String'
1167 (Concat (Search_Dir, String'(1 => Directory_Separator)));
1169 Local_Search_Dir := new String'(Search_Dir);
1172 if File_Type = Include then
1173 Search_File := Include_Search_File;
1174 Default_Suffix_Dir := new String'("adainclude");
1176 Search_File := Objects_Search_File;
1177 Default_Suffix_Dir := new String'("adalib");
1180 Norm_Search_Dir := To_Canonical_Path_Spec (Local_Search_Dir.all);
1182 if Is_Absolute_Path (Norm_Search_Dir.all) then
1184 -- We first verify if there is a directory Include_Search_Dir
1185 -- containing default search directories
1188 := Read_Default_Search_Dirs (Norm_Search_Dir,
1191 Default_Search_Dir := new String'
1192 (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
1193 Free (Norm_Search_Dir);
1195 if Result_Search_Dir /= null then
1196 return String_Ptr (Result_Search_Dir);
1197 elsif Is_Directory (Default_Search_Dir.all) then
1198 return String_Ptr (Default_Search_Dir);
1204 -- Search in the current directory
1206 -- Get the current directory
1209 Buffer : String (1 .. Max_Path + 2);
1210 Path_Len : Natural := Max_Path;
1213 Get_Current_Dir (Buffer'Address, Path_Len'Address);
1215 if Buffer (Path_Len) /= Directory_Separator then
1216 Path_Len := Path_Len + 1;
1217 Buffer (Path_Len) := Directory_Separator;
1220 Current_Dir := new String'(Buffer (1 .. Path_Len));
1224 new String'(Concat (Current_Dir.all, Local_Search_Dir.all));
1226 Result_Search_Dir :=
1227 Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1229 Default_Search_Dir :=
1231 (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
1233 Free (Norm_Search_Dir);
1235 if Result_Search_Dir /= null then
1236 return String_Ptr (Result_Search_Dir);
1238 elsif Is_Directory (Default_Search_Dir.all) then
1239 return String_Ptr (Default_Search_Dir);
1242 -- Search in Search_Dir_Prefix/Search_Dir
1246 (Concat (Update_Path (Search_Dir_Prefix).all,
1247 Local_Search_Dir.all));
1249 Result_Search_Dir :=
1250 Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1252 Default_Search_Dir :=
1254 (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
1256 Free (Norm_Search_Dir);
1258 if Result_Search_Dir /= null then
1259 return String_Ptr (Result_Search_Dir);
1261 elsif Is_Directory (Default_Search_Dir.all) then
1262 return String_Ptr (Default_Search_Dir);
1265 -- We finally search in Search_Dir_Prefix/rts-Search_Dir
1269 (Concat (Update_Path (Search_Dir_Prefix).all, "rts-"));
1272 new String'(Concat (Temp_String.all, Local_Search_Dir.all));
1274 Result_Search_Dir :=
1275 Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
1277 Default_Search_Dir :=
1279 (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
1280 Free (Norm_Search_Dir);
1282 if Result_Search_Dir /= null then
1283 return String_Ptr (Result_Search_Dir);
1285 elsif Is_Directory (Default_Search_Dir.all) then
1286 return String_Ptr (Default_Search_Dir);
1294 end Get_RTS_Search_Dir;
1296 --------------------------------
1297 -- Include_Dir_Default_Prefix --
1298 --------------------------------
1300 function Include_Dir_Default_Prefix return String is
1301 Include_Dir : String_Access :=
1302 String_Access (Update_Path (Include_Dir_Default_Name));
1305 if Include_Dir = null then
1310 Result : constant String := Include_Dir.all;
1316 end Include_Dir_Default_Prefix;
1322 procedure Initialize is
1324 Number_File_Names := 0;
1325 Current_File_Name_Index := 0;
1327 Src_Search_Directories.Init;
1328 Lib_Search_Directories.Init;
1330 -- Start off by setting all suppress options to False, these will
1331 -- be reset later (turning some on if -gnato is not specified, and
1332 -- turning all of them on if -gnatp is specified).
1334 Suppress_Options := (others => False);
1336 -- Reserve the first slot in the search paths table. This is the
1337 -- directory of the main source file or main library file and is
1338 -- filled in by each call to Next_Main_Source/Next_Main_Lib_File with
1339 -- the directory specified for this main source or library file. This
1340 -- is the directory which is searched first by default. This default
1341 -- search is inhibited by the option -I- for both source and library
1344 Src_Search_Directories.Set_Last (Primary_Directory);
1345 Src_Search_Directories.Table (Primary_Directory) := new String'("");
1347 Lib_Search_Directories.Set_Last (Primary_Directory);
1348 Lib_Search_Directories.Table (Primary_Directory) := new String'("");
1351 ----------------------------
1352 -- Is_Directory_Separator --
1353 ----------------------------
1355 function Is_Directory_Separator (C : Character) return Boolean is
1357 -- In addition to the default directory_separator allow the '/' to
1358 -- act as separator since this is allowed in MS-DOS, Windows 95/NT,
1359 -- and OS2 ports. On VMS, the situation is more complicated because
1360 -- there are two characters to check for.
1363 C = Directory_Separator
1365 or else (Hostparm.OpenVMS
1366 and then (C = ']' or else C = ':'));
1367 end Is_Directory_Separator;
1369 -------------------------
1370 -- Is_Readonly_Library --
1371 -------------------------
1373 function Is_Readonly_Library (File : in File_Name_Type) return Boolean is
1375 Get_Name_String (File);
1377 pragma Assert (Name_Buffer (Name_Len - 3 .. Name_Len) = ".ali");
1379 return not Is_Writable_File (Name_Buffer (1 .. Name_Len));
1380 end Is_Readonly_Library;
1386 function Lib_File_Name
1387 (Source_File : File_Name_Type)
1388 return File_Name_Type
1391 -- Pointer to location to set extension in place
1394 Get_Name_String (Source_File);
1395 Fptr := Name_Len + 1;
1397 for J in reverse 2 .. Name_Len loop
1398 if Name_Buffer (J) = '.' then
1404 Name_Buffer (Fptr) := '.';
1405 Name_Buffer (Fptr + 1 .. Fptr + ALI_Suffix'Length) := ALI_Suffix.all;
1406 Name_Buffer (Fptr + ALI_Suffix'Length + 1) := ASCII.NUL;
1407 Name_Len := Fptr + ALI_Suffix'Length;
1411 ------------------------
1412 -- Library_File_Stamp --
1413 ------------------------
1415 function Library_File_Stamp (N : File_Name_Type) return Time_Stamp_Type is
1417 return File_Stamp (Find_File (N, Library));
1418 end Library_File_Stamp;
1424 function Locate_File
1425 (N : File_Name_Type;
1428 Name : String) return File_Name_Type
1430 Dir_Name : String_Ptr;
1434 Dir_Name := Lib_Search_Directories.Table (Dir);
1436 else pragma Assert (T /= Config);
1437 Dir_Name := Src_Search_Directories.Table (Dir);
1441 Full_Name : String (1 .. Dir_Name'Length + Name'Length);
1444 Full_Name (1 .. Dir_Name'Length) := Dir_Name.all;
1445 Full_Name (Dir_Name'Length + 1 .. Full_Name'Length) := Name;
1447 if not Is_Regular_File (Full_Name) then
1451 -- If the file is in the current directory then return N itself
1453 if Dir_Name'Length = 0 then
1456 Name_Len := Full_Name'Length;
1457 Name_Buffer (1 .. Name_Len) := Full_Name;
1464 -------------------------------
1465 -- Matching_Full_Source_Name --
1466 -------------------------------
1468 function Matching_Full_Source_Name
1469 (N : File_Name_Type;
1470 T : Time_Stamp_Type) return File_Name_Type
1473 Get_Name_String (N);
1476 File_Name : constant String := Name_Buffer (1 .. Name_Len);
1477 File : File_Name_Type := No_File;
1481 if Opt.Look_In_Primary_Dir then
1482 File := Locate_File (N, Source, Primary_Directory, File_Name);
1484 if File /= No_File and then T = File_Stamp (N) then
1489 Last_Dir := Src_Search_Directories.Last;
1491 for D in Primary_Directory + 1 .. Last_Dir loop
1492 File := Locate_File (N, Source, D, File_Name);
1494 if File /= No_File and then T = File_Stamp (File) then
1501 end Matching_Full_Source_Name;
1507 function More_Files return Boolean is
1509 return (Current_File_Name_Index < Number_File_Names);
1512 -------------------------------
1513 -- Nb_Dir_In_Obj_Search_Path --
1514 -------------------------------
1516 function Nb_Dir_In_Obj_Search_Path return Natural is
1518 if Opt.Look_In_Primary_Dir then
1519 return Lib_Search_Directories.Last - Primary_Directory + 1;
1521 return Lib_Search_Directories.Last - Primary_Directory;
1523 end Nb_Dir_In_Obj_Search_Path;
1525 -------------------------------
1526 -- Nb_Dir_In_Src_Search_Path --
1527 -------------------------------
1529 function Nb_Dir_In_Src_Search_Path return Natural is
1531 if Opt.Look_In_Primary_Dir then
1532 return Src_Search_Directories.Last - Primary_Directory + 1;
1534 return Src_Search_Directories.Last - Primary_Directory;
1536 end Nb_Dir_In_Src_Search_Path;
1538 --------------------
1539 -- Next_Main_File --
1540 --------------------
1542 function Next_Main_File return File_Name_Type is
1543 File_Name : String_Ptr;
1544 Dir_Name : String_Ptr;
1548 pragma Assert (More_Files);
1550 Current_File_Name_Index := Current_File_Name_Index + 1;
1552 -- Get the file and directory name
1554 File_Name := File_Names (Current_File_Name_Index);
1555 Fptr := File_Name'First;
1557 for J in reverse File_Name'Range loop
1558 if File_Name (J) = Directory_Separator
1559 or else File_Name (J) = '/'
1561 if J = File_Name'Last then
1562 Fail ("File name missing");
1570 -- Save name of directory in which main unit resides for use in
1571 -- locating other units
1573 Dir_Name := new String'(File_Name (File_Name'First .. Fptr - 1));
1575 case Running_Program is
1578 Src_Search_Directories.Table (Primary_Directory) := Dir_Name;
1579 Look_In_Primary_Directory_For_Current_Main := True;
1582 Src_Search_Directories.Table (Primary_Directory) := Dir_Name;
1584 if Fptr > File_Name'First then
1585 Look_In_Primary_Directory_For_Current_Main := True;
1588 when Binder | Gnatls =>
1589 Dir_Name := Normalize_Directory_Name (Dir_Name.all);
1590 Lib_Search_Directories.Table (Primary_Directory) := Dir_Name;
1596 Name_Len := File_Name'Last - Fptr + 1;
1597 Name_Buffer (1 .. Name_Len) := File_Name (Fptr .. File_Name'Last);
1598 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1599 Current_Main := File_Name_Type (Name_Find);
1601 -- In the gnatmake case, the main file may have not have the
1602 -- extension. Try ".adb" first then ".ads"
1604 if Running_Program = Make then
1606 Orig_Main : constant File_Name_Type := Current_Main;
1609 if Strip_Suffix (Orig_Main) = Orig_Main then
1610 Current_Main := Append_Suffix_To_File_Name (Orig_Main, ".adb");
1612 if Full_Source_Name (Current_Main) = No_File then
1614 Append_Suffix_To_File_Name (Orig_Main, ".ads");
1616 if Full_Source_Name (Current_Main) = No_File then
1617 Current_Main := Orig_Main;
1624 return Current_Main;
1627 ------------------------------
1628 -- Normalize_Directory_Name --
1629 ------------------------------
1631 function Normalize_Directory_Name (Directory : String) return String_Ptr is
1633 function Is_Quoted (Path : String) return Boolean;
1634 pragma Inline (Is_Quoted);
1635 -- Returns true if Path is quoted (either double or single quotes)
1641 function Is_Quoted (Path : String) return Boolean is
1642 First : constant Character := Path (Path'First);
1643 Last : constant Character := Path (Path'Last);
1646 if (First = ''' and then Last = ''')
1648 (First = '"' and then Last = '"')
1656 Result : String_Ptr;
1658 -- Start of processing for Normalize_Directory_Name
1661 if Directory'Length = 0 then
1662 Result := new String'(Hostparm.Normalized_CWD);
1664 elsif Is_Directory_Separator (Directory (Directory'Last)) then
1665 Result := new String'(Directory);
1667 elsif Is_Quoted (Directory) then
1669 -- This is a quoted string, it certainly means that the directory
1670 -- contains some spaces for example. We can safely remove the quotes
1671 -- here as the OS_Lib.Normalize_Arguments will be called before any
1672 -- spawn routines. This ensure that quotes will be added when needed.
1674 Result := new String (1 .. Directory'Length - 1);
1675 Result (1 .. Directory'Length - 1) :=
1676 Directory (Directory'First + 1 .. Directory'Last - 1);
1677 Result (Result'Last) := Directory_Separator;
1680 Result := new String (1 .. Directory'Length + 1);
1681 Result (1 .. Directory'Length) := Directory;
1682 Result (Directory'Length + 1) := Directory_Separator;
1686 end Normalize_Directory_Name;
1688 ---------------------
1689 -- Number_Of_Files --
1690 ---------------------
1692 function Number_Of_Files return Int is
1694 return Number_File_Names;
1695 end Number_Of_Files;
1697 -------------------------------
1698 -- Object_Dir_Default_Prefix --
1699 -------------------------------
1701 function Object_Dir_Default_Prefix return String is
1702 Object_Dir : String_Access :=
1703 String_Access (Update_Path (Object_Dir_Default_Name));
1706 if Object_Dir = null then
1711 Result : constant String := Object_Dir.all;
1717 end Object_Dir_Default_Prefix;
1719 ----------------------
1720 -- Object_File_Name --
1721 ----------------------
1723 function Object_File_Name (N : File_Name_Type) return File_Name_Type is
1729 Get_Name_String (N);
1730 Name_Len := Name_Len - ALI_Suffix'Length - 1;
1732 for J in Object_Suffix'Range loop
1733 Name_Len := Name_Len + 1;
1734 Name_Buffer (Name_Len) := Object_Suffix (J);
1738 end Object_File_Name;
1740 --------------------------
1741 -- OS_Time_To_GNAT_Time --
1742 --------------------------
1744 function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type is
1745 GNAT_Time : Time_Stamp_Type;
1755 GM_Split (T, Y, Mo, D, H, Mn, S);
1761 Minutes => Nat (Mn),
1766 end OS_Time_To_GNAT_Time;
1772 function Program_Name (Nam : String) return String_Access is
1773 Res : String_Access;
1776 -- Get the name of the current program being executed
1780 -- Find the target prefix if any, for the cross compilation case
1781 -- for instance in "alpha-dec-vxworks-gcc" the target prefix is
1782 -- "alpha-dec-vxworks-"
1784 while Name_Len > 0 loop
1785 if Name_Buffer (Name_Len) = '-' then
1789 Name_Len := Name_Len - 1;
1792 -- Create the new program name
1794 Res := new String (1 .. Name_Len + Nam'Length);
1795 Res.all (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
1796 Res.all (Name_Len + 1 .. Name_Len + Nam'Length) := Nam;
1800 ------------------------------
1801 -- Read_Default_Search_Dirs --
1802 ------------------------------
1804 function Read_Default_Search_Dirs
1805 (Search_Dir_Prefix : String_Access;
1806 Search_File : String_Access;
1807 Search_Dir_Default_Name : String_Access) return String_Access
1809 Prefix_Len : constant Integer := Search_Dir_Prefix.all'Length;
1810 Buffer : String (1 .. Prefix_Len + Search_File.all'Length + 1);
1811 File_FD : File_Descriptor;
1812 S, S1 : String_Access;
1815 Actual_Len : Integer;
1818 Prev_Was_Separator : Boolean;
1819 Nb_Relative_Dir : Integer;
1821 function Is_Relative (S : String; K : Positive) return Boolean;
1822 pragma Inline (Is_Relative);
1823 -- Returns True if a relative directory specification is found
1824 -- in S at position K, False otherwise.
1830 function Is_Relative (S : String; K : Positive) return Boolean is
1832 return not Is_Absolute_Path (S (K .. S'Last));
1835 -- Start of processing for Read_Default_Search_Dirs
1838 -- Construct a C compatible character string buffer.
1840 Buffer (1 .. Search_Dir_Prefix.all'Length)
1841 := Search_Dir_Prefix.all;
1842 Buffer (Search_Dir_Prefix.all'Length + 1 .. Buffer'Last - 1)
1844 Buffer (Buffer'Last) := ASCII.NUL;
1846 File_FD := Open_Read (Buffer'Address, Binary);
1847 if File_FD = Invalid_FD then
1848 return Search_Dir_Default_Name;
1851 Len := Integer (File_Length (File_FD));
1853 -- An extra character for a trailing Path_Separator is allocated
1855 S := new String (1 .. Len + 1);
1856 S (Len + 1) := Path_Separator;
1858 -- Read the file. Note that the loop is not necessary since the
1859 -- whole file is read at once except on VMS.
1863 while Actual_Len /= 0 loop
1864 Actual_Len := Read (File_FD, S (Curr)'Address, Len);
1865 Curr := Curr + Actual_Len;
1868 -- Process the file, translating line and file ending
1869 -- control characters to a path separator character.
1871 Prev_Was_Separator := True;
1872 Nb_Relative_Dir := 0;
1873 for J in 1 .. Len loop
1874 if S (J) in ASCII.NUL .. ASCII.US
1877 S (J) := Path_Separator;
1880 if S (J) = Path_Separator then
1881 Prev_Was_Separator := True;
1883 if Prev_Was_Separator and then Is_Relative (S.all, J) then
1884 Nb_Relative_Dir := Nb_Relative_Dir + 1;
1887 Prev_Was_Separator := False;
1891 if Nb_Relative_Dir = 0 then
1895 -- Add the Search_Dir_Prefix to all relative paths
1897 S1 := new String (1 .. S'Length + Nb_Relative_Dir * Prefix_Len);
1899 Prev_Was_Separator := True;
1900 for J in 1 .. Len + 1 loop
1901 if S (J) = Path_Separator then
1902 Prev_Was_Separator := True;
1905 if Prev_Was_Separator and then Is_Relative (S.all, J) then
1906 S1 (J1 .. J1 + Prefix_Len - 1) := Search_Dir_Prefix.all;
1907 J1 := J1 + Prefix_Len;
1910 Prev_Was_Separator := False;
1918 end Read_Default_Search_Dirs;
1920 -----------------------
1921 -- Read_Library_Info --
1922 -----------------------
1924 function Read_Library_Info
1925 (Lib_File : File_Name_Type;
1926 Fatal_Err : Boolean := False) return Text_Buffer_Ptr
1928 Lib_FD : File_Descriptor;
1929 -- The file descriptor for the current library file. A negative value
1930 -- indicates failure to open the specified source file.
1932 Text : Text_Buffer_Ptr;
1933 -- Allocated text buffer.
1936 -- For the calls to Close
1939 Current_Full_Lib_Name := Find_File (Lib_File, Library);
1940 Current_Full_Obj_Name := Object_File_Name (Current_Full_Lib_Name);
1942 if Current_Full_Lib_Name = No_File then
1944 Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len));
1946 Current_Full_Obj_Stamp := Empty_Time_Stamp;
1951 Get_Name_String (Current_Full_Lib_Name);
1952 Name_Buffer (Name_Len + 1) := ASCII.NUL;
1954 -- Open the library FD, note that we open in binary mode, because as
1955 -- documented in the spec, the caller is expected to handle either
1956 -- DOS or Unix mode files, and there is no point in wasting time on
1957 -- text translation when it is not required.
1959 Lib_FD := Open_Read (Name_Buffer'Address, Binary);
1961 if Lib_FD = Invalid_FD then
1963 Fail ("Cannot open: ", Name_Buffer (1 .. Name_Len));
1965 Current_Full_Obj_Stamp := Empty_Time_Stamp;
1970 -- Check for object file consistency if requested
1972 if Opt.Check_Object_Consistency then
1973 Current_Full_Lib_Stamp := File_Stamp (Current_Full_Lib_Name);
1974 Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
1976 if Current_Full_Obj_Stamp (1) = ' ' then
1978 -- When the library is readonly, always assume that
1979 -- the object is consistent.
1981 if Is_Readonly_Library (Current_Full_Lib_Name) then
1982 Current_Full_Obj_Stamp := Current_Full_Lib_Stamp;
1984 elsif Fatal_Err then
1985 Get_Name_String (Current_Full_Obj_Name);
1986 Close (Lib_FD, Status);
1987 -- No need to check the status, we fail anyway
1989 Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len));
1992 Current_Full_Obj_Stamp := Empty_Time_Stamp;
1993 Close (Lib_FD, Status);
1994 -- No need to check the status, we return null anyway
2000 -- Object file exists, compare object and ALI time stamps
2002 if Current_Full_Lib_Stamp > Current_Full_Obj_Stamp then
2004 Get_Name_String (Current_Full_Obj_Name);
2005 Close (Lib_FD, Status);
2006 -- No need to check the status, we fail anyway
2007 Fail ("Bad time stamp: ", Name_Buffer (1 .. Name_Len));
2009 Current_Full_Obj_Stamp := Empty_Time_Stamp;
2010 Close (Lib_FD, Status);
2011 -- No need to check the status, we return null anyway
2018 -- Read data from the file
2021 Len : constant Integer := Integer (File_Length (Lib_FD));
2022 -- Length of source file text. If it doesn't fit in an integer
2023 -- we're probably stuck anyway (>2 gigs of source seems a lot!)
2025 Actual_Len : Integer := 0;
2027 Lo : constant Text_Ptr := 0;
2028 -- Low bound for allocated text buffer
2030 Hi : Text_Ptr := Text_Ptr (Len);
2031 -- High bound for allocated text buffer. Note length is Len + 1
2032 -- which allows for extra EOF character at the end of the buffer.
2035 -- Allocate text buffer. Note extra character at end for EOF
2037 Text := new Text_Buffer (Lo .. Hi);
2039 -- Some systems (e.g. VMS) have file types that require one
2040 -- read per line, so read until we get the Len bytes or until
2041 -- there are no more characters.
2045 Actual_Len := Read (Lib_FD, Text (Hi)'Address, Len);
2046 Hi := Hi + Text_Ptr (Actual_Len);
2047 exit when Actual_Len = Len or Actual_Len <= 0;
2053 -- Read is complete, close file and we are done
2055 Close (Lib_FD, Status);
2056 -- The status should never be False. But, if it is, what can we do?
2057 -- So, we don't test it.
2061 end Read_Library_Info;
2063 ----------------------
2064 -- Read_Source_File --
2065 ----------------------
2067 procedure Read_Source_File
2068 (N : File_Name_Type;
2070 Hi : out Source_Ptr;
2071 Src : out Source_Buffer_Ptr;
2072 T : File_Type := Source)
2074 Source_File_FD : File_Descriptor;
2075 -- The file descriptor for the current source file. A negative value
2076 -- indicates failure to open the specified source file.
2079 -- Length of file. Assume no more than 2 gigabytes of source!
2081 Actual_Len : Integer;
2084 -- For the call to Close
2087 Current_Full_Source_Name := Find_File (N, T);
2088 Current_Full_Source_Stamp := File_Stamp (Current_Full_Source_Name);
2090 if Current_Full_Source_Name = No_File then
2092 -- If we were trying to access the main file and we could not
2093 -- find it we have an error.
2095 if N = Current_Main then
2096 Get_Name_String (N);
2097 Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len));
2105 Get_Name_String (Current_Full_Source_Name);
2106 Name_Buffer (Name_Len + 1) := ASCII.NUL;
2108 -- Open the source FD, note that we open in binary mode, because as
2109 -- documented in the spec, the caller is expected to handle either
2110 -- DOS or Unix mode files, and there is no point in wasting time on
2111 -- text translation when it is not required.
2113 Source_File_FD := Open_Read (Name_Buffer'Address, Binary);
2115 if Source_File_FD = Invalid_FD then
2121 -- Prepare to read data from the file
2123 Len := Integer (File_Length (Source_File_FD));
2125 -- Set Hi so that length is one more than the physical length,
2126 -- allowing for the extra EOF character at the end of the buffer
2128 Hi := Lo + Source_Ptr (Len);
2130 -- Do the actual read operation
2133 subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
2134 -- Physical buffer allocated
2136 type Actual_Source_Ptr is access Actual_Source_Buffer;
2137 -- This is the pointer type for the physical buffer allocated
2139 Actual_Ptr : Actual_Source_Ptr := new Actual_Source_Buffer;
2140 -- And this is the actual physical buffer
2143 -- Allocate source buffer, allowing extra character at end for EOF
2145 -- Some systems (e.g. VMS) have file types that require one
2146 -- read per line, so read until we get the Len bytes or until
2147 -- there are no more characters.
2151 Actual_Len := Read (Source_File_FD, Actual_Ptr (Hi)'Address, Len);
2152 Hi := Hi + Source_Ptr (Actual_Len);
2153 exit when Actual_Len = Len or Actual_Len <= 0;
2156 Actual_Ptr (Hi) := EOF;
2158 -- Now we need to work out the proper virtual origin pointer to
2159 -- return. This is exactly Actual_Ptr (0)'Address, but we have
2160 -- to be careful to suppress checks to compute this address.
2163 pragma Suppress (All_Checks);
2165 function To_Source_Buffer_Ptr is new
2166 Unchecked_Conversion (Address, Source_Buffer_Ptr);
2169 Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
2173 -- Read is complete, get time stamp and close file and we are done
2175 Close (Source_File_FD, Status);
2176 -- The status should never be False. But, if it is, what can we do?
2177 -- So, we don't test it.
2179 end Read_Source_File;
2185 function Relocate_Path
2187 Path : String) return String_Ptr
2191 procedure set_std_prefix (S : String; Len : Integer);
2192 pragma Import (C, set_std_prefix);
2195 if Std_Prefix = null then
2196 Std_Prefix := Executable_Prefix;
2198 if Std_Prefix.all /= "" then
2199 -- Remove trailing directory separator when calling set_std_prefix
2201 set_std_prefix (Std_Prefix.all, Std_Prefix'Length - 1);
2205 if Path (Prefix'Range) = Prefix then
2206 if Std_Prefix.all /= "" then
2208 (1 .. Std_Prefix'Length + Path'Last - Prefix'Last);
2209 S (1 .. Std_Prefix'Length) := Std_Prefix.all;
2210 S (Std_Prefix'Length + 1 .. S'Last) :=
2211 Path (Prefix'Last + 1 .. Path'Last);
2216 return new String'(Path);
2223 procedure Set_Program (P : Program_Type) is
2226 Fail ("Set_Program called twice");
2229 Program_Set := True;
2230 Running_Program := P;
2233 ----------------------
2234 -- Smart_File_Stamp --
2235 ----------------------
2237 function Smart_File_Stamp
2238 (N : File_Name_Type;
2239 T : File_Type) return Time_Stamp_Type
2241 Time_Stamp : Time_Stamp_Type;
2244 if not File_Cache_Enabled then
2245 return File_Stamp (Find_File (N, T));
2248 Time_Stamp := File_Stamp_Hash_Table.Get (N);
2250 if Time_Stamp (1) = ' ' then
2251 Time_Stamp := File_Stamp (Smart_Find_File (N, T));
2252 File_Stamp_Hash_Table.Set (N, Time_Stamp);
2256 end Smart_File_Stamp;
2258 ---------------------
2259 -- Smart_Find_File --
2260 ---------------------
2262 function Smart_Find_File
2263 (N : File_Name_Type;
2264 T : File_Type) return File_Name_Type
2266 Full_File_Name : File_Name_Type;
2269 if not File_Cache_Enabled then
2270 return Find_File (N, T);
2273 Full_File_Name := File_Name_Hash_Table.Get (N);
2275 if Full_File_Name = No_File then
2276 Full_File_Name := Find_File (N, T);
2277 File_Name_Hash_Table.Set (N, Full_File_Name);
2280 return Full_File_Name;
2281 end Smart_Find_File;
2283 ----------------------
2284 -- Source_File_Data --
2285 ----------------------
2287 procedure Source_File_Data (Cache : Boolean) is
2289 File_Cache_Enabled := Cache;
2290 end Source_File_Data;
2292 -----------------------
2293 -- Source_File_Stamp --
2294 -----------------------
2296 function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type is
2298 return Smart_File_Stamp (N, Source);
2299 end Source_File_Stamp;
2301 ---------------------
2302 -- Strip_Directory --
2303 ---------------------
2305 function Strip_Directory (Name : File_Name_Type) return File_Name_Type is
2307 Get_Name_String (Name);
2309 for J in reverse 1 .. Name_Len - 1 loop
2310 -- If we find the last directory separator
2312 if Is_Directory_Separator (Name_Buffer (J)) then
2313 -- Return the part of Name that follows this last directory
2316 Name_Buffer (1 .. Name_Len - J) := Name_Buffer (J + 1 .. Name_Len);
2317 Name_Len := Name_Len - J;
2322 -- There were no directory separator, just return Name
2325 end Strip_Directory;
2331 function Strip_Suffix (Name : File_Name_Type) return File_Name_Type is
2333 Get_Name_String (Name);
2335 for J in reverse 2 .. Name_Len loop
2337 -- If we found the last '.', return the part of Name that precedes
2340 if Name_Buffer (J) = '.' then
2349 ---------------------------
2350 -- To_Canonical_Dir_Spec --
2351 ---------------------------
2353 function To_Canonical_Dir_Spec
2355 Prefix_Style : Boolean) return String_Access
2357 function To_Canonical_Dir_Spec
2358 (Host_Dir : Address;
2359 Prefix_Flag : Integer) return Address;
2360 pragma Import (C, To_Canonical_Dir_Spec, "__gnat_to_canonical_dir_spec");
2362 C_Host_Dir : String (1 .. Host_Dir'Length + 1);
2363 Canonical_Dir_Addr : Address;
2364 Canonical_Dir_Len : Integer;
2367 C_Host_Dir (1 .. Host_Dir'Length) := Host_Dir;
2368 C_Host_Dir (C_Host_Dir'Last) := ASCII.NUL;
2370 if Prefix_Style then
2371 Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 1);
2373 Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 0);
2375 Canonical_Dir_Len := C_String_Length (Canonical_Dir_Addr);
2377 if Canonical_Dir_Len = 0 then
2380 return To_Path_String_Access (Canonical_Dir_Addr, Canonical_Dir_Len);
2385 Fail ("erroneous directory spec: ", Host_Dir);
2387 end To_Canonical_Dir_Spec;
2389 ---------------------------
2390 -- To_Canonical_File_List --
2391 ---------------------------
2393 function To_Canonical_File_List
2394 (Wildcard_Host_File : String;
2395 Only_Dirs : Boolean) return String_Access_List_Access
2397 function To_Canonical_File_List_Init
2398 (Host_File : Address;
2399 Only_Dirs : Integer) return Integer;
2400 pragma Import (C, To_Canonical_File_List_Init,
2401 "__gnat_to_canonical_file_list_init");
2403 function To_Canonical_File_List_Next return Address;
2404 pragma Import (C, To_Canonical_File_List_Next,
2405 "__gnat_to_canonical_file_list_next");
2407 procedure To_Canonical_File_List_Free;
2408 pragma Import (C, To_Canonical_File_List_Free,
2409 "__gnat_to_canonical_file_list_free");
2411 Num_Files : Integer;
2412 C_Wildcard_Host_File : String (1 .. Wildcard_Host_File'Length + 1);
2415 C_Wildcard_Host_File (1 .. Wildcard_Host_File'Length) :=
2417 C_Wildcard_Host_File (C_Wildcard_Host_File'Last) := ASCII.NUL;
2419 -- Do the expansion and say how many there are
2421 Num_Files := To_Canonical_File_List_Init
2422 (C_Wildcard_Host_File'Address, Boolean'Pos (Only_Dirs));
2425 Canonical_File_List : String_Access_List (1 .. Num_Files);
2426 Canonical_File_Addr : Address;
2427 Canonical_File_Len : Integer;
2430 -- Retrieve the expanded directoy names and build the list
2432 for J in 1 .. Num_Files loop
2433 Canonical_File_Addr := To_Canonical_File_List_Next;
2434 Canonical_File_Len := C_String_Length (Canonical_File_Addr);
2435 Canonical_File_List (J) := To_Path_String_Access
2436 (Canonical_File_Addr, Canonical_File_Len);
2439 -- Free up the storage
2441 To_Canonical_File_List_Free;
2443 return new String_Access_List'(Canonical_File_List);
2445 end To_Canonical_File_List;
2447 ----------------------------
2448 -- To_Canonical_File_Spec --
2449 ----------------------------
2451 function To_Canonical_File_Spec
2452 (Host_File : String) return String_Access
2454 function To_Canonical_File_Spec (Host_File : Address) return Address;
2456 (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
2458 C_Host_File : String (1 .. Host_File'Length + 1);
2459 Canonical_File_Addr : Address;
2460 Canonical_File_Len : Integer;
2463 C_Host_File (1 .. Host_File'Length) := Host_File;
2464 C_Host_File (C_Host_File'Last) := ASCII.NUL;
2466 Canonical_File_Addr := To_Canonical_File_Spec (C_Host_File'Address);
2467 Canonical_File_Len := C_String_Length (Canonical_File_Addr);
2469 if Canonical_File_Len = 0 then
2472 return To_Path_String_Access
2473 (Canonical_File_Addr, Canonical_File_Len);
2478 Fail ("erroneous file spec: ", Host_File);
2480 end To_Canonical_File_Spec;
2482 ----------------------------
2483 -- To_Canonical_Path_Spec --
2484 ----------------------------
2486 function To_Canonical_Path_Spec
2487 (Host_Path : String) return String_Access
2489 function To_Canonical_Path_Spec (Host_Path : Address) return Address;
2491 (C, To_Canonical_Path_Spec, "__gnat_to_canonical_path_spec");
2493 C_Host_Path : String (1 .. Host_Path'Length + 1);
2494 Canonical_Path_Addr : Address;
2495 Canonical_Path_Len : Integer;
2498 C_Host_Path (1 .. Host_Path'Length) := Host_Path;
2499 C_Host_Path (C_Host_Path'Last) := ASCII.NUL;
2501 Canonical_Path_Addr := To_Canonical_Path_Spec (C_Host_Path'Address);
2502 Canonical_Path_Len := C_String_Length (Canonical_Path_Addr);
2504 -- Return a null string (vice a null) for zero length paths, for
2505 -- compatibility with getenv().
2507 return To_Path_String_Access (Canonical_Path_Addr, Canonical_Path_Len);
2511 Fail ("erroneous path spec: ", Host_Path);
2513 end To_Canonical_Path_Spec;
2515 ---------------------------
2516 -- To_Host_Dir_Spec --
2517 ---------------------------
2519 function To_Host_Dir_Spec
2520 (Canonical_Dir : String;
2521 Prefix_Style : Boolean) return String_Access
2523 function To_Host_Dir_Spec
2524 (Canonical_Dir : Address;
2525 Prefix_Flag : Integer) return Address;
2526 pragma Import (C, To_Host_Dir_Spec, "__gnat_to_host_dir_spec");
2528 C_Canonical_Dir : String (1 .. Canonical_Dir'Length + 1);
2529 Host_Dir_Addr : Address;
2530 Host_Dir_Len : Integer;
2533 C_Canonical_Dir (1 .. Canonical_Dir'Length) := Canonical_Dir;
2534 C_Canonical_Dir (C_Canonical_Dir'Last) := ASCII.NUL;
2536 if Prefix_Style then
2537 Host_Dir_Addr := To_Host_Dir_Spec (C_Canonical_Dir'Address, 1);
2539 Host_Dir_Addr := To_Host_Dir_Spec (C_Canonical_Dir'Address, 0);
2541 Host_Dir_Len := C_String_Length (Host_Dir_Addr);
2543 if Host_Dir_Len = 0 then
2546 return To_Path_String_Access (Host_Dir_Addr, Host_Dir_Len);
2548 end To_Host_Dir_Spec;
2550 ----------------------------
2551 -- To_Host_File_Spec --
2552 ----------------------------
2554 function To_Host_File_Spec
2555 (Canonical_File : String) return String_Access
2557 function To_Host_File_Spec (Canonical_File : Address) return Address;
2558 pragma Import (C, To_Host_File_Spec, "__gnat_to_host_file_spec");
2560 C_Canonical_File : String (1 .. Canonical_File'Length + 1);
2561 Host_File_Addr : Address;
2562 Host_File_Len : Integer;
2565 C_Canonical_File (1 .. Canonical_File'Length) := Canonical_File;
2566 C_Canonical_File (C_Canonical_File'Last) := ASCII.NUL;
2568 Host_File_Addr := To_Host_File_Spec (C_Canonical_File'Address);
2569 Host_File_Len := C_String_Length (Host_File_Addr);
2571 if Host_File_Len = 0 then
2574 return To_Path_String_Access
2575 (Host_File_Addr, Host_File_Len);
2577 end To_Host_File_Spec;
2579 ---------------------------
2580 -- To_Path_String_Access --
2581 ---------------------------
2583 function To_Path_String_Access
2584 (Path_Addr : Address;
2585 Path_Len : Integer) return String_Access
2587 subtype Path_String is String (1 .. Path_Len);
2588 type Path_String_Access is access Path_String;
2590 function Address_To_Access is new
2591 Unchecked_Conversion (Source => Address,
2592 Target => Path_String_Access);
2594 Path_Access : constant Path_String_Access :=
2595 Address_To_Access (Path_Addr);
2597 Return_Val : String_Access;
2600 Return_Val := new String (1 .. Path_Len);
2602 for J in 1 .. Path_Len loop
2603 Return_Val (J) := Path_Access (J);
2607 end To_Path_String_Access;
2613 function Update_Path (Path : String_Ptr) return String_Ptr is
2615 function C_Update_Path (Path, Component : Address) return Address;
2616 pragma Import (C, C_Update_Path, "update_path");
2618 function Strlen (Str : Address) return Integer;
2619 pragma Import (C, Strlen, "strlen");
2621 procedure Strncpy (X : Address; Y : Address; Length : Integer);
2622 pragma Import (C, Strncpy, "strncpy");
2624 In_Length : constant Integer := Path'Length;
2625 In_String : String (1 .. In_Length + 1);
2626 Component_Name : aliased String := "GCC" & ASCII.NUL;
2627 Result_Ptr : Address;
2628 Result_Length : Integer;
2629 Out_String : String_Ptr;
2632 In_String (1 .. In_Length) := Path.all;
2633 In_String (In_Length + 1) := ASCII.NUL;
2634 Result_Ptr := C_Update_Path (In_String'Address,
2635 Component_Name'Address);
2636 Result_Length := Strlen (Result_Ptr);
2638 Out_String := new String (1 .. Result_Length);
2639 Strncpy (Out_String.all'Address, Result_Ptr, Result_Length);
2647 procedure Write_Info (Info : String) is
2649 Write_With_Check (Info'Address, Info'Length);
2650 Write_With_Check (EOL'Address, 1);
2653 ------------------------
2654 -- Write_Program_Name --
2655 ------------------------
2657 procedure Write_Program_Name is
2658 Save_Buffer : constant String (1 .. Name_Len) :=
2659 Name_Buffer (1 .. Name_Len);
2665 -- Convert the name to lower case so error messages are the same on
2668 for J in 1 .. Name_Len loop
2669 if Name_Buffer (J) in 'A' .. 'Z' then
2671 Character'Val (Character'Pos (Name_Buffer (J)) + 32);
2675 Write_Str (Name_Buffer (1 .. Name_Len));
2677 -- Restore Name_Buffer which was clobbered by the call to
2678 -- Find_Program_Name
2680 Name_Len := Save_Buffer'Last;
2681 Name_Buffer (1 .. Name_Len) := Save_Buffer;
2682 end Write_Program_Name;
2684 ----------------------
2685 -- Write_With_Check --
2686 ----------------------
2688 procedure Write_With_Check (A : Address; N : Integer) is
2692 if N = Write (Output_FD, A, N) then
2696 Write_Str ("error: disk full writing ");
2697 Write_Name_Decoded (Output_File_Name);
2699 Name_Len := Name_Len + 1;
2700 Name_Buffer (Name_Len) := ASCII.NUL;
2701 Delete_File (Name_Buffer'Address, Ignore);
2702 Exit_Program (E_Fatal);
2704 end Write_With_Check;
2706 ----------------------------
2707 -- Package Initialization --
2708 ----------------------------
2711 Initialization : declare
2713 function Get_Default_Identifier_Character_Set return Character;
2714 pragma Import (C, Get_Default_Identifier_Character_Set,
2715 "__gnat_get_default_identifier_character_set");
2716 -- Function to determine the default identifier character set,
2717 -- which is system dependent. See Opt package spec for a list of
2718 -- the possible character codes and their interpretations.
2720 function Get_Maximum_File_Name_Length return Int;
2721 pragma Import (C, Get_Maximum_File_Name_Length,
2722 "__gnat_get_maximum_file_name_length");
2723 -- Function to get maximum file name length for system
2726 Identifier_Character_Set := Get_Default_Identifier_Character_Set;
2727 Maximum_File_Name_Length := Get_Maximum_File_Name_Length;
2729 -- Following should be removed by having above function return
2730 -- Integer'Last as indication of no maximum instead of -1 ???
2732 if Maximum_File_Name_Length = -1 then
2733 Maximum_File_Name_Length := Int'Last;
2736 Src_Search_Directories.Set_Last (Primary_Directory);
2737 Src_Search_Directories.Table (Primary_Directory) := new String'("");
2739 Lib_Search_Directories.Set_Last (Primary_Directory);
2740 Lib_Search_Directories.Table (Primary_Directory) := new String'("");