diff options
author | Vincent Celier <celier@adacore.com> | 2007-06-06 12:19:40 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2007-06-06 12:19:40 +0200 |
commit | 39f4e199a51bc4ff869d273937d363902cc963c3 (patch) | |
tree | 2c708600f1cac4ba92be2eb201eabd01f089e8cf /gcc/ada/osint.adb | |
parent | 379ec90449ee88ae149c19e377910f453007e137 (diff) | |
download | gcc-39f4e199a51bc4ff869d273937d363902cc963c3.zip gcc-39f4e199a51bc4ff869d273937d363902cc963c3.tar.gz gcc-39f4e199a51bc4ff869d273937d363902cc963c3.tar.bz2 |
bcheck.adb, [...]: Move Name_Id, File_Name_Type and Unit_Name_Type from package Types to package Namet.
2007-04-20 Vincent Celier <celier@adacore.com>
Robert Dewar <dewar@adacore.com>
* bcheck.adb, binde.adb, binderr.adb, binderr.ads, butil.adb,
butil.ads, erroutc.adb, erroutc.ads, errutil.adb, errutil.ads,
err_vars.ads, exp_tss.adb, exp_tss.ads, fmap.adb, fmap.ads,
fname.adb, fname.ads, fname-sf.adb, fname-uf.adb, fname-uf.ads,
lib-sort.adb, lib-util.adb, lib-util.ads, lib-xref.adb, makeutl.ads,
makeutl.adb, nmake.adt, osint.adb, osint.ads, osint-b.adb,
par-load.adb, prj-attr.adb, prj-dect.adb, prj-err.adb, prj-makr.adb,
prj-part.adb, prj-pp.adb, prj-proc.adb, prj-tree.adb, prj-tree.ads,
prj-util.adb, prj-util.ads, scans.adb, scans.ads, sem_ch2.adb,
sinput-c.adb, styleg-c.adb, tempdir.adb, tempdir.ads, uname.adb,
uname.ads, atree.h, atree.ads, atree.adb, ali-util.ads, ali-util.adb,
ali.ads, ali.adb:
Move Name_Id, File_Name_Type and Unit_Name_Type from package Types to
package Namet. Make File_Name_Type and Unit_Name_Type types derived from
Mame_Id. Add new type Path_Name_Type, also derived from Name_Id.
Use variables of types File_Name_Type and Unit_Name_Type in error
messages.
(Get_Name): Add parameter Ignore_Special, and set it reading file name
(New_Copy): When debugging the compiler, call New_Node_Debugging_Output
here.
Define flags Flag217-Flag230 with associated subprograms
(Flag_Word5): New record type.
(Flag_Word5_Ptr): New access type.
(To_Flag_Word5): New unchecked conversion.
(To_Flag_Word5_Ptr): Likewise.
(Flag216): New function.
(Set_Flag216): New procedure.
From-SVN: r125377
Diffstat (limited to 'gcc/ada/osint.adb')
-rw-r--r-- | gcc/ada/osint.adb | 202 |
1 files changed, 98 insertions, 104 deletions
diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 8d1a5d4..a78ab8d 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, 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- -- @@ -24,22 +24,21 @@ -- -- ------------------------------------------------------------------------------ -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 Targparm; use Targparm; +with Unchecked_Conversion; with System.Case_Util; use System.Case_Util; -with Unchecked_Conversion; - 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; @@ -62,21 +61,21 @@ package body Osint is ------------------------------------- -- 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; + (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; @@ -84,11 +83,10 @@ package body Osint is 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 @@ -99,20 +97,20 @@ package body Osint is 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 -- @@ -122,15 +120,13 @@ package body Osint is -- 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; @@ -138,9 +134,9 @@ package body Osint is 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 -- @@ -148,13 +144,13 @@ package body Osint is 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, @@ -165,7 +161,7 @@ package body Osint is 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, @@ -183,12 +179,11 @@ package body Osint is -- 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 @@ -224,11 +219,10 @@ package body Osint is 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 -- @@ -327,17 +321,15 @@ package body Osint is 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); @@ -451,8 +443,8 @@ package body Osint is -- 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); @@ -515,9 +507,8 @@ package body Osint is 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); @@ -589,8 +580,8 @@ package body Osint is -------------------------------- 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); @@ -722,6 +713,7 @@ package body Osint is function Executable_Name (Name : File_Name_Type) return File_Name_Type is Exec_Suffix : String_Access; + begin if Name = No_File then return No_File; @@ -741,13 +733,12 @@ package body Osint is 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. + -- 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 the Executable does not end with the executable - -- suffix, add it. + -- If Executable does not end with the executable suffix, add it if Buffer'Length <= Exec_Suffix'Length or else @@ -810,6 +801,7 @@ package body Osint is ----------------------- 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". @@ -866,7 +858,7 @@ package body Osint is -- directory prefix. return Get_Install_Dir - (GNAT.OS_Lib.Locate_Exec_On_Path (Exec_Name.all).all); + (System.OS_Lib.Locate_Exec_On_Path (Exec_Name.all).all); end Executable_Prefix; ------------------ @@ -950,6 +942,11 @@ package body Osint is 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 -- --------------- @@ -970,7 +967,7 @@ package body Osint is -- 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 @@ -1002,10 +999,11 @@ package body Osint is -- 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 @@ -1051,8 +1049,8 @@ package body Osint is 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); @@ -1276,10 +1274,8 @@ package body Osint is -- 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); + 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); @@ -1421,12 +1417,11 @@ package body Osint is 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'(""); @@ -1687,7 +1682,7 @@ package body Osint is 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" @@ -1698,7 +1693,8 @@ package body Osint is 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 := @@ -1868,8 +1864,8 @@ package body Osint is 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 @@ -1972,14 +1968,13 @@ package body Osint is 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; @@ -2076,8 +2071,7 @@ package body Osint is 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; @@ -2085,6 +2079,7 @@ package body Osint is 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)); @@ -2174,8 +2169,8 @@ package body Osint is 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); @@ -2573,7 +2568,7 @@ package body Osint is 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; @@ -2749,8 +2744,7 @@ package body Osint is 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); |