-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
-with Fmap; use Fmap;
-with Gnatvsn; use Gnatvsn;
-with Hostparm;
-with Namet; use Namet;
-with Opt; use Opt;
-with Output; use Output;
-with Sdefault; use Sdefault;
-with Table;
+with Unchecked_Conversion;
with System.Case_Util; use System.Case_Util;
-with Unchecked_Conversion;
-
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.HTable;
+with Fmap; use Fmap;
+with Gnatvsn; use Gnatvsn;
+with Hostparm;
+with Opt; use Opt;
+with Output; use Output;
+with Sdefault; use Sdefault;
+with Table;
+with Targparm; use Targparm;
+
package body Osint is
Running_Program : Program_Type := Unspecified;
-------------------------------------
-- This package creates a number of source, ALI and object file names
- -- that are used to locate the actual file and for the purpose of
- -- message construction. These names need not be accessible by Name_Find,
- -- and can be therefore created by using routine Name_Enter. The files in
- -- question are file names with a prefix directory (ie the files not
- -- in the current directory). File names without a prefix directory are
- -- entered with Name_Find because special values might be attached to
- -- the various Info fields of the corresponding name table entry.
+ -- that are used to locate the actual file and for the purpose of message
+ -- construction. These names need not be accessible by Name_Find, and can
+ -- be therefore created by using routine Name_Enter. The files in question
+ -- are file names with a prefix directory (ie the files not in the current
+ -- directory). File names without a prefix directory are entered with
+ -- Name_Find because special values might be attached to the various Info
+ -- fields of the corresponding name table entry.
-----------------------
-- Local Subprograms --
-----------------------
function Append_Suffix_To_File_Name
- (Name : Name_Id;
- Suffix : String) return Name_Id;
- -- Appends Suffix to Name and returns the new name.
+ (Name : File_Name_Type;
+ Suffix : String) return File_Name_Type;
+ -- Appends Suffix to Name and returns the new name
function OS_Time_To_GNAT_Time (T : OS_Time) return Time_Stamp_Type;
-- Convert OS format time to GNAT format time stamp
- function Concat (String_One : String; String_Two : String) return String;
- -- Concatenates 2 strings and returns the result of the concatenation
-
function Executable_Prefix return String_Ptr;
-- Returns the name of the root directory where the executable is stored.
- -- The executable must be located in a directory called "bin", or
- -- under root/lib/gcc-lib/..., or under root/libexec/gcc/... Thus, if
- -- the executable is stored in directory "/foo/bar/bin", this routine
- -- returns "/foo/bar/". Return "" if the location is not recognized
- -- as described above.
+ -- The executable must be located in a directory called "bin", or under
+ -- root/lib/gcc-lib/..., or under root/libexec/gcc/... For example, if
+ -- executable is stored in directory "/foo/bar/bin", this routine returns
+ -- "/foo/bar/". Return "" if location is not recognized as described above.
function Update_Path (Path : String_Ptr) return String_Ptr;
-- Update the specified path to replace the prefix with the location
-- where GNAT is installed. See the file prefix.c in GCC for details.
- procedure Write_With_Check (A : Address; N : Integer);
- -- Writes N bytes from buffer starting at address A to file whose FD is
- -- stored in Output_FD, and whose file name is stored as a File_Name_Type
- -- in Output_File_Name. A check is made for disk full, and if this is
- -- detected, the file being written is deleted, and a fatal error is
- -- signalled.
-
function Locate_File
(N : File_Name_Type;
T : File_Type;
Dir : Natural;
Name : String) return File_Name_Type;
- -- See if the file N whose name is Name exists in directory Dir. Dir is
- -- an index into the Lib_Search_Directories table if T = Library.
- -- Otherwise if T = Source, Dir is an index into the
- -- Src_Search_Directories table. Returns the File_Name_Type of the
- -- full file name if file found, or No_File if not found.
+ -- See if the file N whose name is Name exists in directory Dir. Dir is an
+ -- index into the Lib_Search_Directories table if T = Library. Otherwise
+ -- if T = Source, Dir is an index into the Src_Search_Directories table.
+ -- Returns the File_Name_Type of the full file name if file found, or
+ -- No_File if not found.
function C_String_Length (S : Address) return Integer;
- -- Returns length of a C string. Returns zero for a null address.
+ -- Returns length of a C string (zero for a null address)
function To_Path_String_Access
(Path_Addr : Address;
Path_Len : Integer) return String_Access;
- -- Converts a C String to an Ada String. Are we doing this to avoid
- -- withing Interfaces.C.Strings ???
+ -- Converts a C String to an Ada String. Are we doing this to avoid withing
+ -- Interfaces.C.Strings ???
------------------------------
-- Other Local Declarations --
-- End of line character
Number_File_Names : Int := 0;
- -- The total number of file names found on command line and placed in
- -- File_Names.
+ -- Number of file names founde on command line and placed in File_Names
Look_In_Primary_Directory_For_Current_Main : Boolean := False;
- -- When this variable is True, Find_File will only look in
- -- the Primary_Directory for the Current_Main file.
- -- This variable is always True for the compiler.
- -- It is also True for gnatmake, when the soucr name given
- -- on the command line has directory information.
+ -- When this variable is True, Find_File only looks in Primary_Directory
+ -- for the Current_Main file. This variable is always set to True for the
+ -- compiler. It is also True for gnatmake, when the soucr name given on
+ -- the command line has directory information.
Current_Full_Source_Name : File_Name_Type := No_File;
Current_Full_Source_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
Current_Full_Lib_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
Current_Full_Obj_Name : File_Name_Type := No_File;
Current_Full_Obj_Stamp : Time_Stamp_Type := Empty_Time_Stamp;
- -- Respectively full name (with directory info) and time stamp of
- -- the latest source, library and object files opened by Read_Source_File
- -- and Read_Library_Info.
+ -- Respectively full name (with directory info) and time stamp of the
+ -- latest source, library and object files opened by Read_Source_File and
+ -- Read_Library_Info.
------------------
-- Search Paths --
Primary_Directory : constant := 0;
-- This is index in the tables created below for the first directory to
- -- search in for source or library information files. This is the
- -- directory containing the latest main input file (a source file for
- -- the compiler or a library file for the binder).
+ -- search in for source or library information files. This is the directory
+ -- containing the latest main input file (a source file for the compiler or
+ -- a library file for the binder).
package Src_Search_Directories is new Table.Table (
Table_Component_Type => String_Ptr,
- Table_Index_Type => Natural,
+ Table_Index_Type => Integer,
Table_Low_Bound => Primary_Directory,
Table_Initial => 10,
Table_Increment => 100,
package Lib_Search_Directories is new Table.Table (
Table_Component_Type => String_Ptr,
- Table_Index_Type => Natural,
+ Table_Index_Type => Integer,
Table_Low_Bound => Primary_Directory,
Table_Initial => 10,
Table_Increment => 100,
-- efficiency concern when retrieving full file names or time stamps of
-- source files. If the programmer calls Source_File_Data (Cache => True)
-- he is guaranteed that the price to retrieve the full name (ie with
- -- directory info) or time stamp of the file will be payed only once,
- -- the first time the full name is actually searched (or the first time
- -- the time stamp is actually retrieved). This is achieved by employing
- -- a hash table that stores as a key the File_Name_Type of the file and
- -- associates to that File_Name_Type the full file name of the file and its
- -- time stamp.
+ -- directory info) or time stamp of the file will be payed only once, the
+ -- first time the full name is actually searched (or the first time the
+ -- time stamp is actually retrieved). This is achieved by employing a hash
+ -- table that stores as a key the File_Name_Type of the file and associates
+ -- to that File_Name_Type the full file name and time stamp of the file.
File_Cache_Enabled : Boolean := False;
- -- Set to true if you want the enable the file data caching mechanism.
+ -- Set to true if you want the enable the file data caching mechanism
type File_Hash_Num is range 0 .. 1020;
function Smart_File_Stamp
(N : File_Name_Type;
T : File_Type) return Time_Stamp_Type;
- -- Takes the same parameter as the routine above (N is a file name
- -- without any prefix directory information) and behaves like File_Stamp
- -- except that if File_Cache_Enabled is True this routine looks first in
- -- the hash table to see if the file stamp of the file is already
- -- available.
+ -- Takes the same parameter as the routine above (N is a file name without
+ -- any prefix directory information) and behaves like File_Stamp except
+ -- that if File_Cache_Enabled is True this routine looks first in the hash
+ -- table to see if the file stamp of the file is already available.
-----------------------------
-- Add_Default_Search_Dirs --
function Get_Libraries_From_Registry return String_Ptr;
-- On Windows systems, get the list of installed standard libraries
-- from the registry key:
+ --
-- HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\
-- GNAT\Standard Libraries
-- Return an empty string on other systems
procedure Get_Dirs_From_File (Additional_Source_Dir : Boolean) is
File_FD : File_Descriptor;
- Buffer : String (1 .. Path_File_Name'Length + 1);
+ Buffer : constant String := Path_File_Name.all & ASCII.NUL;
Len : Natural;
Actual_Len : Natural;
S : String_Access;
-- For the call to Close
begin
- -- Construct a C compatible character string buffer
-
- Buffer (1 .. Buffer'Last - 1) := Path_File_Name.all;
- Buffer (Buffer'Last) := ASCII.NUL;
-
File_FD := Open_Read (Buffer'Address, Binary);
-- If we cannot open the file, we ignore it, we don't fail
Curr := Curr + Actual_Len;
end loop;
- -- We are done with the file, so we close it
+ -- We are done with the file, so we close it (ignore any error on
+ -- the close, since we have successfully read the file).
Close (File_FD, Status);
- -- We ignore any error here, because we have successfully read the
- -- file.
-- Now, we read line by line
First := 1;
Curr := 0;
-
while Curr < Len loop
Ch := S (Curr + 1);
function C_Get_Libraries_From_Registry return Address;
pragma Import (C, C_Get_Libraries_From_Registry,
"__gnat_get_libraries_from_registry");
+
function Strlen (Str : Address) return Integer;
pragma Import (C, Strlen, "strlen");
+
procedure Strncpy (X : Address; Y : Address; Length : Integer);
pragma Import (C, Strncpy, "strncpy");
- Result_Ptr : Address;
+
+ Result_Ptr : Address;
Result_Length : Integer;
- Out_String : String_Ptr;
+ Out_String : String_Ptr;
begin
Result_Ptr := C_Get_Libraries_From_Registry;
-- will handle the expansion as part of the file processing.
for Additional_Source_Dir in False .. True loop
-
if Additional_Source_Dir then
Search_Path := Getenv (Ada_Include_Path);
+
if Search_Path'Length > 0 then
if Hostparm.OpenVMS then
Search_Path := To_Canonical_Path_Spec ("ADA_INCLUDE_PATH:");
Search_Path := To_Canonical_Path_Spec (Search_Path.all);
end if;
end if;
+
else
Search_Path := Getenv (Ada_Objects_Path);
+
if Search_Path'Length > 0 then
if Hostparm.OpenVMS then
Search_Path := To_Canonical_Path_Spec ("ADA_OBJECTS_PATH:");
-- For the compiler, if --RTS= was specified, add the runtime
-- directories.
- if RTS_Src_Path_Name /= null and then
- RTS_Lib_Path_Name /= null
+ if RTS_Src_Path_Name /= null
+ and then RTS_Lib_Path_Name /= null
then
Add_Search_Dirs (RTS_Src_Path_Name, Include);
Add_Search_Dirs (RTS_Lib_Path_Name, Objects);
begin
Number_File_Names := Number_File_Names + 1;
- -- As Add_File may be called for mains specified inside
- -- a project file, File_Names may be too short and needs
- -- to be extended.
+ -- As Add_File may be called for mains specified inside a project file,
+ -- File_Names may be too short and needs to be extended.
if Number_File_Names > File_Names'Last then
File_Names := new File_Name_Array'(File_Names.all & File_Names.all);
--------------------------------
function Append_Suffix_To_File_Name
- (Name : Name_Id;
- Suffix : String) return Name_Id
+ (Name : File_Name_Type;
+ Suffix : String) return File_Name_Type
is
begin
Get_Name_String (Name);
end if;
end Canonical_Case_File_Name;
- ------------
- -- Concat --
- ------------
-
- function Concat (String_One : String; String_Two : String) return String is
- Buffer : String (1 .. String_One'Length + String_Two'Length);
- begin
- Buffer (1 .. String_One'Length) := String_One;
- Buffer (String_One'Length + 1 .. Buffer'Last) := String_Two;
- return Buffer;
- end Concat;
-
---------------------------
-- Create_File_And_Check --
---------------------------
return No_File;
end if;
+ if Executable_Extension_On_Target = No_Name then
+ Exec_Suffix := Get_Target_Executable_Suffix;
+ else
+ Get_Name_String (Executable_Extension_On_Target);
+ Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
+ end if;
+
Get_Name_String (Name);
- Exec_Suffix := Get_Executable_Suffix;
- for J in Exec_Suffix'Range loop
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Exec_Suffix (J);
- end loop;
+ if Exec_Suffix'Length /= 0 then
+ declare
+ Buffer : String := Name_Buffer (1 .. Name_Len);
+
+ begin
+ -- Get the file name in canonical case to accept as is names
+ -- ending with ".EXE" on VMS and Windows.
+
+ Canonical_Case_File_Name (Buffer);
+
+ -- If Executable does not end with the executable suffix, add it
+
+ if Buffer'Length <= Exec_Suffix'Length
+ or else
+ Buffer (Buffer'Last - Exec_Suffix'Length + 1 .. Buffer'Last)
+ /= Exec_Suffix.all
+ then
+ Name_Buffer (Name_Len + 1 .. Name_Len + Exec_Suffix'Length) :=
+ Exec_Suffix.all;
+ Name_Len := Name_Len + Exec_Suffix'Length;
+ Free (Exec_Suffix);
+ return Name_Find;
+ end if;
+ end;
+ end if;
Free (Exec_Suffix);
+ return Name;
+ end Executable_Name;
- return Name_Enter;
+ function Executable_Name (Name : String) return String is
+ Exec_Suffix : String_Access;
+ Canonical_Name : String := Name;
+
+ begin
+ if Executable_Extension_On_Target = No_Name then
+ Exec_Suffix := Get_Target_Executable_Suffix;
+ else
+ Get_Name_String (Executable_Extension_On_Target);
+ Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
+ end if;
+
+ declare
+ Suffix : constant String := Exec_Suffix.all;
+
+ begin
+ Free (Exec_Suffix);
+ Canonical_Case_File_Name (Canonical_Name);
+
+ if Suffix'Length /= 0
+ and then
+ (Canonical_Name'Length <= Suffix'Length
+ or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
+ .. Canonical_Name'Last) /= Suffix)
+ then
+ declare
+ Result : String (1 .. Name'Length + Suffix'Length);
+ begin
+ Result (1 .. Name'Length) := Name;
+ Result (Name'Length + 1 .. Result'Last) := Suffix;
+ return Result;
+ end;
+ else
+ return Name;
+ end if;
+ end;
end Executable_Name;
-----------------------
-----------------------
function Executable_Prefix return String_Ptr is
+
function Get_Install_Dir (Exec : String) return String_Ptr;
-- S is the executable name preceeded by the absolute or relative
-- path, e.g. "c:\usr\bin\gcc.exe" or "..\bin\gcc".
---------------------
function Get_Install_Dir (Exec : String) return String_Ptr is
+ Full_Path : constant String := Normalize_Pathname (Exec);
+ -- Use the full path, so that we find "lib" or "bin", even when
+ -- the tool has been invoked with a relative path, as in
+ -- "./gnatls -v" invoked in the GNAT bin directory.
+
begin
- for J in reverse Exec'Range loop
- if Is_Directory_Separator (Exec (J)) then
- if J < Exec'Last - 5 then
- if (To_Lower (Exec (J + 1)) = 'l'
- and then To_Lower (Exec (J + 2)) = 'i'
- and then To_Lower (Exec (J + 3)) = 'b')
+ for J in reverse Full_Path'Range loop
+ if Is_Directory_Separator (Full_Path (J)) then
+ if J < Full_Path'Last - 5 then
+ if (To_Lower (Full_Path (J + 1)) = 'l'
+ and then To_Lower (Full_Path (J + 2)) = 'i'
+ and then To_Lower (Full_Path (J + 3)) = 'b')
or else
- (To_Lower (Exec (J + 1)) = 'b'
- and then To_Lower (Exec (J + 2)) = 'i'
- and then To_Lower (Exec (J + 3)) = 'n')
+ (To_Lower (Full_Path (J + 1)) = 'b'
+ and then To_Lower (Full_Path (J + 2)) = 'i'
+ and then To_Lower (Full_Path (J + 3)) = 'n')
then
- return new String'(Exec (Exec'First .. J));
+ return new String'(Full_Path (Full_Path'First .. J));
end if;
end if;
end if;
-- If we come here, the user has typed the executable name with no
-- directory prefix.
- return Get_Install_Dir
- (GNAT.OS_Lib.Locate_Exec_On_Path (Exec_Name.all).all);
+ return Get_Install_Dir (Locate_Exec_On_Path (Exec_Name.all).all);
end Executable_Prefix;
------------------
end if;
end File_Stamp;
+ function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type is
+ begin
+ return File_Stamp (File_Name_Type (Name));
+ end File_Stamp;
+
---------------
-- Find_File --
---------------
-- If we are looking for a config file, look only in the current
-- directory, i.e. return input argument unchanged. Also look
-- only in the current directory if we are looking for a .dg
- -- file (happens in -gnatD mode)
+ -- file (happens in -gnatD mode).
if T = Config
or else (Debug_Generated_Code
-- corresponding path name
if File /= No_File then
+
-- For locally removed file, Error_Name is returned; then
-- return No_File, indicating the file is not a source.
- if File = Error_Name then
+ if File = Error_File_Name then
return No_File;
else
procedure Find_Program_Name is
Command_Name : String (1 .. Len_Arg (0));
- Cindex1 : Integer := Command_Name'First;
- Cindex2 : Integer := Command_Name'Last;
+ Cindex1 : Integer := Command_Name'First;
+ Cindex2 : Integer := Command_Name'Last;
begin
Fill_Arg (Command_Name'Address, 0);
+ if Command_Name = "" then
+ Name_Len := 0;
+ return;
+ end if;
+
-- The program name might be specified by a full path name. However,
-- we don't want to print that all out in an error message, so the
-- path might need to be stripped away.
-- so that we can directly append a file to the directory
if Search_Dir (Search_Dir'Last) /= Directory_Separator then
- Local_Search_Dir := new String'
- (Concat (Search_Dir, String'(1 => Directory_Separator)));
+ Local_Search_Dir :=
+ new String'(Search_Dir & String'(1 => Directory_Separator));
else
Local_Search_Dir := new String'(Search_Dir);
end if;
-- We first verify if there is a directory Include_Search_Dir
-- containing default search directories
- Result_Search_Dir
- := Read_Default_Search_Dirs (Norm_Search_Dir,
- Search_File,
- null);
- Default_Search_Dir := new String'
- (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+ Result_Search_Dir :=
+ Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
+ Default_Search_Dir :=
+ new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
Free (Norm_Search_Dir);
if Result_Search_Dir /= null then
end;
Norm_Search_Dir :=
- new String'(Concat (Current_Dir.all, Local_Search_Dir.all));
+ new String'(Current_Dir.all & Local_Search_Dir.all);
Result_Search_Dir :=
Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
Default_Search_Dir :=
- new String'
- (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+ new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
Free (Norm_Search_Dir);
Norm_Search_Dir :=
new String'
- (Concat (Update_Path (Search_Dir_Prefix).all,
- Local_Search_Dir.all));
+ (Update_Path (Search_Dir_Prefix).all & Local_Search_Dir.all);
Result_Search_Dir :=
Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
Default_Search_Dir :=
- new String'
- (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+ new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
Free (Norm_Search_Dir);
-- We finally search in Search_Dir_Prefix/rts-Search_Dir
Temp_String :=
- new String'
- (Concat (Update_Path (Search_Dir_Prefix).all, "rts-"));
+ new String'(Update_Path (Search_Dir_Prefix).all & "rts-");
Norm_Search_Dir :=
- new String'(Concat (Temp_String.all, Local_Search_Dir.all));
+ new String'(Temp_String.all & Local_Search_Dir.all);
Result_Search_Dir :=
Read_Default_Search_Dirs (Norm_Search_Dir, Search_File, null);
Default_Search_Dir :=
- new String'
- (Concat (Norm_Search_Dir.all, Default_Suffix_Dir.all));
+ new String'(Norm_Search_Dir.all & Default_Suffix_Dir.all);
Free (Norm_Search_Dir);
if Result_Search_Dir /= null then
Suppress_Options := (others => False);
-- Reserve the first slot in the search paths table. This is the
- -- directory of the main source file or main library file and is
- -- filled in by each call to Next_Main_Source/Next_Main_Lib_File with
- -- the directory specified for this main source or library file. This
- -- is the directory which is searched first by default. This default
- -- search is inhibited by the option -I- for both source and library
- -- files.
+ -- directory of the main source file or main library file and is filled
+ -- in by each call to Next_Main_Source/Next_Main_Lib_File with the
+ -- directory specified for this main source or library file. This is the
+ -- directory which is searched first by default. This default search is
+ -- inhibited by the option -I- for both source and library files.
Src_Search_Directories.Set_Last (Primary_Directory);
Src_Search_Directories.Table (Primary_Directory) := new String'("");
-- Is_Readonly_Library --
-------------------------
- function Is_Readonly_Library (File : in File_Name_Type) return Boolean is
+ function Is_Readonly_Library (File : File_Name_Type) return Boolean is
begin
Get_Name_String (File);
Name_Len := File_Name'Last - Fptr + 1;
Name_Buffer (1 .. Name_Len) := File_Name (Fptr .. File_Name'Last);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
- Current_Main := File_Name_Type (Name_Find);
+ Current_Main := Name_Find;
-- In the gnatmake case, the main file may have not have the
-- extension. Try ".adb" first then ".ads"
begin
if Strip_Suffix (Orig_Main) = Orig_Main then
- Current_Main := Append_Suffix_To_File_Name (Orig_Main, ".adb");
+ Current_Main :=
+ Append_Suffix_To_File_Name (Orig_Main, ".adb");
if Full_Source_Name (Current_Main) = No_File then
Current_Main :=
-- spawn routines. This ensure that quotes will be added when needed.
Result := new String (1 .. Directory'Length - 1);
- Result (1 .. Directory'Length - 1) :=
+ Result (1 .. Directory'Length - 2) :=
Directory (Directory'First + 1 .. Directory'Last - 1);
Result (Result'Last) := Directory_Separator;
Get_Name_String (N);
Name_Len := Name_Len - ALI_Suffix'Length - 1;
- for J in Object_Suffix'Range loop
+ for J in Target_Object_Suffix'Range loop
Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Object_Suffix (J);
+ Name_Buffer (Name_Len) := Target_Object_Suffix (J);
end loop;
return Name_Enter;
end Object_File_Name;
+ -------------------------------
+ -- OS_Exit_Through_Exception --
+ -------------------------------
+
+ procedure OS_Exit_Through_Exception (Status : Integer) is
+ begin
+ Current_Exit_Status := Status;
+ raise Types.Terminate_Program;
+ end OS_Exit_Through_Exception;
+
--------------------------
-- OS_Time_To_GNAT_Time --
--------------------------
Find_Program_Name;
- -- Find the target prefix if any, for the cross compilation case
- -- for instance in "alpha-dec-vxworks-gcc" the target prefix is
+ -- Find the target prefix if any, for the cross compilation case.
+ -- For instance in "alpha-dec-vxworks-gcc" the target prefix is
-- "alpha-dec-vxworks-"
while Name_Len > 0 loop
Prev_Was_Separator := True;
Nb_Relative_Dir := 0;
for J in 1 .. Len loop
- if S (J) in ASCII.NUL .. ASCII.US
- or else S (J) = ' '
- then
+ if S (J) in ASCII.NUL .. ASCII.US or else S (J) = ' ' then
S (J) := Path_Separator;
end if;
if S (J) = Path_Separator then
Prev_Was_Separator := True;
+
else
if Prev_Was_Separator and then Is_Relative (S.all, J) then
Nb_Relative_Dir := Nb_Relative_Dir + 1;
if Current_Full_Obj_Stamp (1) = ' ' then
- -- When the library is readonly, always assume that
- -- the object is consistent.
+ -- When the library is readonly always assume object is consistent
if Is_Readonly_Library (Current_Full_Lib_Name) then
Current_Full_Obj_Stamp := Current_Full_Lib_Stamp;
elsif Fatal_Err then
Get_Name_String (Current_Full_Obj_Name);
Close (Lib_FD, Status);
+
-- No need to check the status, we fail anyway
Fail ("Cannot find: ", Name_Buffer (1 .. Name_Len));
if Current_Full_Source_Name = No_File then
- -- If we were trying to access the main file and we could not
- -- find it we have an error.
+ -- If we were trying to access the main file and we could not find
+ -- it, we have an error.
if N = Current_Main then
Get_Name_String (N);
Library (3 + Name'Length) := '-';
Library (4 + Name'Length .. Library'Last) := Library_Version;
- if Hostparm.OpenVMS then
+ if OpenVMS_On_Target then
for K in Library'First + 2 .. Library'Last loop
if Library (K) = '.' or else Library (K) = '-' then
Library (K) := '_';
pragma Import
(C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
- C_Host_File : String (1 .. Host_File'Length + 1);
+ C_Host_File : String (1 .. Host_File'Length + 1);
Canonical_File_Addr : Address;
Canonical_File_Len : Integer;
begin
In_String (1 .. In_Length) := Path.all;
In_String (In_Length + 1) := ASCII.NUL;
- Result_Ptr := C_Update_Path (In_String'Address,
- Component_Name'Address);
+ Result_Ptr := C_Update_Path (In_String'Address, Component_Name'Address);
Result_Length := Strlen (Result_Ptr);
Out_String := new String (1 .. Result_Length);
Identifier_Character_Set := Get_Default_Identifier_Character_Set;
Maximum_File_Name_Length := Get_Maximum_File_Name_Length;
- -- On VMS, '~' is not allowed in file names. Change the multi unit
- -- index character to '$'.
-
- if Hostparm.OpenVMS then
- Multi_Unit_Index_Character := '$';
- end if;
-
-- Following should be removed by having above function return
-- Integer'Last as indication of no maximum instead of -1 ???
OSDN Git Service
