OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

2009-10-30 Emmanuel Briot <briot@adacore.com>

Browse Source 
* make.adb, adaint.c, adaint.h, osint.adb, osint.ads, bcheck.adb
	(*_attr): new subprograms.
	(File_Length, File_Time_Stamp, Is_Writable_File): new subprograms
	(Read_Library_Info_From_Full, Full_Library_Info_Name,
	Full_Source_Name): Now benefit from a previous cache of the file
	attributes, to further save on system calls.
	(Smart_Find_File): now also cache the file attributes. This makes the
	package File_Stamp_Hash_Table useless, and it was removed.
	(Compile_Sources): create subprograms for the various steps of the main
	loop, for readibility and to avoid sharing variables between the
	various steps.

From-SVN: r153747
This commit is contained in:
Emmanuel Briot 2009-10-30 13:44:40 +00:00 committed by Arnaud Charlet
parent b11cb5fd9e
commit 48263c9aa0
7 changed files with 1414 additions and 859 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2009-10-30 Emmanuel Briot <briot@adacore.com>
* make.adb, adaint.c, adaint.h, osint.adb, osint.ads, bcheck.adb
(*_attr): new subprograms.
(File_Length, File_Time_Stamp, Is_Writable_File): new subprograms
(Read_Library_Info_From_Full, Full_Library_Info_Name,
Full_Source_Name): Now benefit from a previous cache of the file
attributes, to further save on system calls.
(Smart_Find_File): now also cache the file attributes. This makes the
package File_Stamp_Hash_Table useless, and it was removed.
(Compile_Sources): create subprograms for the various steps of the main
loop, for readibility and to avoid sharing variables between the
various steps.
2009-10-30 Emmanuel Briot <briot@adacore.com>
* make.adb, osint.adb, osint.ads (Library_File_Stamp): Removed, since

561
gcc/ada/adaint.c
View File

@ -324,6 +324,12 @@ const int __gnat_vmsp = 0;
#endif
/* Used for Ada bindings */
const int size_of_file_attributes = sizeof (struct file_attributes);
/* Reset the file attributes as if no system call had been performed */
void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
/* The __gnat_max_path_len variable is used to export the maximum
length of a path name to Ada code. max_path_len is also provided
for compatibility with older GNAT versions, please do not use
@ -371,6 +377,24 @@ to_ptr32 (char **ptr64)
#define MAYBE_TO_PTR32(argv) argv
#endif
void
reset_attributes
(struct file_attributes* attr)
{
attr->exists = -1;
attr->writable = -1;
attr->readable = -1;
attr->executable = -1;
attr->regular = -1;
attr->symbolic_link = -1;
attr->directory = -1;
attr->timestamp = (OS_Time)-2;
attr->file_length = -1;
}
OS_Time
__gnat_current_time
(void)
@ -1036,42 +1060,89 @@ __gnat_open_new_temp (char *path, int fmode)
return fd < 0 ? -1 : fd;
}
/* Return the number of bytes in the specified file. */
/****************************************************************
** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
** as possible from it, storing the result in a cache for later reuse
****************************************************************/
void
__gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
{
GNAT_STRUCT_STAT statbuf;
int ret;
if (fd != -1)
ret = GNAT_FSTAT (fd, &statbuf);
else
ret = __gnat_stat (name, &statbuf);
attr->regular = (!ret && S_ISREG (statbuf.st_mode));
attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
if (!attr->regular)
attr->file_length = 0;
else
/* st_size may be 32 bits, or 64 bits which is converted to long. We
don't return a useful value for files larger than 2 gigabytes in
either case. */
attr->file_length = statbuf.st_size; /* all systems */
#ifndef __MINGW32__
/* on Windows requires extra system call, see comment in __gnat_file_exists_attr */
attr->exists = !ret;
#endif
#if !defined (_WIN32) || defined (RTX)
/* on Windows requires extra system call, see __gnat_is_readable_file_attr */
attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
#endif
#if !defined (__EMX__) && !defined (MSDOS) && (!defined (_WIN32) || defined (RTX))
/* on Windows requires extra system call, see __gnat_file_time_name_attr */
if (ret != 0) {
attr->timestamp = (OS_Time)-1;
} else {
#ifdef VMS
/* VMS has file versioning. */
attr->timestamp = (OS_Time)statbuf.st_ctime;
#else
attr->timestamp = (OS_Time)statbuf.st_mtime;
#endif
}
#endif
}
/****************************************************************
** Return the number of bytes in the specified file
****************************************************************/
long
__gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
{
if (attr->file_length == -1) {
__gnat_stat_to_attr (fd, name, attr);
}
return attr->file_length;
}
long
__gnat_file_length (int fd)
{
int ret;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_FSTAT (fd, &statbuf);
if (ret || !S_ISREG (statbuf.st_mode))
return 0;
/* st_size may be 32 bits, or 64 bits which is converted to long. We
don't return a useful value for files larger than 2 gigabytes in
either case. */
return (statbuf.st_size);
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_file_length_attr (fd, NULL, &attr);
}
/* Return the number of bytes in the specified named file. */
long
__gnat_named_file_length (char *name)
{
int ret;
GNAT_STRUCT_STAT statbuf;
ret = __gnat_stat (name, &statbuf);
if (ret || !S_ISREG (statbuf.st_mode))
return 0;
/* st_size may be 32 bits, or 64 bits which is converted to long. We
don't return a useful value for files larger than 2 gigabytes in
either case. */
return (statbuf.st_size);
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_file_length_attr (-1, name, &attr);
}
/* Create a temporary filename and put it in string pointed to by
@ -1266,137 +1337,136 @@ win32_filetime (HANDLE h)
/* Return a GNAT time stamp given a file name. */
OS_Time
__gnat_file_time_name (char *name)
__gnat_file_time_name_attr (char* name, struct file_attributes* attr)
{
if (attr->timestamp == (OS_Time)-2) {
#if defined (__EMX__) || defined (MSDOS)
int fd = open (name, O_RDONLY | O_BINARY);
time_t ret = __gnat_file_time_fd (fd);
close (fd);
return (OS_Time)ret;
int fd = open (name, O_RDONLY | O_BINARY);
time_t ret = __gnat_file_time_fd (fd);
close (fd);
attr->timestamp = (OS_Time)ret;
#elif defined (_WIN32) && !defined (RTX)
time_t ret = -1;
TCHAR wname[GNAT_MAX_PATH_LEN];
time_t ret = -1;
TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
HANDLE h = CreateFile
(wname, GENERIC_READ, FILE_SHARE_READ, 0,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
HANDLE h = CreateFile
(wname, GENERIC_READ, FILE_SHARE_READ, 0,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
if (h != INVALID_HANDLE_VALUE)
{
ret = win32_filetime (h);
CloseHandle (h);
}
return (OS_Time) ret;
if (h != INVALID_HANDLE_VALUE) {
ret = win32_filetime (h);
CloseHandle (h);
}
attr->timestamp = (OS_Time) ret;
#else
GNAT_STRUCT_STAT statbuf;
if (__gnat_stat (name, &statbuf) != 0) {
return (OS_Time)-1;
} else {
#ifdef VMS
/* VMS has file versioning. */
return (OS_Time)statbuf.st_ctime;
#else
return (OS_Time)statbuf.st_mtime;
__gnat_stat_to_attr (-1, name, attr);
#endif
}
#endif
return attr->timestamp;
}
OS_Time
__gnat_file_time_name (char *name)
{
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_file_time_name_attr (name, &attr);
}
/* Return a GNAT time stamp given a file descriptor. */
OS_Time
__gnat_file_time_fd (int fd)
__gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
{
/* The following workaround code is due to the fact that under EMX and
DJGPP fstat attempts to convert time values to GMT rather than keep the
actual OS timestamp of the file. By using the OS2/DOS functions directly
the GNAT timestamp are independent of this behavior, which is desired to
facilitate the distribution of GNAT compiled libraries. */
if (attr->timestamp == (OS_Time)-2) {
/* The following workaround code is due to the fact that under EMX and
DJGPP fstat attempts to convert time values to GMT rather than keep the
actual OS timestamp of the file. By using the OS2/DOS functions directly
the GNAT timestamp are independent of this behavior, which is desired to
facilitate the distribution of GNAT compiled libraries. */
#if defined (__EMX__) || defined (MSDOS)
#ifdef __EMX__
FILESTATUS fs;
int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
sizeof (FILESTATUS));
FILESTATUS fs;
int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
sizeof (FILESTATUS));
unsigned file_year = fs.fdateLastWrite.year;
unsigned file_month = fs.fdateLastWrite.month;
unsigned file_day = fs.fdateLastWrite.day;
unsigned file_hour = fs.ftimeLastWrite.hours;
unsigned file_min = fs.ftimeLastWrite.minutes;
unsigned file_tsec = fs.ftimeLastWrite.twosecs;
unsigned file_year = fs.fdateLastWrite.year;
unsigned file_month = fs.fdateLastWrite.month;
unsigned file_day = fs.fdateLastWrite.day;
unsigned file_hour = fs.ftimeLastWrite.hours;
unsigned file_min = fs.ftimeLastWrite.minutes;
unsigned file_tsec = fs.ftimeLastWrite.twosecs;
#else
struct ftime fs;
int ret = getftime (fd, &fs);
struct ftime fs;
int ret = getftime (fd, &fs);
unsigned file_year = fs.ft_year;
unsigned file_month = fs.ft_month;
unsigned file_day = fs.ft_day;
unsigned file_hour = fs.ft_hour;
unsigned file_min = fs.ft_min;
unsigned file_tsec = fs.ft_tsec;
unsigned file_year = fs.ft_year;
unsigned file_month = fs.ft_month;
unsigned file_day = fs.ft_day;
unsigned file_hour = fs.ft_hour;
unsigned file_min = fs.ft_min;
unsigned file_tsec = fs.ft_tsec;
#endif
/* Calculate the seconds since epoch from the time components. First count
the whole days passed. The value for years returned by the DOS and OS2
functions count years from 1980, so to compensate for the UNIX epoch which
begins in 1970 start with 10 years worth of days and add days for each
four year period since then. */
/* Calculate the seconds since epoch from the time components. First count
the whole days passed. The value for years returned by the DOS and OS2
functions count years from 1980, so to compensate for the UNIX epoch which
begins in 1970 start with 10 years worth of days and add days for each
four year period since then. */
time_t tot_secs;
int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
int days_passed = 3652 + (file_year / 4) * 1461;
int years_since_leap = file_year % 4;
time_t tot_secs;
int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
int days_passed = 3652 + (file_year / 4) * 1461;
int years_since_leap = file_year % 4;
if (years_since_leap == 1)
days_passed += 366;
else if (years_since_leap == 2)
days_passed += 731;
else if (years_since_leap == 3)
days_passed += 1096;
if (years_since_leap == 1)
days_passed += 366;
else if (years_since_leap == 2)
days_passed += 731;
else if (years_since_leap == 3)
days_passed += 1096;
if (file_year > 20)
days_passed -= 1;
if (file_year > 20)
days_passed -= 1;
days_passed += cum_days[file_month - 1];
if (years_since_leap == 0 && file_year != 20 && file_month > 2)
days_passed++;
days_passed += cum_days[file_month - 1];
if (years_since_leap == 0 && file_year != 20 && file_month > 2)
days_passed++;
days_passed += file_day - 1;
days_passed += file_day - 1;
/* OK - have whole days. Multiply -- then add in other parts. */
/* OK - have whole days. Multiply -- then add in other parts. */
tot_secs = days_passed * 86400;
tot_secs += file_hour * 3600;
tot_secs += file_min * 60;
tot_secs += file_tsec * 2;
return (OS_Time) tot_secs;
tot_secs = days_passed * 86400;
tot_secs += file_hour * 3600;
tot_secs += file_min * 60;
tot_secs += file_tsec * 2;
attr->timestamp = (OS_Time) tot_secs;
#elif defined (_WIN32) && !defined (RTX)
HANDLE h = (HANDLE) _get_osfhandle (fd);
time_t ret = win32_filetime (h);
return (OS_Time) ret;
HANDLE h = (HANDLE) _get_osfhandle (fd);
time_t ret = win32_filetime (h);
attr->timestamp = (OS_Time) ret;
#else
GNAT_STRUCT_STAT statbuf;
__gnat_stat_to_attr (fd, NULL, attr);
#endif
}
if (GNAT_FSTAT (fd, &statbuf) != 0) {
return (OS_Time) -1;
} else {
#ifdef VMS
/* VMS has file versioning. */
return (OS_Time) statbuf.st_ctime;
#else
return (OS_Time) statbuf.st_mtime;
#endif
}
#endif
return attr->timestamp;
}
OS_Time
__gnat_file_time_fd (int fd)
{
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_file_time_fd_attr (fd, &attr);
}
/* Set the file time stamp. */
@ -1722,24 +1792,41 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
#endif
}
/*************************************************************************
** Check whether a file exists
*************************************************************************/
int
__gnat_file_exists_attr (char* name, struct file_attributes* attr)
{
if (attr->exists == -1) {
#ifdef __MINGW32__
/* On Windows do not use __gnat_stat() because of a bug in Microsoft
_stat() routine. When the system time-zone is set with a negative
offset the _stat() routine fails on specific files like CON: */
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
attr->exists = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
__gnat_stat_to_attr (-1, name, attr);
#endif
}
return attr->exists;
}
int
__gnat_file_exists (char *name)
{
#ifdef __MINGW32__
/* On Windows do not use __gnat_stat() because a bug in Microsoft
_stat() routine. When the system time-zone is set with a negative
offset the _stat() routine fails on specific files like CON: */
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
GNAT_STRUCT_STAT statbuf;
return !__gnat_stat (name, &statbuf);
#endif
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_file_exists_attr (name, &attr);
}
/**********************************************************************
** Whether name is an absolute path
**********************************************************************/
int
__gnat_is_absolute_path (char *name, int length)
{
@ -1775,24 +1862,40 @@ __gnat_is_absolute_path (char *name, int length)
#endif
}
int
__gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
{
if (attr->regular == -1) {
__gnat_stat_to_attr (-1, name, attr);
}
return attr->regular;
}
int
__gnat_is_regular_file (char *name)
{
int ret;
GNAT_STRUCT_STAT statbuf;
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_is_regular_file_attr (name, &attr);
}
ret = __gnat_stat (name, &statbuf);
return (!ret && S_ISREG (statbuf.st_mode));
int
__gnat_is_directory_attr (char* name, struct file_attributes* attr)
{
if (attr->directory == -1) {
__gnat_stat_to_attr (-1, name, attr);
}
return attr->directory;
}
int
__gnat_is_directory (char *name)
{
int ret;
GNAT_STRUCT_STAT statbuf;
ret = __gnat_stat (name, &statbuf);
return (!ret && S_ISDIR (statbuf.st_mode));
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_is_directory_attr (name, &attr);
}
#if defined (_WIN32) && !defined (RTX)
@ -1985,96 +2088,112 @@ __gnat_can_use_acl (TCHAR *wname)
#endif /* defined (_WIN32) && !defined (RTX) */
int
__gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
{
if (attr->readable == -1) {
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname))
{
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericRead = GENERIC_READ;
attr->readable = __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
}
else
attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
__gnat_stat_to_attr (-1, name, attr);
#endif
}
return attr->readable;
}
int
__gnat_is_readable_file (char *name)
{
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_is_readable_file_attr (name, &attr);
}
int
__gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
{
if (attr->writable == -1) {
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname))
{
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericRead = GENERIC_READ;
if (__gnat_can_use_acl (wname))
{
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericWrite = GENERIC_WRITE;
return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
}
else
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
attr->writable = __gnat_check_OWNER_ACL
(wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
&& !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
}
else
attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
#else
int ret;
int mode;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_STAT (name, &statbuf);
mode = statbuf.st_mode & S_IRUSR;
return (!ret && mode);
__gnat_stat_to_attr (-1, name, attr);
#endif
}
return attr->writable;
}
int
__gnat_is_writable_file (char *name)
{
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_is_writable_file_attr (name, &attr);
}
int
__gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
{
if (attr->executable == -1) {
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname))
{
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericWrite = GENERIC_WRITE;
return __gnat_check_OWNER_ACL
(wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
&& !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
}
else
return !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
if (__gnat_can_use_acl (wname))
{
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericExecute = GENERIC_EXECUTE;
attr->executable = __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
}
else
attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
&& _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
#else
int ret;
int mode;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_STAT (name, &statbuf);
mode = statbuf.st_mode & S_IWUSR;
return (!ret && mode);
__gnat_stat_to_attr (-1, name, attr);
#endif
}
return attr->executable;
}
int
__gnat_is_executable_file (char *name)
{
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname))
{
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericExecute = GENERIC_EXECUTE;
return __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
}
else
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
&& _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
#else
int ret;
int mode;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_STAT (name, &statbuf);
mode = statbuf.st_mode & S_IXUSR;
return (!ret && mode);
#endif
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_is_executable_file_attr (name, &attr);
}
void
@ -2193,21 +2312,31 @@ __gnat_set_non_readable (char *name)
}
int
__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
__gnat_is_symbolic_link_attr (char* name, struct file_attributes* attr)
{
if (attr->symbolic_link == -1) {
#if defined (__vxworks) || defined (__nucleus__)
return 0;
attr->symbolic_link = 0;
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
int ret;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_LSTAT (name, &statbuf);
return (!ret && S_ISLNK (statbuf.st_mode));
int ret;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_LSTAT (name, &statbuf);
attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
#else
return 0;
attr->symbolic_link = 0;
#endif
}
return attr->symbolic_link;
}
int
__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
{
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_is_symbolic_link_attr (name, &attr);
}
#if defined (sun) && defined (__SVR4)

51
gcc/ada/adaint.h
View File

@ -68,6 +68,30 @@ typedef long long OS_Time;
typedef long OS_Time;
#endif
/* A lazy cache for the attributes of a file. On some systems, a single call to
stat() will give all this information, so it is better than doing a system
call every time. On other systems this require several system calls.
*/
struct file_attributes {
short exists;
short writable;
short readable;
short executable;
short symbolic_link;
short regular;
short directory;
OS_Time timestamp;
long file_length;
};
/* WARNING: changing the size here might require changing the constant
* File_Attributes_Size in osint.ads (which should be big enough to
* fit the above struct on any system)
*/
extern int __gnat_max_path_len;
extern OS_Time __gnat_current_time (void);
extern void __gnat_current_time_string (char *);
@ -121,15 +145,28 @@ extern OS_Time __gnat_file_time_fd (int);
extern void __gnat_set_file_time_name (char *, time_t);
extern int __gnat_dup (int);
extern int __gnat_dup2 (int, int);
extern int __gnat_file_exists (char *);
extern int __gnat_is_regular_file (char *);
extern int __gnat_is_absolute_path (char *,int);
extern int __gnat_is_directory (char *);
extern int __gnat_dup (int);
extern int __gnat_dup2 (int, int);
extern int __gnat_file_exists (char *);
extern int __gnat_is_regular_file (char *);
extern int __gnat_is_absolute_path (char *,int);
extern int __gnat_is_directory (char *);
extern int __gnat_is_writable_file (char *);
extern int __gnat_is_readable_file (char *name);
extern int __gnat_is_executable_file (char *name);
extern int __gnat_is_executable_file (char *name);
extern void reset_attributes (struct file_attributes* attr);
extern long __gnat_file_length_attr (int, char *, struct file_attributes *);
extern OS_Time __gnat_file_time_name_attr (char *, struct file_attributes *);
extern OS_Time __gnat_file_time_fd_attr (int, struct file_attributes *);
extern int __gnat_file_exists_attr (char *, struct file_attributes *);
extern int __gnat_is_regular_file_attr (char *, struct file_attributes *);
extern int __gnat_is_directory_attr (char *, struct file_attributes *);
extern int __gnat_is_readable_file_attr (char *, struct file_attributes *);
extern int __gnat_is_writable_file_attr (char *, struct file_attributes *);
extern int __gnat_is_executable_file_attr (char *, struct file_attributes *);
extern int __gnat_is_symbolic_link_attr (char *, struct file_attributes *);
extern void __gnat_set_non_writable (char *name);
extern void __gnat_set_writable (char *name);
extern void __gnat_set_executable (char *name);

2
gcc/ada/bcheck.adb
View File

@ -190,7 +190,7 @@ package body Bcheck is
else
ALI_Path_Id :=
Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
if Osint.Is_Readonly_Library (ALI_Path_Id) then
if Tolerate_Consistency_Errors then
Error_Msg ("?{ should be recompiled");

1188
gcc/ada/make.adb
View File

File diff suppressed because it is too large Load Diff

383
gcc/ada/osint.adb
View File

@ -94,16 +94,39 @@ package body Osint is
-- Update the specified path to replace the prefix with the location
-- where GNAT is installed. See the file prefix.c in GCC for details.
function Locate_File
(N : File_Name_Type;
T : File_Type;
Dir : Natural;
Name : String) return File_Name_Type;
procedure Locate_File
(N : File_Name_Type;
T : File_Type;
Dir : Natural;
Name : String;
Found : out File_Name_Type;
Attr : access File_Attributes);
-- 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.
-- On exit, Found is set to the file that was found, and Attr to a cache of
-- its attributes (at least those that have been computed so far). Reusing
-- the cache will save some system calls.
-- Attr is always reset in this call to Unknown_Attributes, even in case of
-- failure
procedure Find_File
(N : File_Name_Type;
T : File_Type;
Found : out File_Name_Type;
Attr : access File_Attributes);
-- A version of Find_File that also returns a cache of the file attributes
-- for later reuse
procedure Smart_Find_File
(N : File_Name_Type;
T : File_Type;
Found : out File_Name_Type;
Attr : out File_Attributes);
-- A version of Smart_Find_File that also returns a cache of the file
-- attributes for later reuse
function C_String_Length (S : Address) return Integer;
-- Returns length of a C string (zero for a null address)
@ -212,18 +235,17 @@ package body Osint is
function File_Hash (F : File_Name_Type) return File_Hash_Num;
-- Compute hash index for use by Simple_HTable
type File_Info_Cache is record
File : File_Name_Type;
Attr : aliased File_Attributes;
end record;
No_File_Info_Cache : constant File_Info_Cache :=
(No_File, Unknown_Attributes);
package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => File_Hash_Num,
Element => File_Name_Type,
No_Element => No_File,
Key => File_Name_Type,
Hash => File_Hash,
Equal => "=");
package File_Stamp_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => File_Hash_Num,
Element => Time_Stamp_Type,
No_Element => Empty_Time_Stamp,
Element => File_Info_Cache,
No_Element => No_File_Info_Cache,
Key => File_Name_Type,
Hash => File_Hash,
Equal => "=");
@ -959,6 +981,33 @@ package body Osint is
return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length);
end File_Hash;
-----------------
-- File_Length --
-----------------
function File_Length
(Name : C_File_Name; Attr : access File_Attributes) return Long_Integer
is
function Internal
(F : Integer; N : C_File_Name; A : System.Address) return Long_Integer;
pragma Import (C, Internal, "__gnat_file_length_attr");
begin
return Internal (-1, Name, Attr.all'Address);
end File_Length;
---------------------
-- File_Time_Stamp --
---------------------
function File_Time_Stamp
(Name : C_File_Name; Attr : access File_Attributes) return OS_Time
is
function Internal (N : C_File_Name; A : System.Address) return OS_Time;
pragma Import (C, Internal, "__gnat_file_time_name_attr");
begin
return Internal (Name, Attr.all'Address);
end File_Time_Stamp;
----------------
-- File_Stamp --
----------------
@ -993,6 +1042,22 @@ package body Osint is
(N : File_Name_Type;
T : File_Type) return File_Name_Type
is
Attr : aliased File_Attributes;
Found : File_Name_Type;
begin
Find_File (N, T, Found, Attr'Access);
return Found;
end Find_File;
---------------
-- Find_File --
---------------
procedure Find_File
(N : File_Name_Type;
T : File_Type;
Found : out File_Name_Type;
Attr : access File_Attributes) is
begin
Get_Name_String (N);
@ -1016,7 +1081,9 @@ package body Osint is
(Hostparm.OpenVMS and then
Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
then
return N;
Found := N;
Attr.all := Unknown_Attributes;
return;
-- If we are trying to find the current main file just look in the
-- directory where the user said it was.
@ -1024,7 +1091,8 @@ package body Osint is
elsif Look_In_Primary_Directory_For_Current_Main
and then Current_Main = N
then
return Locate_File (N, T, Primary_Directory, File_Name);
Locate_File (N, T, Primary_Directory, File_Name, Found, Attr);
return;
-- Otherwise do standard search for source file
@ -1042,21 +1110,23 @@ package body Osint is
-- return No_File, indicating the file is not a source.
if File = Error_File_Name then
return No_File;
Found := No_File;
else
return File;
Found := File;
end if;
Attr.all := Unknown_Attributes;
return;
end if;
-- First place to look is in the primary directory (i.e. the same
-- directory as the source) unless this has been disabled with -I-
if Opt.Look_In_Primary_Dir then
File := Locate_File (N, T, Primary_Directory, File_Name);
Locate_File (N, T, Primary_Directory, File_Name, Found, Attr);
if File /= No_File then
return File;
if Found /= No_File then
return;
end if;
end if;
@ -1069,14 +1139,15 @@ package body Osint is
end if;
for D in Primary_Directory + 1 .. Last_Dir loop
File := Locate_File (N, T, D, File_Name);
Locate_File (N, T, D, File_Name, Found, Attr);
if File /= No_File then
return File;
if Found /= No_File then
return;
end if;
end loop;
return No_File;
Attr.all := Unknown_Attributes;
Found := No_File;
end if;
end;
end Find_File;
@ -1148,9 +1219,28 @@ package body Osint is
-- Full_Lib_File_Name --
------------------------
function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type is
procedure Full_Lib_File_Name
(N : File_Name_Type;
Lib_File : out File_Name_Type;
Attr : out File_Attributes)
is
A : aliased File_Attributes;
begin
return Find_File (N, Library);
-- ??? seems we could use Smart_Find_File here
Find_File (N, Library, Lib_File, A'Access);
Attr := A;
end Full_Lib_File_Name;
------------------------
-- Full_Lib_File_Name --
------------------------
function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type is
Attr : File_Attributes;
File : File_Name_Type;
begin
Full_Lib_File_Name (N, File, Attr);
return File;
end Full_Lib_File_Name;
----------------------------
@ -1189,6 +1279,18 @@ package body Osint is
return Smart_Find_File (N, Source);
end Full_Source_Name;
----------------------
-- Full_Source_Name --
----------------------
procedure Full_Source_Name
(N : File_Name_Type;
Full_File : out File_Name_Type;
Attr : access File_Attributes) is
begin
Smart_Find_File (N, Source, Full_File, Attr.all);
end Full_Source_Name;
-------------------
-- Get_Directory --
-------------------
@ -1470,6 +1572,19 @@ package body Osint is
Lib_Search_Directories.Table (Primary_Directory) := new String'("");
end Initialize;
------------------
-- Is_Directory --
------------------
function Is_Directory
(Name : C_File_Name; Attr : access File_Attributes) return Boolean
is
function Internal (N : C_File_Name; A : System.Address) return Integer;
pragma Import (C, Internal, "__gnat_is_directory_attr");
begin
return Internal (Name, Attr.all'Address) /= 0;
end Is_Directory;
----------------------------
-- Is_Directory_Separator --
----------------------------
@ -1501,6 +1616,71 @@ package body Osint is
return not Is_Writable_File (Name_Buffer (1 .. Name_Len));
end Is_Readonly_Library;
------------------------
-- Is_Executable_File --
------------------------
function Is_Executable_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean
is
function Internal (N : C_File_Name; A : System.Address) return Integer;
pragma Import (C, Internal, "__gnat_is_executable_file_attr");
begin
return Internal (Name, Attr.all'Address) /= 0;
end Is_Executable_File;
----------------------
-- Is_Readable_File --
----------------------
function Is_Readable_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean
is
function Internal (N : C_File_Name; A : System.Address) return Integer;
pragma Import (C, Internal, "__gnat_is_readable_file_attr");
begin
return Internal (Name, Attr.all'Address) /= 0;
end Is_Readable_File;
---------------------
-- Is_Regular_File --
---------------------
function Is_Regular_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean
is
function Internal (N : C_File_Name; A : System.Address) return Integer;
pragma Import (C, Internal, "__gnat_is_regular_file_attr");
begin
return Internal (Name, Attr.all'Address) /= 0;
end Is_Regular_File;
----------------------
-- Is_Symbolic_Link --
----------------------
function Is_Symbolic_Link
(Name : C_File_Name; Attr : access File_Attributes) return Boolean
is
function Internal (N : C_File_Name; A : System.Address) return Integer;
pragma Import (C, Internal, "__gnat_is_symbolic_link_attr");
begin
return Internal (Name, Attr.all'Address) /= 0;
end Is_Symbolic_Link;
----------------------
-- Is_Writable_File --
----------------------
function Is_Writable_File
(Name : C_File_Name; Attr : access File_Attributes) return Boolean
is
function Internal (N : C_File_Name; A : System.Address) return Integer;
pragma Import (C, Internal, "__gnat_is_writable_file_attr");
begin
return Internal (Name, Attr.all'Address) /= 0;
end Is_Writable_File;
-------------------
-- Lib_File_Name --
-------------------
@ -1533,11 +1713,13 @@ package body Osint is
-- Locate_File --
-----------------
function Locate_File
(N : File_Name_Type;
T : File_Type;
Dir : Natural;
Name : String) return File_Name_Type
procedure Locate_File
(N : File_Name_Type;
T : File_Type;
Dir : Natural;
Name : String;
Found : out File_Name_Type;
Attr : access File_Attributes)
is
Dir_Name : String_Ptr;
@ -1555,24 +1737,28 @@ package body Osint is
end if;
declare
Full_Name : String (1 .. Dir_Name'Length + Name'Length);
Full_Name : String (1 .. Dir_Name'Length + Name'Length + 1);
begin
Full_Name (1 .. Dir_Name'Length) := Dir_Name.all;
Full_Name (Dir_Name'Length + 1 .. Full_Name'Length) := Name;
Full_Name (Dir_Name'Length + 1 .. Full_Name'Last - 1) := Name;
Full_Name (Full_Name'Last) := ASCII.NUL;
if not Is_Regular_File (Full_Name) then
return No_File;
Attr.all := Unknown_Attributes;
if not Is_Regular_File (Full_Name'Address, Attr) then
Found := No_File;
else
-- If the file is in the current directory then return N itself
if Dir_Name'Length = 0 then
return N;
Found := N;
else
Name_Len := Full_Name'Length;
Name_Buffer (1 .. Name_Len) := Full_Name;
return Name_Enter;
Name_Len := Full_Name'Length - 1;
Name_Buffer (1 .. Name_Len) :=
Full_Name (1 .. Full_Name'Last - 1);
Found := Name_Find; -- ??? Was Name_Enter, no obvious reason
end if;
end if;
end;
@ -1592,11 +1778,13 @@ package body Osint is
declare
File_Name : constant String := Name_Buffer (1 .. Name_Len);
File : File_Name_Type := No_File;
Attr : aliased File_Attributes;
Last_Dir : Natural;
begin
if Opt.Look_In_Primary_Dir then
File := Locate_File (N, Source, Primary_Directory, File_Name);
Locate_File
(N, Source, Primary_Directory, File_Name, File, Attr'Access);
if File /= No_File and then T = File_Stamp (N) then
return File;
@ -1606,7 +1794,7 @@ package body Osint is
Last_Dir := Src_Search_Directories.Last;
for D in Primary_Directory + 1 .. Last_Dir loop
File := Locate_File (N, Source, D, File_Name);
Locate_File (N, Source, D, File_Name, File, Attr'Access);
if File /= No_File and then T = File_Stamp (File) then
return File;
@ -2110,10 +2298,15 @@ package body Osint is
function Read_Library_Info
(Lib_File : File_Name_Type;
Fatal_Err : Boolean := False) return Text_Buffer_Ptr is
Fatal_Err : Boolean := False) return Text_Buffer_Ptr
is
File : File_Name_Type;
Attr : aliased File_Attributes;
begin
Find_File (Lib_File, Library, File, Attr'Access);
return Read_Library_Info_From_Full
(Full_Lib_File => Find_File (Lib_File, Library),
(Full_Lib_File => File,
Lib_File_Attr => Attr'Access,
Fatal_Err => Fatal_Err);
end Read_Library_Info;
@ -2123,12 +2316,17 @@ package body Osint is
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
is
Lib_FD : File_Descriptor;
-- The file descriptor for the current library file. A negative value
-- indicates failure to open the specified source file.
Len : Integer;
-- Length of source file text (ALI). If it doesn't fit in an integer
-- we're probably stuck anyway (>2 gigs of source seems a lot!)
Text : Text_Buffer_Ptr;
-- Allocated text buffer
@ -2168,17 +2366,32 @@ package body Osint is
end if;
end if;
-- Compute the length of the file (potentially also preparing other data
-- like the timestamp and whether the file is read-only, for future use)
Len := Integer (File_Length (Name_Buffer'Address, Lib_File_Attr));
-- Check for object file consistency if requested
if Opt.Check_Object_Consistency then
Current_Full_Lib_Stamp := File_Stamp (Current_Full_Lib_Name);
-- On most systems, this does not result in an extra system call
Current_Full_Lib_Stamp := OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr));
-- ??? One system call here
Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
if Current_Full_Obj_Stamp (1) = ' ' then
-- When the library is readonly always assume object is consistent
-- The call to Is_Writable_File only results in a system call on
-- some systems, but in most cases it has already been computed as
-- part of the call to File_Length above.
if Is_Readonly_Library (Current_Full_Lib_Name) then
Get_Name_String (Current_Full_Lib_Name);
Name_Buffer (Name_Len + 1) := ASCII.NUL;
if not Is_Writable_File (Name_Buffer'Address, Lib_File_Attr) then
Current_Full_Obj_Stamp := Current_Full_Lib_Stamp;
elsif Fatal_Err then
@ -2203,10 +2416,6 @@ package body Osint is
-- Read data from the file
declare
Len : constant Integer := Integer (File_Length (Lib_FD));
-- Length of source file text. If it doesn't fit in an integer
-- we're probably stuck anyway (>2 gigs of source seems a lot!)
Actual_Len : Integer := 0;
Lo : constant Text_Ptr := 0;
@ -2482,21 +2691,23 @@ package body Osint is
(N : File_Name_Type;
T : File_Type) return Time_Stamp_Type
is
Time_Stamp : Time_Stamp_Type;
File : File_Name_Type;
Attr : aliased File_Attributes;
begin
if not File_Cache_Enabled then
return File_Stamp (Find_File (N, T));
Find_File (N, T, File, Attr'Access);
else
Smart_Find_File (N, T, File, Attr);
end if;
Time_Stamp := File_Stamp_Hash_Table.Get (N);
if Time_Stamp (1) = ' ' then
Time_Stamp := File_Stamp (Smart_Find_File (N, T));
File_Stamp_Hash_Table.Set (N, Time_Stamp);
if File = No_File then
return Empty_Time_Stamp;
else
Get_Name_String (File);
Name_Buffer (Name_Len + 1) := ASCII.NUL;
return OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer'Address, Attr'Access));
end if;
return Time_Stamp;
end Smart_File_Stamp;
---------------------
@ -2507,21 +2718,38 @@ package body Osint is
(N : File_Name_Type;
T : File_Type) return File_Name_Type
is
Full_File_Name : File_Name_Type;
File : File_Name_Type;
Attr : File_Attributes;
begin
Smart_Find_File (N, T, File, Attr);
return File;
end Smart_Find_File;
---------------------
-- Smart_Find_File --
---------------------
procedure Smart_Find_File
(N : File_Name_Type;
T : File_Type;
Found : out File_Name_Type;
Attr : out File_Attributes)
is
Info : File_Info_Cache;
begin
if not File_Cache_Enabled then
return Find_File (N, T);
Find_File (N, T, Info.File, Info.Attr'Access);
else
Info := File_Name_Hash_Table.Get (N);
if Info.File = No_File then
Find_File (N, T, Info.File, Info.Attr'Access);
File_Name_Hash_Table.Set (N, Info);
end if;
end if;
Full_File_Name := File_Name_Hash_Table.Get (N);
if Full_File_Name = No_File then
Full_File_Name := Find_File (N, T);
File_Name_Hash_Table.Set (N, Full_File_Name);
end if;
return Full_File_Name;
Found := Info.File;
Attr := Info.Attr;
end Smart_Find_File;
----------------------
@ -2951,6 +3179,9 @@ package body Osint is
-- Package Initialization --
----------------------------
procedure Reset_File_Attributes (Attr : System.Address);
pragma Import (C, Reset_File_Attributes, "reset_attributes");
begin
Initialization : declare
@ -2966,7 +3197,15 @@ begin
"__gnat_get_maximum_file_name_length");
-- Function to get maximum file name length for system
Sizeof_File_Attributes : Integer;
pragma Import (C, Sizeof_File_Attributes,
"size_of_file_attributes");
begin
pragma Assert (Sizeof_File_Attributes <= File_Attributes_Size);
Reset_File_Attributes (Unknown_Attributes'Address);
Identifier_Character_Set := Get_Default_Identifier_Character_Set;
Maximum_File_Name_Length := Get_Maximum_File_Name_Length;

74
gcc/ada/osint.ads
View File

@ -29,6 +29,7 @@
with Namet; use Namet;
with Types; use Types;
with System.Storage_Elements;
with System.OS_Lib; use System.OS_Lib;
with System; use System;
@ -230,6 +231,47 @@ package Osint is
-- 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;
-- 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 --
-------------------------
@ -380,6 +422,10 @@ package Osint is
-- 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
@ -390,6 +436,8 @@ package Osint is
-- 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
@ -488,10 +536,14 @@ package Osint is
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)
-- 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;
@ -508,6 +560,10 @@ package Osint is
-- 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;
-- 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
@ -515,6 +571,8 @@ package Osint is
-- 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;
@ -660,4 +718,18 @@ private
-- detected, the file being written is deleted, and a fatal error is
-- signalled.
File_Attributes_Size : constant Integer := 50;
-- This should be big enough to fit a "struct file_attributes" on any
-- system. It doesn't matter 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)
type File_Attributes is
array (1 .. File_Attributes_Size)
of System.Storage_Elements.Storage_Element;
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;