-- --
-- S p e c --
-- --
--- $Revision: 1.1 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
--- This package contains the low level, operating system routines used in
--- the GNAT compiler and binder for command line processing and file input
--- output. The specification is suitable for use with MS-DOS, Unix, and
--- similar systems. Note that for input source and library information
--- files, the line terminator may be either CR/LF or LF alone, and the
--- DOS-style EOF (16#1A#) character marking the end of the text in a
--- file may be used in all systems including Unix. This allows for more
--- convenient processing of DOS files in a Unix environment.
+-- This package contains the low level, operating system routines used in the
+-- compiler and binder for command line processing and file input output.
+
+with Namet; use Namet;
+with Types; use Types;
+
+with System; use System;
+
+pragma Warnings (Off);
+-- This package is used also by gnatcoll
+with System.OS_Lib; use System.OS_Lib;
+pragma Warnings (On);
+
+with System.Storage_Elements;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-with System; use System;
-with Types; use Types;
+pragma Elaborate_All (System.OS_Lib);
+-- For the call to function Get_Target_Object_Suffix in the private part
package Osint is
- procedure Set_Main_File_Name (Name : String);
- -- Set the main file name for Gnatmake.
+ Multi_Unit_Index_Character : Character := '~';
+ -- The character before the index of the unit in a multi-unit source in ALI
+ -- and object file names. Changed to '$' on VMS.
+
+ Ada_Include_Path : constant String := "ADA_INCLUDE_PATH";
+ Ada_Objects_Path : constant String := "ADA_OBJECTS_PATH";
+ Project_Include_Path_File : constant String := "ADA_PRJ_INCLUDE_FILE";
+ Project_Objects_Path_File : constant String := "ADA_PRJ_OBJECTS_FILE";
+
+ procedure Initialize;
+ -- Initialize internal tables
function Normalize_Directory_Name (Directory : String) return String_Ptr;
-- Verify and normalize a directory name. If directory name is invalid,
-- this will return an empty string. Otherwise it will insure a trailing
-- slash and make other normalizations.
- type File_Type is (Source, Library, Config);
+ type File_Type is (Source, Library, Config, Definition, Preprocessing_Data);
function Find_File
- (N : File_Name_Type;
- T : File_Type)
- return File_Name_Type;
- -- Finds a source or library file depending on the value of T following
- -- the directory search order rules unless N is the name of the file
- -- just read with Next_Main_File and already contains directiory
- -- information, in which case just look in the Primary_Directory.
- -- Returns File_Name_Type of the full file name if found, No_File if
- -- file not found. Note that for the special case of gnat.adc, only the
- -- compilation environment directory is searched, i.e. the directory
- -- where the ali and object files are written. Another special case is
- -- when Debug_Generated_Code is set and the file name ends on ".dg",
- -- in which case we look for the generated file only in the current
- -- directory, since that is where it is always built.
-
- function Get_Switch_Character return Character;
- pragma Import (C, Get_Switch_Character, "__gnat_get_switch_character");
- Switch_Character : constant Character := Get_Switch_Character;
- -- Set to the default switch character (note that minus is always an
- -- acceptable alternative switch character)
+ (N : File_Name_Type;
+ T : File_Type) return File_Name_Type;
+ -- Finds a source, library or config file depending on the value of T
+ -- following the directory search order rules unless N is the name of the
+ -- file just read with Next_Main_File and already contains directory
+ -- information, in which case just look in the Primary_Directory. Returns
+ -- File_Name_Type of the full file name if found, No_File if file not
+ -- found. Note that for the special case of gnat.adc, only the compilation
+ -- environment directory is searched, i.e. the directory where the ali and
+ -- object files are written. Another special case is Debug_Generated_Code
+ -- set and the file name ends on ".dg", in which case we look for the
+ -- generated file only in the current directory, since that is where it is
+ -- always built.
function Get_File_Names_Case_Sensitive return Int;
pragma Import (C, Get_File_Names_Case_Sensitive,
- "__gnat_get_file_names_case_sensitive");
+ "__gnat_get_file_names_case_sensitive");
File_Names_Case_Sensitive : constant Boolean :=
- Get_File_Names_Case_Sensitive /= 0;
+ Get_File_Names_Case_Sensitive /= 0;
-- Set to indicate whether the operating system convention is for file
-- names to be case sensitive (e.g., in Unix, set True), or non case
- -- sensitive (e.g., in OS/2, set False).
+ -- sensitive (e.g., in Windows, set False).
procedure Canonical_Case_File_Name (S : in out String);
-- Given a file name, converts it to canonical case form. For systems
-- this call converts the given string to canonical all lower case form,
-- so that two file names compare equal if they refer to the same file.
- function Number_Of_Files return Int;
- -- gives the total number of filenames found on the command line.
-
- procedure Add_File (File_Name : String);
- -- Called by the subprogram processing the command line for each
- -- file name found.
+ function Get_Env_Vars_Case_Sensitive return Int;
+ pragma Import (C, Get_Env_Vars_Case_Sensitive,
+ "__gnat_get_env_vars_case_sensitive");
+ Env_Vars_Case_Sensitive : constant Boolean :=
+ Get_Env_Vars_Case_Sensitive /= 0;
+ -- Set to indicate whether the operating system convention is for
+ -- environment variable names to be case sensitive (e.g., in Unix, set
+ -- True), or non case sensitive (e.g., in Windows, set False).
+
+ procedure Canonical_Case_Env_Var_Name (S : in out String);
+ -- Given an environment variable name, converts it to canonical case form.
+ -- For systems where environment variable names are case sensitive, this
+ -- procedure has no effect. If environment variable names are not case
+ -- sensitive, then this call converts the given string to canonical all
+ -- lower case form, so that two environment variable names compare equal if
+ -- they refer to the same environment variable.
- procedure Set_Output_Object_File_Name (Name : String);
- -- Called by the subprogram processing the command line when an
- -- output object file name is found.
+ function Number_Of_Files return Int;
+ -- Gives the total number of filenames found on the command line
- type Program_Type is (Compiler, Binder, Make);
- Program : Program_Type;
- -- Program currently running (set by Initialize below)
+ No_Index : constant := -1;
+ -- Value used in Add_File to indicate no index is specified for main
- procedure Initialize (P : Program_Type);
- -- This routine scans parameters and initializes for the first call to
- -- Next_Main_Source (Compiler or Make) or Next_Main_Lib_File (Binder).
- -- It also resets any of the variables in package Opt in response to
- -- command switch settings.
- --
- -- Initialize may terminate execution if the parameters are invalid or some
- -- other fatal error is encountered. The interface is set up to
- -- accommodate scanning a series of files (e.g. as the result of
- -- wild card references in DOS, or an expanded list of source files
- -- in Unix). Of course it is perfectly possible to ignore this in
- -- the implementation and provide for opening only one file.
- -- The parameter P is the program (Compiler, Binder or Make) that is
- -- actually running.
+ procedure Add_File (File_Name : String; Index : Int := No_Index);
+ -- Called by the subprogram processing the command line for each file name
+ -- found. The index, when not defaulted to No_Index is the index of the
+ -- subprogram in its source, zero indicating that the source is not
+ -- multi-unit.
procedure Find_Program_Name;
-- Put simple name of current program being run (excluding the directory
-- path) in Name_Buffer, with the length in Name_Len.
- function Program_Name (Nam : String) return String_Access;
- -- In the native compilation case, Create a string containing Nam. In
- -- the cross compilation case, looks at the prefix of the current
- -- program being run and prepend it to Nam. For instance if the program
- -- being run is <target>-gnatmake and Nam is "gcc", the returned value
- -- will be a pointer to "<target>-gcc". This function clobbers
- -- Name_Buffer and Name_Len.
+ function Program_Name (Nam : String; Prog : String) return String_Access;
+ -- In the native compilation case, Create a string containing Nam. In the
+ -- cross compilation case, looks at the prefix of the current program being
+ -- run and prepend it to Nam. For instance if the program being run is
+ -- <target>-gnatmake and Nam is "gcc", the returned value will be a pointer
+ -- to "<target>-gcc". In the specific case where AAMP_On_Target is set, the
+ -- name "gcc" is mapped to "gnaamp", and names of the form "gnat*" are
+ -- mapped to "gnaamp*". This function clobbers Name_Buffer and Name_Len.
+ -- Also look at any suffix, e.g. gnatmake-4.1 -> "gcc-4.1". Prog is the
+ -- default name of the current program being executed, e.g. "gnatmake",
+ -- "gnatlink".
procedure Write_Program_Name;
- -- Writes name of program as invoked to standard output
+ -- Writes name of program as invoked to the current output (normally
+ -- standard output).
- procedure Fail (S1 : String; S2 : String := ""; S3 : String := "");
- -- Outputs error messages S1 & S2 & S3 preceeded by the name of the
- -- executing program and exits with E_Fatal.
+ procedure Fail (S : String);
+ pragma No_Return (Fail);
+ -- Outputs error message S preceded by the name of the executing program
+ -- and exits with E_Fatal. The output goes to standard error, except if
+ -- special output is in effect (see Output).
function Is_Directory_Separator (C : Character) return Boolean;
-- Returns True if C is a directory separator
function Get_Directory (Name : File_Name_Type) return File_Name_Type;
-- Get the prefix directory name (if any) from Name. The last separator
- -- is preserved. Return No_File if there is no directory part in the
- -- name.
+ -- is preserved. Return the normalized current directory if there is no
+ -- directory part in the name.
function Is_Readonly_Library (File : File_Name_Type) return Boolean;
- -- Check if this library file is a read-only file.
+ -- Check if this library file is a read-only file
function Strip_Directory (Name : File_Name_Type) return File_Name_Type;
-- Strips the prefix directory name (if any) from Name. Returns the
- -- stripped name.
+ -- stripped name. Name cannot end with a directory separator.
function Strip_Suffix (Name : File_Name_Type) return File_Name_Type;
- -- Strips the suffix (the '.' and whatever comes after it) from Name.
+ -- Strips the suffix (the last '.' and whatever comes after it) from Name.
-- Returns the stripped name.
- function Executable_Name (Name : File_Name_Type) return File_Name_Type;
+ function Executable_Name
+ (Name : File_Name_Type;
+ Only_If_No_Suffix : Boolean := False) return File_Name_Type;
-- Given a file name it adds the appropriate suffix at the end so that
-- it becomes the name of the executable on the system at end. For
-- instance under DOS it adds the ".exe" suffix, whereas under UNIX no
-- suffix is added.
+ function Executable_Name
+ (Name : String;
+ Only_If_No_Suffix : Boolean := False) return String;
+ -- Same as above, with String parameters
+
function File_Stamp (Name : File_Name_Type) return Time_Stamp_Type;
- -- Returns the time stamp of file Name. Name should include relative
- -- path information in order to locate it. If the source file cannot be
- -- opened, or Name = No_File, and all blank time stamp is returned (this is
- -- not an error situation).
-
- procedure Record_Time_From_Last_Bind;
- -- Trigger the computing of the time from the last bind of the same
- -- program.
-
- function Time_From_Last_Bind return Nat;
- -- This function give an approximate number of minute from the last bind.
- -- It bases its computation on file stamp and therefore does gibe not
- -- any meaningful result before the new output binder file is written.
- -- So it returns Nat'last if
- -- - it is the first bind of this specific program
- -- - Record_Time_From_Last_Bind was not Called first
- -- - Close_Binder_Output was not called first
- -- otherwise returns the number of minutes
- -- till the last bind. The computation does not try to be completely
- -- accurate and in particular does not take leap years into account.
+ -- Returns the time stamp of file Name. Name should include relative path
+ -- information in order to locate it. If the source file cannot be opened,
+ -- or Name = No_File, and all blank time stamp is returned (this is not an
+ -- error situation).
+
+ function File_Stamp (Name : Path_Name_Type) return Time_Stamp_Type;
+ -- Same as above for a path name
type String_Access_List is array (Positive range <>) of String_Access;
- -- Deferenced type used to return a list of file specs in
+ -- Dereferenced type used to return a list of file specs in
-- To_Canonical_File_List.
type String_Access_List_Access is access all String_Access_List;
- -- Type used to return a String_Access_List without dragging in secondary
+ -- Type used to return a String_Access_List without dragging in secondary
-- stack.
function To_Canonical_File_List
- (Wildcard_Host_File : String; Only_Dirs : Boolean)
- return String_Access_List_Access;
+ (Wildcard_Host_File : String;
+ Only_Dirs : Boolean) return String_Access_List_Access;
-- Expand a wildcard host syntax file or directory specification (e.g. on
- -- a VMS host, any file or directory spec that contains:
- -- "*", or "%", or "...")
- -- and return a list of valid Unix syntax file or directory specs.
+ -- a VMS host, any file or directory spec that contains: "*", or "%", or
+ -- "...") and return a list of valid Unix syntax file or directory specs.
-- If Only_Dirs is True, then only return directories.
function To_Canonical_Dir_Spec
(Host_Dir : String;
- Prefix_Style : Boolean)
- return String_Access;
+ Prefix_Style : Boolean) return String_Access;
-- Convert a host syntax directory specification (e.g. on a VMS host:
-- "SYS$DEVICE:[DIR]") to canonical (Unix) syntax (e.g. "/sys$device/dir").
- -- If Prefix_Style then make it a valid file specification prefix.
- -- A file specification prefix is a directory specification that
- -- can be appended with a simple file specification to yield a valid
- -- absolute or relative path to a file. On a conversion to Unix syntax
- -- this simply means the spec has a trailing slash ("/").
+ -- If Prefix_Style then make it a valid file specification prefix. A file
+ -- specification prefix is a directory specification that can be appended
+ -- with a simple file specification to yield a valid absolute or relative
+ -- path to a file. On a conversion to Unix syntax this simply means the
+ -- spec has a trailing slash ("/").
function To_Canonical_File_Spec
- (Host_File : String)
- return String_Access;
+ (Host_File : String) return String_Access;
-- Convert a host syntax file specification (e.g. on a VMS host:
-- "SYS$DEVICE:[DIR]FILE.EXT;69 to canonical (Unix) syntax (e.g.
-- "/sys$device/dir/file.ext.69").
function To_Canonical_Path_Spec
- (Host_Path : String)
- return String_Access;
+ (Host_Path : String) return String_Access;
-- Convert a host syntax Path specification (e.g. on a VMS host:
-- "SYS$DEVICE:[BAR],DISK$USER:[FOO] to canonical (Unix) syntax (e.g.
-- "/sys$device/foo:disk$user/foo").
function To_Host_Dir_Spec
(Canonical_Dir : String;
- Prefix_Style : Boolean)
- return String_Access;
- -- Convert a canonical syntax directory specification to host syntax.
- -- The Prefix_Style flag is currently ignored but should be set to
- -- False.
+ Prefix_Style : Boolean) return String_Access;
+ -- Convert a canonical syntax directory specification to host syntax. The
+ -- Prefix_Style flag is currently ignored but should be set to False.
+ -- Note that the caller must free result.
function To_Host_File_Spec
- (Canonical_File : String)
- return String_Access;
- -- Convert a canonical syntax file specification to host syntax.
+ (Canonical_File : String) return String_Access;
+ -- Convert a canonical syntax file specification to host syntax
+
+ function Relocate_Path
+ (Prefix : String;
+ Path : String) return String_Ptr;
+ -- Given an absolute path and a prefix, if Path starts with Prefix,
+ -- replace the Prefix substring with the root installation directory.
+ -- By default, try to compute the root installation directory by looking
+ -- at the executable name as it was typed on the command line and, if
+ -- needed, use the PATH environment variable. If the above computation
+ -- fails, return Path. This function assumes Prefix'First = Path'First.
+
+ function Shared_Lib (Name : String) return String;
+ -- Returns the runtime shared library in the form -l<name>-<version> where
+ -- version is the GNAT runtime library option for the platform. For example
+ -- this routine called with Name set to "gnat" will return "-lgnat-5.02"
+ -- on UNIX and Windows and -lgnat_5_02 on VMS.
+
+ ---------------------
+ -- File attributes --
+ ---------------------
+
+ -- The following subprograms offer services similar to those found in
+ -- System.OS_Lib, but with the ability to extra multiple information from
+ -- a single system call, depending on the system. This can result in fewer
+ -- system calls when reused.
+
+ -- In all these subprograms, the requested value is either read from the
+ -- File_Attributes parameter (resulting in no system call), or computed
+ -- from the disk and then cached in the File_Attributes parameter (possibly
+ -- along with other values).
+
+ type File_Attributes is private;
+ Unknown_Attributes : constant File_Attributes;
+ -- A cache for various attributes for a file (length, accessibility,...)
+ -- This must be initialized to Unknown_Attributes prior to the first call.
+
+ function Is_Directory
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Boolean;
+ function Is_Regular_File
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Boolean;
+ function Is_Symbolic_Link
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Boolean;
+ -- Return the type of the file,
+
+ function File_Length
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Long_Integer;
+ -- Return the length (number of bytes) of the file
+
+ function File_Time_Stamp
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return OS_Time;
+ function File_Time_Stamp
+ (Name : Path_Name_Type;
+ Attr : access File_Attributes) return Time_Stamp_Type;
+ -- Return the time stamp of the file
+
+ function Is_Readable_File
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Boolean;
+ function Is_Executable_File
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Boolean;
+ function Is_Writable_File
+ (Name : C_File_Name;
+ Attr : access File_Attributes) return Boolean;
+ -- Return the access rights for the file
-------------------------
-- Search Dir Routines --
-------------------------
+ function Include_Dir_Default_Prefix return String;
+ -- Return the directory of the run-time library sources, as modified
+ -- by update_path.
+
+ function Object_Dir_Default_Prefix return String;
+ -- Return the directory of the run-time library ALI and object files, as
+ -- modified by update_path.
+
procedure Add_Default_Search_Dirs;
- -- This routine adds the default search dirs indicated by the
- -- environment variables and sdefault package.
+ -- This routine adds the default search dirs indicated by the environment
+ -- variables and sdefault package.
procedure Add_Lib_Search_Dir (Dir : String);
-- Add Dir at the end of the library file search path
procedure Get_Next_Dir_In_Path_Init
(Search_Path : String_Access);
- function Get_Next_Dir_In_Path
- (Search_Path : String_Access)
- return String_Access;
- -- These subprograms are used to parse out the directory names in a
- -- search path specified by a Search_Path argument. The procedure
- -- initializes an internal pointer to point to the initial directory
- -- name, and calls to the function return sucessive directory names,
- -- with a null pointer marking the end of the list.
+ function Get_Next_Dir_In_Path
+ (Search_Path : String_Access) return String_Access;
+ -- These subprograms are used to parse out the directory names in a search
+ -- path specified by a Search_Path argument. The procedure initializes an
+ -- internal pointer to point to the initial directory name, and calls to
+ -- the function return successive directory names, with a null pointer
+ -- marking the end of the list.
+
+ type Search_File_Type is (Include, Objects);
+
+ procedure Add_Search_Dirs
+ (Search_Path : String_Ptr;
+ Path_Type : Search_File_Type);
+ -- These procedure adds all the search directories that are in Search_Path
+ -- in the proper file search path (library or source)
function Get_Primary_Src_Search_Directory return String_Ptr;
-- Retrieved the primary directory (directory containing the main source
- -- file for Gnatmake.
+ -- file for Gnatmake.
function Nb_Dir_In_Src_Search_Path return Natural;
function Dir_In_Src_Search_Path (Position : Natural) return String_Ptr;
function Dir_In_Obj_Search_Path (Position : Natural) return String_Ptr;
-- Functions to access the directory names in the Object search path
- Include_Search_File : constant String_Access
- := new String'("ada_source_path");
- Objects_Search_File : constant String_Access
- := new String'("ada_object_path");
+ Include_Search_File : constant String_Access :=
+ new String'("ada_source_path");
+ Objects_Search_File : constant String_Access :=
+ new String'("ada_object_path");
+ -- Names of the files containing the default include or objects search
+ -- directories. These files, located in Sdefault.Search_Dir_Prefix, do
+ -- not necessarily exist.
- -- Files containg the default include or objects search directories.
+ Exec_Name : String_Ptr;
+ -- Executable name as typed by the user (used to compute the
+ -- executable prefix).
function Read_Default_Search_Dirs
- (Search_Dir_Prefix : String_Access;
- Search_File : String_Access;
- Search_Dir_Default_Name : String_Access)
- return String_Access;
+ (Search_Dir_Prefix : String_Access;
+ Search_File : String_Access;
+ Search_Dir_Default_Name : String_Access) return String_Access;
-- Read and return the default search directories from the file located
-- in Search_Dir_Prefix (as modified by update_path) and named Search_File.
-- If no such file exists or an error occurs then instead return the
-- Search_Dir_Default_Name (as modified by update_path).
+ function Get_RTS_Search_Dir
+ (Search_Dir : String;
+ File_Type : Search_File_Type) return String_Ptr;
+ -- This function retrieves the paths to the search (resp. lib) dirs and
+ -- return them. The search dir can be absolute or relative. If the search
+ -- dir contains Include_Search_File (resp. Object_Search_File), then this
+ -- function reads and returns the default search directories from the file.
+ -- Otherwise, if the directory is absolute, it will try to find 'adalib'
+ -- (resp. 'adainclude'). If found, null is returned. If the directory is
+ -- relative, the following directories for the directories 'adalib' and
+ -- 'adainclude' will be scanned:
+ --
+ -- - current directory (from which the tool has been spawned)
+ -- - $GNAT_ROOT/gcc/gcc-lib/$targ/$vers/
+ -- - $GNAT_ROOT/gcc/gcc-lib/$targ/$vers/rts-
+ --
+ -- The scan will stop as soon as the directory being searched for (adalib
+ -- or adainclude) is found. If the scan fails, null is returned.
+
-----------------------
-- Source File Input --
-----------------------
-- source files and the subsidiary source files (e.g. with'ed units), and
-- also by the binder to check presence/time stamps of sources.
- function More_Source_Files return Boolean;
- -- Indicates whether more source file remain to be processed. Returns
- -- False right away if no source files, or if all source files have
- -- been processed.
-
- function Next_Main_Source return File_Name_Type;
- -- This function returns the name of the next main source file specified
- -- on the command line. It is an error to call Next_Main_Source if no more
- -- source files exist (i.e. Next_Main_Source may be called only if a
- -- previous call to More_Source_Files returned True). This name is the
- -- simple file name (without any directory information).
-
procedure Read_Source_File
(N : File_Name_Type;
Lo : Source_Ptr;
--
-- CR
-- CR/LF
- -- LF/CR
-- LF
- -- The source is terminated by an EOF (16#1A#) character, which is
- -- the last charcater of the returned source bufer (note that any
- -- EOF characters in positions other than the last source character
- -- are treated as representing blanks).
+ -- The source is terminated by an EOF (16#1A#) character, which is the last
+ -- character of the returned source buffer (note that any EOF characters in
+ -- positions other than the last source character are treated as blanks).
--
-- The logical lower bound of the source buffer is the input value of Lo,
-- and on exit Hi is set to the logical upper bound of the source buffer.
-- without any directory information. The implementation is responsible
-- for searching for the file in the appropriate directories.
--
- -- Note the special case that if the file name is gnat.adc, then the
- -- search for the file is done ONLY in the directory corresponding to
- -- the current compilation environment, i.e. in the same directory
- -- where the ali and object files will be written.
+ -- Note the special case that if the file name is gnat.adc, then the search
+ -- for the file is done ONLY in the directory corresponding to the current
+ -- compilation environment, i.e. in the same directory where the ali and
+ -- object files will be written.
function Full_Source_Name return File_Name_Type;
function Current_Source_File_Stamp return Time_Stamp_Type;
-- using Read_Source_File. Calling this routine entails no source file
-- directory lookup penalty.
+ procedure Full_Source_Name
+ (N : File_Name_Type;
+ Full_File : out File_Name_Type;
+ Attr : access File_Attributes);
function Full_Source_Name (N : File_Name_Type) return File_Name_Type;
function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type;
-- Returns the full name/time stamp of the source file whose simple name
-- is N which should not include path information. Note that if the file
- -- cannot be located No_File is returned for the first routine and an
- -- all blank time stamp is returned for the second (this is not an error
- -- situation). The full name includes the appropriate directory
- -- information. The source file directory lookup penalty is incurred
- -- every single time the routines are called unless you have previously
- -- called Source_File_Data (Cache => True). See below.
+ -- cannot be located No_File is returned for the first routine and an all
+ -- blank time stamp is returned for the second (this is not an error
+ -- situation). The full name includes appropriate directory information.
+ -- The source file directory lookup penalty is incurred every single time
+ -- the routines are called unless you have previously called
+ -- Source_File_Data (Cache => True). See below.
+ --
+ -- The procedural version also returns some file attributes for the ALI
+ -- file (to save on system calls later on).
+
+ function Current_File_Index return Int;
+ -- Return the index in its source file of the current main unit
function Matching_Full_Source_Name
- (N : File_Name_Type;
- T : Time_Stamp_Type)
- return File_Name_Type;
- -- Same semantics than Full_Source_Name but will search on the source
- -- path until a source file with time stamp matching T is found. If
- -- none is found returns No_File.
+ (N : File_Name_Type;
+ T : Time_Stamp_Type) return File_Name_Type;
+ -- Same semantics than Full_Source_Name but will search on the source path
+ -- until a source file with time stamp matching T is found. If none is
+ -- found returns No_File.
procedure Source_File_Data (Cache : Boolean);
-- By default source file data (full source file name and time stamp)
-- Source_File_Stamp (N) is made. This may be undesirable in certain
-- applications as this is uselessly slow if source file data does not
-- change during program execution. When this procedure is called with
- -- Cache => True access to source file data does not encurr a penalty if
+ -- Cache => True access to source file data does not incur a penalty if
-- this data was previously retrieved.
+ procedure Dump_Source_File_Names;
+ -- Prints out the names of all source files that have been read by
+ -- Read_Source_File, except those that come from the run-time library
+ -- (i.e. Include_Dir_Default_Prefix). The text is sent to whatever Output
+ -- is currently using (e.g. standard output or standard error).
+
-------------------------------------------
-- Representation of Library Information --
-------------------------------------------
- -- Associated with each compiled source file is library information,
- -- a string of bytes whose exact format is described in the body of
- -- Lib.Writ. Compiling a source file generates this library information
- -- for the compiled unit, and access the library information for units
- -- that were compiled previously on which the unit being compiled depends.
+ -- Associated with each compiled source file is library information, a
+ -- string of bytes whose exact format is described in the body of Lib.Writ.
+ -- Compiling a source file generates this library information for the
+ -- compiled unit, and access the library information for units that were
+ -- compiled previously on which the unit being compiled depends.
-- How this information is stored is up to the implementation of this
-- package. At the interface level, this information is simply associated
-- Which of these three methods is chosen depends on the constraints of the
-- host operating system. The interface described here is independent of
- -- which of these approaches is used.
+ -- which of these approaches is used. Currently all versions of GNAT use
+ -- the third approach with a file name of xxx.ali where xxx is the source
+ -- file name.
-------------------------------
-- Library Information Input --
-- These subprograms are used by the binder to read library information
-- files, see section above for representation of these files.
- function More_Lib_Files return Boolean;
- -- Indicates whether more library information files remain to be processed.
- -- Returns False right away if no source files, or if all source files
- -- have been processed.
-
- function Next_Main_Lib_File return File_Name_Type;
- -- This function returns the name of the next library info file specified
- -- on the command line. It is an error to call Next_Main_Lib_File if no
- -- more library information files exist (i.e. Next_Main_Lib_File may be
- -- called only if a previous call to More_Lib_Files returned True). This
- -- name is the simple name, excluding any directory information.
-
function Read_Library_Info
(Lib_File : File_Name_Type;
- Fatal_Err : Boolean := False)
- return Text_Buffer_Ptr;
+ Fatal_Err : Boolean := False) return Text_Buffer_Ptr;
-- Allocates a Text_Buffer of appropriate length and reads in the entire
-- source of the library information from the library information file
-- whose name is given by the parameter Name.
--
-- See description of Read_Source_File for details on the format of the
- -- returned text buffer (the format is identical). THe lower bound of
+ -- returned text buffer (the format is identical). The lower bound of
-- the Text_Buffer is always zero
--
-- If the specified file cannot be opened, then the action depends on
-- include any directory information. The implementation is responsible
-- for searching for the file in appropriate directories.
--
- -- If Opt.Check_Object_Consistency is set to True then this routine
- -- checks whether the object file corresponding to the Lib_File is
- -- consistent with it. The object file is inconsistent if the object
- -- does not exist or if it has an older time stamp than Lib_File.
- -- This check is not performed when the Lib_File is "locked" (i.e.
- -- read/only) because in this case the object file may be buried
- -- in a library. In case of inconsistencies Read_Library_Info
- -- behaves as if it did not find Lib_File (namely if Fatal_Err is
- -- False, null is returned).
-
- procedure Read_Library_Info
- (Name : out File_Name_Type;
- Text : out Text_Buffer_Ptr);
- -- The procedure version of Read_Library_Info is used from the compiler
- -- to read an existing ali file associated with the main unit. If the
- -- ALI file exists, then its file name is returned in Name, and its
- -- text is returned in Text. If the file does not exist, then Text is
- -- set to null.
+ -- If Opt.Check_Object_Consistency is set to True then this routine checks
+ -- whether the object file corresponding to the Lib_File is consistent with
+ -- it. The object file is inconsistent if the object does not exist or if
+ -- it has an older time stamp than Lib_File. This check is not performed
+ -- when the Lib_File is "locked" (i.e. read/only) because in this case the
+ -- object file may be buried in a library. In case of inconsistencies
+ -- Read_Library_Info behaves as if it did not find Lib_File (namely if
+ -- Fatal_Err is False, null is returned).
+
+ function Read_Library_Info_From_Full
+ (Full_Lib_File : File_Name_Type;
+ Lib_File_Attr : access File_Attributes;
+ Fatal_Err : Boolean := False) return Text_Buffer_Ptr;
+ -- Same as Read_Library_Info, except Full_Lib_File must contains the full
+ -- path to the library file (instead of having Read_Library_Info recompute
+ -- it).
+ -- Lib_File_Attr should be an initialized set of attributes for the
+ -- library file (it can be initialized to Unknown_Attributes, but in
+ -- general will have been initialized by a previous call to Find_File).
function Full_Library_Info_Name return File_Name_Type;
function Full_Object_File_Name return File_Name_Type;
-- using Read_Library_Info, including appropriate directory information.
-- Calling this routine entails no library file directory lookup
-- penalty. Note that the object file corresponding to a library file
- -- is not actually read. Its time stamp is fected when the flag
+ -- is not actually read. Its time stamp is affected when the flag
-- Opt.Check_Object_Consistency is set.
function Current_Library_File_Stamp return Time_Stamp_Type;
-- It is an error to call Current_Object_File_Stamp if
-- Opt.Check_Object_Consistency is set to False.
+ procedure Full_Lib_File_Name
+ (N : File_Name_Type;
+ Lib_File : out File_Name_Type;
+ Attr : out File_Attributes);
function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type;
- function Library_File_Stamp (N : File_Name_Type) return Time_Stamp_Type;
- -- Returns the full name/time stamp of library file N. N should not
- -- include path information. Note that if the file cannot be located
- -- No_File is returned for the first routine and an all blank time stamp
- -- is returned for the second (this is not an error situation). The
- -- full name includes the appropriate directory information. The library
- -- file directory lookup penalty is incurred every single time this
- -- routine is called.
-
- function Object_File_Name (N : File_Name_Type) return File_Name_Type;
- -- Constructs the name of the object file corresponding to library
- -- file N. If N is a full file name than the returned file name will
- -- also be a full file name. Note that no lookup in the library file
- -- directories is done for this file. This routine merely constructs
- -- the name.
-
- --------------------------------
- -- Library Information Output --
- --------------------------------
-
- -- These routines are used by the compiler to generate the library
- -- information file for the main source file being compiled. See section
- -- above for a discussion of how library information files are stored.
-
- procedure Create_Output_Library_Info;
- -- Creates the output library information file for the source file which
- -- is currently being compiled (i.e. the file which was most recently
- -- returned by Next_Main_Source).
-
- procedure Write_Library_Info (Info : String);
- -- Writes the contents of the referenced string to the library information
- -- file for the main source file currently being compiled (i.e. the file
- -- which was most recently opened with a call to Read_Next_File). Info
- -- represents a single line in the file, but does not contain any line
- -- termination characters. The implementation of Write_Library_Info is
- -- responsible for adding necessary end of line and end of file control
- -- characters to the generated file.
-
- procedure Close_Output_Library_Info;
- -- Closes the file created by Create_Output_Library_Info, flushing any
- -- buffers etc from writes by Write_Library_Info.
-
- function Lib_File_Name (Source_File : File_Name_Type) return File_Name_Type;
+ -- Returns the full name of library file N. N should not include
+ -- path information. Note that if the file cannot be located No_File is
+ -- returned for the first routine and an all blank time stamp is returned
+ -- for the second (this is not an error situation). The full name includes
+ -- the appropriate directory information. The library file directory lookup
+ -- penalty is incurred every single time this routine is called.
+ -- The procedural version also returns some file attributes for the ALI
+ -- file (to save on system calls later on).
+
+ function Lib_File_Name
+ (Source_File : File_Name_Type;
+ Munit_Index : Nat := 0) return File_Name_Type;
-- Given the name of a source file, returns the name of the corresponding
- -- library information file. This may be the name of the object file, or
- -- of a separate file used to store the library information. In either case
- -- the returned result is suitable for use in a call to Read_Library_Info.
- -- Note: this subprogram is in this section because it is used by the
- -- compiler to determine the proper library information names to be placed
- -- in the generated library information file.
-
- ------------------------------
- -- Debug Source File Output --
- ------------------------------
-
- -- These routines are used by the compiler to generate the debug source
- -- file for the Debug_Generated_Code (-gnatD switch) option. Note that
- -- debug source file writing occurs at a completely different point in
- -- the processing from library information output, so the code in the
- -- body can assume these functions are never used at the same time.
-
- function Create_Debug_File (Src : File_Name_Type) return File_Name_Type;
- -- Given the simple name of a source file, this routine creates the
- -- corresponding debug file, and returns its full name.
-
- procedure Write_Debug_Info (Info : String);
- -- Writes contents of given string as next line of the current debug
- -- source file created by the most recent call to Get_Debug_Name. Info
- -- does not contain any end of line or other formatting characters.
-
- procedure Close_Debug_File;
- -- Close current debug file created by the most recent call to
- -- Get_Debug_Name.
-
- function Debug_File_Eol_Length return Nat;
- -- Returns the number of characters (1 for NL, 2 for CR/LF) written
- -- at the end of each line by Write_Debug_Info.
-
- --------------------------------
- -- Semantic Tree Input-Output --
- --------------------------------
-
- procedure Tree_Create;
- -- Creates the tree output file for the source file which is currently
- -- being compiled (i.e. the file which was most recently returned by
- -- Next_Main_Source), and initializes Tree_IO.Tree_Write for output.
-
- procedure Tree_Close;
- -- Closes the file previously opened by Tree_Create
-
- -------------------
- -- Binder Output --
- -------------------
-
- -- These routines are used by the binder to generate the C source file
- -- containing the binder output. The format of this file is described
- -- in the package Bindfmt.
-
- procedure Create_Binder_Output
- (Output_File_Name : String;
- Typ : Character;
- Bfile : out Name_Id);
- -- Creates the binder output file. Typ is one of
- --
- -- 'c' create output file for case of generating C
- -- 'b' create body file for case of generating Ada
- -- 's' create spec file for case of generating Ada
- --
- -- If Output_File_Name is null, then a default name is used based on
- -- the name of the most recently accessed main source file name. If
- -- Output_File_Name is non-null then it is the full path name of the
- -- file to be output (in the case of Ada, it must have an extension
- -- of adb, and the spec file is created by changing the last character
- -- from b to s. On return, Bfile also contains the Name_Id for the
- -- generated file name.
-
- procedure Write_Binder_Info (Info : String);
- -- Writes the contents of the referenced string to the binder output file
- -- created by a previous call to Create_Binder_Output. Info represents a
- -- single line in the file, but does not contain any line termination
- -- characters. The implementation of Write_Binder_Info is responsible
- -- for adding necessary end of line and end of file control characters
- -- as required by the operating system.
-
- procedure Close_Binder_Output;
- -- Closes the file created by Create_Binder_Output, flushing any
- -- buffers etc from writes by Write_Binder_Info.
+ -- library information file. This may be the name of the object file or of
+ -- a separate file used to store the library information. In the current
+ -- implementation, a separate file (the ALI file) is always used. In either
+ -- case the returned result is suitable for calling Read_Library_Info. The
+ -- Munit_Index is the unit index in multiple unit per file mode, or zero in
+ -- normal single unit per file mode (used to add ~nnn suffix). Note: this
+ -- subprogram is in this section because it is used by the compiler to
+ -- determine the proper library information names to be placed in the
+ -- generated library information file.
-----------------
-- Termination --
-----------------
+ Current_Exit_Status : Integer := 0;
+ -- Exit status that is set with procedure OS_Exit_Through_Exception below
+ -- and can be used in exception handler for Types.Terminate_Program to call
+ -- Set_Exit_Status as the last action of the program.
+
+ procedure OS_Exit_Through_Exception (Status : Integer);
+ -- Set the Current_Exit_Status, then raise Types.Terminate_Program
+
type Exit_Code_Type is (
E_Success, -- No warnings or errors
E_Warnings, -- Compiler warnings generated
E_Abort); -- Internally detected compiler error
procedure Exit_Program (Exit_Code : Exit_Code_Type);
- -- A call to Exit_Program terminates execution with the given status.
- -- A status of zero indicates normal completion, a non-zero status
- -- indicates abnormal termination.
+ pragma No_Return (Exit_Program);
+ -- A call to Exit_Program terminates execution with the given status. A
+ -- status of zero indicates normal completion, a non-zero status indicates
+ -- abnormal termination.
-------------------------
-- Command Line Access --
pragma Import (C, Len_Arg, "__gnat_len_arg");
-- Get length of argument
+ ALI_Default_Suffix : constant String_Ptr := new String'("ali");
+ ALI_Suffix : String_Ptr := ALI_Default_Suffix;
+ -- The suffixes used for the library files (also known as ALI files)
+
+private
+
+ Current_Main : File_Name_Type := No_File;
+ -- Used to save a simple file name between calls to Next_Main_Source and
+ -- Read_Source_File. If the file name argument to Read_Source_File is
+ -- No_File, that indicates that the file whose name was returned by the
+ -- last call to Next_Main_Source (and stored here) is to be read.
+
+ Target_Object_Suffix : constant String := Get_Target_Object_Suffix.all;
+ -- The suffix used for the target object files
+
+ Output_FD : File_Descriptor;
+ -- File descriptor for current library info, list, tree, or binder output
+
+ Output_File_Name : File_Name_Type;
+ -- File_Name_Type for name of open file whose FD is in Output_FD, the name
+ -- stored does not include the trailing NUL character.
+
+ Argument_Count : constant Integer := Arg_Count - 1;
+ -- Number of arguments (excluding program name)
+
+ type File_Name_Array is array (Int range <>) of String_Ptr;
+ type File_Name_Array_Ptr is access File_Name_Array;
+ File_Names : File_Name_Array_Ptr :=
+ new File_Name_Array (1 .. Int (Argument_Count) + 2);
+ -- As arguments are scanned, file names are stored in this array. The
+ -- strings do not have terminating NUL files. The array is extensible,
+ -- because when using project files, there may be more files than
+ -- arguments on the command line.
+
+ type File_Index_Array is array (Int range <>) of Int;
+ type File_Index_Array_Ptr is access File_Index_Array;
+ File_Indexes : File_Index_Array_Ptr :=
+ new File_Index_Array (1 .. Int (Argument_Count) + 2);
+
+ Current_File_Name_Index : Int := 0;
+ -- The index in File_Names of the last file opened by Next_Main_Source
+ -- or Next_Main_Lib_File. The value 0 indicates that no files have been
+ -- opened yet.
+
+ procedure Create_File_And_Check
+ (Fdesc : out File_Descriptor;
+ Fmode : Mode);
+ -- Create file whose name (NUL terminated) is in Name_Buffer (with the
+ -- length in Name_Len), and place the resulting descriptor in Fdesc. Issue
+ -- message and exit with fatal error if file cannot be created. The Fmode
+ -- parameter is set to either Text or Binary (for details see description
+ -- of System.OS_Lib.Create_File).
+
+ type Program_Type is (Compiler, Binder, Make, Gnatls, Unspecified);
+ -- Program currently running
+ procedure Set_Program (P : Program_Type);
+ -- Indicates to the body of Osint the program currently running. This
+ -- procedure is called by the child packages of Osint. A check is made
+ -- that this procedure is not called more than once.
+
+ function More_Files return Boolean;
+ -- Implements More_Source_Files and More_Lib_Files
+
+ function Next_Main_File return File_Name_Type;
+ -- Implements Next_Main_Source and Next_Main_Lib_File
+
+ function Object_File_Name (N : File_Name_Type) return File_Name_Type;
+ -- Constructs the name of the object file corresponding to library file N.
+ -- If N is a full file name than the returned file name will also be a full
+ -- file name. Note that no lookup in the library file directories is done
+ -- for this file. This routine merely constructs the name.
+
+ procedure Write_Info (Info : String);
+ -- Implementation of Write_Binder_Info, Write_Debug_Info and
+ -- Write_Library_Info (identical)
+
+ 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.
+
+ File_Attributes_Size : constant Natural := 24;
+ -- This should be big enough to fit a "struct file_attributes" on any
+ -- system. It doesn't cause any malfunction if it is too big (which avoids
+ -- the need for either mapping the struct exactly or importing the sizeof
+ -- from C, which would result in dynamic code). However, it does waste
+ -- space (e.g. when a component of this type appears in a record, if it is
+ -- unnecessarily large.
+
+ type File_Attributes is
+ array (1 .. File_Attributes_Size)
+ of System.Storage_Elements.Storage_Element;
+ for File_Attributes'Alignment use Standard'Maximum_Alignment;
+
+ Unknown_Attributes : constant File_Attributes := (others => 0);
+ -- Will be initialized properly at elaboration (for efficiency later on,
+ -- avoid function calls every time we want to reset the attributes).
+
end Osint;
OSDN Git Service
