Skip to content

R
riscv-gcc-1
Commit 48263c9a by Emmanuel Briot Committed by Arnaud Charlet
Options

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.

From-SVN: r153747
parent b11cb5fd
Showing with 1300 additions and 745 deletions
gcc/ada/ChangeLog
2009-10-30 Emmanuel Briot <briot@adacore.com> 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 * make.adb, osint.adb, osint.ads (Library_File_Stamp): Removed, since
unused. unused.
(Read_Library_Info_From_Full): New subprogram. (Read_Library_Info_From_Full): New subprogram.
......
gcc/ada/adaint.c
...@@ -324,6 +324,12 @@ const int __gnat_vmsp = 0; ...@@ -324,6 +324,12 @@ const int __gnat_vmsp = 0;
#endif #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 /* 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 length of a path name to Ada code. max_path_len is also provided
for compatibility with older GNAT versions, please do not use for compatibility with older GNAT versions, please do not use
...@@ -371,6 +377,24 @@ to_ptr32 (char **ptr64) ...@@ -371,6 +377,24 @@ to_ptr32 (char **ptr64)
#define MAYBE_TO_PTR32(argv) argv #define MAYBE_TO_PTR32(argv) argv
#endif #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 OS_Time
__gnat_current_time __gnat_current_time
(void) (void)
...@@ -1036,42 +1060,89 @@ __gnat_open_new_temp (char *path, int fmode) ...@@ -1036,42 +1060,89 @@ __gnat_open_new_temp (char *path, int fmode)
return fd < 0 ? -1 : fd; 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
****************************************************************/
long void
__gnat_file_length (int fd) __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
{ {
int ret;
GNAT_STRUCT_STAT statbuf; GNAT_STRUCT_STAT statbuf;
int ret;
ret = GNAT_FSTAT (fd, &statbuf); if (fd != -1)
if (ret || !S_ISREG (statbuf.st_mode)) ret = GNAT_FSTAT (fd, &statbuf);
return 0; else
ret = __gnat_stat (name, &statbuf);
attr->regular = (!ret && S_ISREG (statbuf.st_mode));
attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
/* st_size may be 32 bits, or 64 bits which is converted to long. We if (!attr->regular)
don't return a useful value for files larger than 2 gigabytes in attr->file_length = 0;
either case. */ 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 (statbuf.st_size);
} }
/* Return the number of bytes in the specified named file. */ /****************************************************************
** Return the number of bytes in the specified file
****************************************************************/
long long
__gnat_named_file_length (char *name) __gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
{ {
int ret; if (attr->file_length == -1) {
GNAT_STRUCT_STAT statbuf; __gnat_stat_to_attr (fd, name, attr);
}
ret = __gnat_stat (name, &statbuf); return attr->file_length;
if (ret || !S_ISREG (statbuf.st_mode)) }
return 0;
/* st_size may be 32 bits, or 64 bits which is converted to long. We long
don't return a useful value for files larger than 2 gigabytes in __gnat_file_length (int fd)
either case. */ {
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_file_length_attr (fd, NULL, &attr);
}
return (statbuf.st_size); long
__gnat_named_file_length (char *name)
{
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 /* Create a temporary filename and put it in string pointed to by
...@@ -1266,137 +1337,136 @@ win32_filetime (HANDLE h) ...@@ -1266,137 +1337,136 @@ win32_filetime (HANDLE h)
/* Return a GNAT time stamp given a file name. */ /* Return a GNAT time stamp given a file name. */
OS_Time 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) #if defined (__EMX__) || defined (MSDOS)
int fd = open (name, O_RDONLY | O_BINARY); int fd = open (name, O_RDONLY | O_BINARY);
time_t ret = __gnat_file_time_fd (fd); time_t ret = __gnat_file_time_fd (fd);
close (fd); close (fd);
return (OS_Time)ret; attr->timestamp = (OS_Time)ret;
#elif defined (_WIN32) && !defined (RTX) #elif defined (_WIN32) && !defined (RTX)
time_t ret = -1; time_t ret = -1;
TCHAR wname[GNAT_MAX_PATH_LEN]; TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
HANDLE h = CreateFile HANDLE h = CreateFile
(wname, GENERIC_READ, FILE_SHARE_READ, 0, (wname, GENERIC_READ, FILE_SHARE_READ, 0,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0); OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
if (h != INVALID_HANDLE_VALUE) if (h != INVALID_HANDLE_VALUE) {
{ ret = win32_filetime (h);
ret = win32_filetime (h); CloseHandle (h);
CloseHandle (h); }
} attr->timestamp = (OS_Time) ret;
return (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 #else
return (OS_Time)statbuf.st_mtime; __gnat_stat_to_attr (-1, name, attr);
#endif #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. */ /* Return a GNAT time stamp given a file descriptor. */
OS_Time 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 if (attr->timestamp == (OS_Time)-2) {
DJGPP fstat attempts to convert time values to GMT rather than keep the /* The following workaround code is due to the fact that under EMX and
actual OS timestamp of the file. By using the OS2/DOS functions directly DJGPP fstat attempts to convert time values to GMT rather than keep the
the GNAT timestamp are independent of this behavior, which is desired to actual OS timestamp of the file. By using the OS2/DOS functions directly
facilitate the distribution of GNAT compiled libraries. */ the GNAT timestamp are independent of this behavior, which is desired to
facilitate the distribution of GNAT compiled libraries. */
#if defined (__EMX__) || defined (MSDOS) #if defined (__EMX__) || defined (MSDOS)
#ifdef __EMX__ #ifdef __EMX__
FILESTATUS fs; FILESTATUS fs;
int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs, int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
sizeof (FILESTATUS)); sizeof (FILESTATUS));
unsigned file_year = fs.fdateLastWrite.year; unsigned file_year = fs.fdateLastWrite.year;
unsigned file_month = fs.fdateLastWrite.month; unsigned file_month = fs.fdateLastWrite.month;
unsigned file_day = fs.fdateLastWrite.day; unsigned file_day = fs.fdateLastWrite.day;
unsigned file_hour = fs.ftimeLastWrite.hours; unsigned file_hour = fs.ftimeLastWrite.hours;
unsigned file_min = fs.ftimeLastWrite.minutes; unsigned file_min = fs.ftimeLastWrite.minutes;
unsigned file_tsec = fs.ftimeLastWrite.twosecs; unsigned file_tsec = fs.ftimeLastWrite.twosecs;
#else #else
struct ftime fs; struct ftime fs;
int ret = getftime (fd, &fs); int ret = getftime (fd, &fs);
unsigned file_year = fs.ft_year; unsigned file_year = fs.ft_year;
unsigned file_month = fs.ft_month; unsigned file_month = fs.ft_month;
unsigned file_day = fs.ft_day; unsigned file_day = fs.ft_day;
unsigned file_hour = fs.ft_hour; unsigned file_hour = fs.ft_hour;
unsigned file_min = fs.ft_min; unsigned file_min = fs.ft_min;
unsigned file_tsec = fs.ft_tsec; unsigned file_tsec = fs.ft_tsec;
#endif #endif
/* Calculate the seconds since epoch from the time components. First count /* 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 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 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 begins in 1970 start with 10 years worth of days and add days for each
four year period since then. */ four year period since then. */
time_t tot_secs; time_t tot_secs;
int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334}; 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 days_passed = 3652 + (file_year / 4) * 1461;
int years_since_leap = file_year % 4; int years_since_leap = file_year % 4;
if (years_since_leap == 1) if (years_since_leap == 1)
days_passed += 366; days_passed += 366;
else if (years_since_leap == 2) else if (years_since_leap == 2)
days_passed += 731; days_passed += 731;
else if (years_since_leap == 3) else if (years_since_leap == 3)
days_passed += 1096; days_passed += 1096;
if (file_year > 20) if (file_year > 20)
days_passed -= 1; days_passed -= 1;
days_passed += cum_days[file_month - 1]; days_passed += cum_days[file_month - 1];
if (years_since_leap == 0 && file_year != 20 && file_month > 2) if (years_since_leap == 0 && file_year != 20 && file_month > 2)
days_passed++; 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 = days_passed * 86400;
tot_secs += file_hour * 3600; tot_secs += file_hour * 3600;
tot_secs += file_min * 60; tot_secs += file_min * 60;
tot_secs += file_tsec * 2; tot_secs += file_tsec * 2;
return (OS_Time) tot_secs; attr->timestamp = (OS_Time) tot_secs;
#elif defined (_WIN32) && !defined (RTX) #elif defined (_WIN32) && !defined (RTX)
HANDLE h = (HANDLE) _get_osfhandle (fd); HANDLE h = (HANDLE) _get_osfhandle (fd);
time_t ret = win32_filetime (h); time_t ret = win32_filetime (h);
return (OS_Time) ret; attr->timestamp = (OS_Time) ret;
#else #else
GNAT_STRUCT_STAT statbuf; __gnat_stat_to_attr (fd, NULL, attr);
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 #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. */ /* Set the file time stamp. */
...@@ -1722,25 +1792,42 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf) ...@@ -1722,25 +1792,42 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
#endif #endif
} }
/*************************************************************************
** Check whether a file exists
*************************************************************************/
int int
__gnat_file_exists (char *name) __gnat_file_exists_attr (char* name, struct file_attributes* attr)
{ {
if (attr->exists == -1) {
#ifdef __MINGW32__ #ifdef __MINGW32__
/* On Windows do not use __gnat_stat() because a bug in Microsoft /* 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 _stat() routine. When the system time-zone is set with a negative
offset the _stat() routine fails on specific files like CON: */ offset the _stat() routine fails on specific files like CON: */
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2); attr->exists = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else #else
GNAT_STRUCT_STAT statbuf; __gnat_stat_to_attr (-1, name, attr);
return !__gnat_stat (name, &statbuf);
#endif #endif
}
return attr->exists;
} }
int int
__gnat_file_exists (char *name)
{
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) __gnat_is_absolute_path (char *name, int length)
{ {
#ifdef __vxworks #ifdef __vxworks
...@@ -1776,23 +1863,39 @@ __gnat_is_absolute_path (char *name, int length) ...@@ -1776,23 +1863,39 @@ __gnat_is_absolute_path (char *name, int length)
} }
int 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) __gnat_is_regular_file (char *name)
{ {
int ret; struct file_attributes attr;
GNAT_STRUCT_STAT statbuf; reset_attributes (&attr);
return __gnat_is_regular_file_attr (name, &attr);
}
ret = __gnat_stat (name, &statbuf); int
return (!ret && S_ISREG (statbuf.st_mode)); __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 int
__gnat_is_directory (char *name) __gnat_is_directory (char *name)
{ {
int ret; struct file_attributes attr;
GNAT_STRUCT_STAT statbuf; reset_attributes (&attr);
return __gnat_is_directory_attr (name, &attr);
ret = __gnat_stat (name, &statbuf);
return (!ret && S_ISDIR (statbuf.st_mode));
} }
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32) && !defined (RTX)
...@@ -1986,95 +2089,111 @@ __gnat_can_use_acl (TCHAR *wname) ...@@ -1986,95 +2089,111 @@ __gnat_can_use_acl (TCHAR *wname)
#endif /* defined (_WIN32) && !defined (RTX) */ #endif /* defined (_WIN32) && !defined (RTX) */
int int
__gnat_is_readable_file (char *name) __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
{ {
if (attr->readable == -1) {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping; GENERIC_MAPPING GenericMapping;
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
if (__gnat_can_use_acl (wname)) S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
{
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericRead = GENERIC_READ;
return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
}
else
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
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 #else
int ret; __gnat_stat_to_attr (-1, name, attr);
int mode;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_STAT (name, &statbuf);
mode = statbuf.st_mode & S_IRUSR;
return (!ret && mode);
#endif #endif
}
return attr->readable;
} }
int int
__gnat_is_writable_file (char *name) __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) #if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping; 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)) if (__gnat_can_use_acl (wname))
{ {
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING)); ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericWrite = GENERIC_WRITE; GenericMapping.GenericWrite = GENERIC_WRITE;
return __gnat_check_OWNER_ACL attr->writable = __gnat_check_OWNER_ACL
(wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping) (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
&& !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY); && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
} }
else else
return !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY); attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
#else #else
int ret; __gnat_stat_to_attr (-1, name, attr);
int mode;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_STAT (name, &statbuf);
mode = statbuf.st_mode & S_IWUSR;
return (!ret && mode);
#endif #endif
}
return attr->writable;
} }
int int
__gnat_is_executable_file (char *name) __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) #if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping; 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)) if (__gnat_can_use_acl (wname))
{ {
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING)); ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericExecute = GENERIC_EXECUTE; GenericMapping.GenericExecute = GENERIC_EXECUTE;
return __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping); attr->executable = __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
} }
else else
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
&& _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4); && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
#else #else
int ret; __gnat_stat_to_attr (-1, name, attr);
int mode;
GNAT_STRUCT_STAT statbuf;
ret = GNAT_STAT (name, &statbuf);
mode = statbuf.st_mode & S_IXUSR;
return (!ret && mode);
#endif #endif
}
return attr->executable;
}
int
__gnat_is_executable_file (char *name)
{
struct file_attributes attr;
reset_attributes (&attr);
return __gnat_is_executable_file_attr (name, &attr);
} }
void void
...@@ -2193,21 +2312,31 @@ __gnat_set_non_readable (char *name) ...@@ -2193,21 +2312,31 @@ __gnat_set_non_readable (char *name)
} }
int 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__) #if defined (__vxworks) || defined (__nucleus__)
return 0; attr->symbolic_link = 0;
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__) #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
int ret; int ret;
GNAT_STRUCT_STAT statbuf; GNAT_STRUCT_STAT statbuf;
ret = GNAT_LSTAT (name, &statbuf);
ret = GNAT_LSTAT (name, &statbuf); attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
return (!ret && S_ISLNK (statbuf.st_mode));
#else #else
return 0; attr->symbolic_link = 0;
#endif #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) #if defined (sun) && defined (__SVR4)
......
gcc/ada/adaint.h
...@@ -68,6 +68,30 @@ typedef long long OS_Time; ...@@ -68,6 +68,30 @@ typedef long long OS_Time;
typedef long OS_Time; typedef long OS_Time;
#endif #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 int __gnat_max_path_len;
extern OS_Time __gnat_current_time (void); extern OS_Time __gnat_current_time (void);
extern void __gnat_current_time_string (char *); extern void __gnat_current_time_string (char *);
...@@ -121,15 +145,28 @@ extern OS_Time __gnat_file_time_fd (int); ...@@ -121,15 +145,28 @@ extern OS_Time __gnat_file_time_fd (int);
extern void __gnat_set_file_time_name (char *, time_t); extern void __gnat_set_file_time_name (char *, time_t);
extern int __gnat_dup (int); extern int __gnat_dup (int);
extern int __gnat_dup2 (int, int); extern int __gnat_dup2 (int, int);
extern int __gnat_file_exists (char *); extern int __gnat_file_exists (char *);
extern int __gnat_is_regular_file (char *); extern int __gnat_is_regular_file (char *);
extern int __gnat_is_absolute_path (char *,int); extern int __gnat_is_absolute_path (char *,int);
extern int __gnat_is_directory (char *); extern int __gnat_is_directory (char *);
extern int __gnat_is_writable_file (char *); extern int __gnat_is_writable_file (char *);
extern int __gnat_is_readable_file (char *name); 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_non_writable (char *name);
extern void __gnat_set_writable (char *name); extern void __gnat_set_writable (char *name);
extern void __gnat_set_executable (char *name); extern void __gnat_set_executable (char *name);
......
gcc/ada/bcheck.adb
...@@ -190,7 +190,7 @@ package body Bcheck is ...@@ -190,7 +190,7 @@ package body Bcheck is
else else
ALI_Path_Id := 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 Osint.Is_Readonly_Library (ALI_Path_Id) then
if Tolerate_Consistency_Errors then if Tolerate_Consistency_Errors then
Error_Msg ("?{ should be recompiled"); Error_Msg ("?{ should be recompiled");
......
gcc/ada/make.adb
...@@ -106,13 +106,17 @@ package body Make is ...@@ -106,13 +106,17 @@ package body Make is
Full_Source_File : File_Name_Type; Full_Source_File : File_Name_Type;
Lib_File : File_Name_Type; Lib_File : File_Name_Type;
Source_Unit : Unit_Name_Type; Source_Unit : Unit_Name_Type;
Full_Lib_File : File_Name_Type;
Lib_File_Attr : aliased File_Attributes;
Mapping_File : Natural := No_Mapping_File; Mapping_File : Natural := No_Mapping_File;
Project : Project_Id := No_Project; Project : Project_Id := No_Project;
Syntax_Only : Boolean := False;
Output_Is_Object : Boolean := True;
end record; end record;
-- Data recorded for each compilation process spawned -- Data recorded for each compilation process spawned
No_Compilation_Data : constant Compilation_Data :=
(Invalid_Pid, No_File, No_File, No_Unit_Name, No_File, Unknown_Attributes,
No_Mapping_File, No_Project);
type Comp_Data_Arr is array (Positive range <>) of Compilation_Data; type Comp_Data_Arr is array (Positive range <>) of Compilation_Data;
type Comp_Data_Ptr is access Comp_Data_Arr; type Comp_Data_Ptr is access Comp_Data_Arr;
Running_Compile : Comp_Data_Ptr; Running_Compile : Comp_Data_Ptr;
...@@ -741,6 +745,7 @@ package body Make is ...@@ -741,6 +745,7 @@ package body Make is
The_Args : Argument_List; The_Args : Argument_List;
Lib_File : File_Name_Type; Lib_File : File_Name_Type;
Full_Lib_File : File_Name_Type; Full_Lib_File : File_Name_Type;
Lib_File_Attr : access File_Attributes;
Read_Only : Boolean; Read_Only : Boolean;
ALI : out ALI_Id; ALI : out ALI_Id;
O_File : out File_Name_Type; O_File : out File_Name_Type;
...@@ -752,7 +757,9 @@ package body Make is ...@@ -752,7 +757,9 @@ package body Make is
-- up-to-date, then the corresponding source file needs to be recompiled. -- up-to-date, then the corresponding source file needs to be recompiled.
-- In this case ALI = No_ALI_Id. -- In this case ALI = No_ALI_Id.
-- Full_Lib_File must be the result of calling Osint.Full_Lib_File_Name on -- Full_Lib_File must be the result of calling Osint.Full_Lib_File_Name on
-- Lib_File. Precomputing it saves system calls. -- Lib_File. Precomputing it saves system calls. Lib_File_Attr is the
-- initialized attributes of that file, which is also used to save on
-- system calls (it can safely be initialized to Unknown_Attributes).
procedure Check_Linker_Options procedure Check_Linker_Options
(E_Stamp : Time_Stamp_Type; (E_Stamp : Time_Stamp_Type;
...@@ -1418,6 +1425,7 @@ package body Make is ...@@ -1418,6 +1425,7 @@ package body Make is
The_Args : Argument_List; The_Args : Argument_List;
Lib_File : File_Name_Type; Lib_File : File_Name_Type;
Full_Lib_File : File_Name_Type; Full_Lib_File : File_Name_Type;
Lib_File_Attr : access File_Attributes;
Read_Only : Boolean; Read_Only : Boolean;
ALI : out ALI_Id; ALI : out ALI_Id;
O_File : out File_Name_Type; O_File : out File_Name_Type;
...@@ -1577,12 +1585,12 @@ package body Make is ...@@ -1577,12 +1585,12 @@ package body Make is
Check_Object_Consistency; Check_Object_Consistency;
begin begin
Check_Object_Consistency := False; Check_Object_Consistency := False;
Text := Read_Library_Info_From_Full (Full_Lib_File); Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr);
Check_Object_Consistency := Saved_Check_Object_Consistency; Check_Object_Consistency := Saved_Check_Object_Consistency;
end; end;
else else
Text := Read_Library_Info_From_Full (Full_Lib_File); Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr);
end if; end if;
Full_Obj_File := Full_Object_File_Name; Full_Obj_File := Full_Object_File_Name;
...@@ -2418,62 +2426,22 @@ package body Make is ...@@ -2418,62 +2426,22 @@ package body Make is
Initialize_ALI_Data : Boolean := True; Initialize_ALI_Data : Boolean := True;
Max_Process : Positive := 1) Max_Process : Positive := 1)
is is
Source_Unit : Unit_Name_Type; Mfile : Natural := No_Mapping_File;
-- Current source unit Mapping_File_Arg : String_Access;
-- Info on the mapping file
Source_File : File_Name_Type;
-- Current source file
Full_Source_File : File_Name_Type;
-- Full name of the current source file
Lib_File : File_Name_Type;
-- Current library file
Full_Lib_File : File_Name_Type;
-- Full name of the current library file
Obj_File : File_Name_Type;
-- Full name of the object file corresponding to Lib_File
Obj_Stamp : Time_Stamp_Type;
-- Time stamp of the current object file
Sfile : File_Name_Type;
-- Contains the source file of the units withed by Source_File
Uname : Unit_Name_Type;
-- Contains the unit name of the units withed by Source_File
ALI : ALI_Id;
-- ALI Id of the current ALI file
-- Comment following declarations ???
Read_Only : Boolean := False;
Compilation_OK : Boolean;
Need_To_Compile : Boolean;
Pid : Process_Id;
Text : Text_Buffer_Ptr;
Mfile : Natural := No_Mapping_File;
Need_To_Check_Standard_Library : Boolean := Need_To_Check_Standard_Library : Boolean :=
Check_Readonly_Files Check_Readonly_Files
and not Unique_Compile; and not Unique_Compile;
Mapping_File_Arg : String_Access;
Process_Created : Boolean := False;
procedure Add_Process procedure Add_Process
(Pid : Process_Id; (Pid : Process_Id;
Sfile : File_Name_Type; Sfile : File_Name_Type;
Afile : File_Name_Type; Afile : File_Name_Type;
Uname : Unit_Name_Type; Uname : Unit_Name_Type;
Mfile : Natural := No_Mapping_File); Full_Lib_File : File_Name_Type;
Lib_File_Attr : File_Attributes;
Mfile : Natural := No_Mapping_File);
-- Adds process Pid to the current list of outstanding compilation -- Adds process Pid to the current list of outstanding compilation
-- processes and record the full name of the source file Sfile that -- processes and record the full name of the source file Sfile that
-- we are compiling, the name of its library file Afile and the -- we are compiling, the name of its library file Afile and the
...@@ -2482,18 +2450,16 @@ package body Make is ...@@ -2482,18 +2450,16 @@ package body Make is
-- array The_Mapping_File_Names. -- array The_Mapping_File_Names.
procedure Await_Compile procedure Await_Compile
(Sfile : out File_Name_Type; (Data : out Compilation_Data;
Afile : out File_Name_Type;
Uname : out Unit_Name_Type;
OK : out Boolean); OK : out Boolean);
-- Awaits that an outstanding compilation process terminates. When -- Awaits that an outstanding compilation process terminates. When
-- it does set Sfile to the name of the source file that was compiled -- it does set Data to the information registered for the corresponding
-- Afile to the name of its library file and Uname to the name of its -- call to Add_Process.
-- unit. Note that this time stamp can be used to check whether the -- Note that this time stamp can be used to check whether the
-- compilation did generate an object file. OK is set to True if the -- compilation did generate an object file. OK is set to True if the
-- compilation succeeded. Note that Sfile, Afile and Uname could be -- compilation succeeded.
-- resp. No_File, No_File and No_Name if there were no compilations -- Data could be No_Compilation_Data if there was no compilation to wait
-- to wait for. -- for.
function Bad_Compilation_Count return Natural; function Bad_Compilation_Count return Natural;
-- Returns the number of compilation failures -- Returns the number of compilation failures
...@@ -2501,8 +2467,15 @@ package body Make is ...@@ -2501,8 +2467,15 @@ package body Make is
procedure Check_Standard_Library; procedure Check_Standard_Library;
-- Check if s-stalib.adb needs to be compiled -- Check if s-stalib.adb needs to be compiled
procedure Collect_Arguments_And_Compile (Source_Index : Int); procedure Collect_Arguments_And_Compile
-- Collect arguments from project file (if any) and compile (Full_Source_File : File_Name_Type;
Lib_File : File_Name_Type;
Source_Index : Int;
Pid : out Process_Id;
Process_Created : out Boolean);
-- Collect arguments from project file (if any) and compile.
-- If no compilation was attempted, Processed_Created is set to False,
-- and the value of Pid is unknown.
function Compile function Compile
(Project : Project_Id; (Project : Project_Id;
...@@ -2545,16 +2518,41 @@ package body Make is ...@@ -2545,16 +2518,41 @@ package body Make is
procedure Record_Good_ALI (A : ALI_Id); procedure Record_Good_ALI (A : ALI_Id);
-- Records in the previous set the Id of an ALI file -- Records in the previous set the Id of an ALI file
function Must_Exit_Because_Of_Error return Boolean;
-- Return True if there were errors and the user decided to exit in such
-- a case. This waits for any outstanding compilation.
function Start_Compile_If_Possible (Args : Argument_List) return Boolean;
-- Check if there is more work that we can do (i.e. the Queue is non
-- empty). If there is, do it only if we have not yet used up all the
-- available processes.
-- Returns True if we should exit the main loop
procedure Wait_For_Available_Slot;
-- Check if we should wait for a compilation to finish. This is the case
-- if all the available processes are busy compiling sources or there is
-- nothing else to do (that is the Q is empty and there are no good ALIs
-- to process).
procedure Fill_Queue_From_ALI_Files;
-- Check if we recorded good ALI files. If yes process them now in the
-- order in which they have been recorded. There are two occasions in
-- which we record good ali files. The first is in phase 1 when, after
-- scanning an existing ALI file we realize it is up-to-date, the second
-- instance is after a successful compilation.
----------------- -----------------
-- Add_Process -- -- Add_Process --
----------------- -----------------
procedure Add_Process procedure Add_Process
(Pid : Process_Id; (Pid : Process_Id;
Sfile : File_Name_Type; Sfile : File_Name_Type;
Afile : File_Name_Type; Afile : File_Name_Type;
Uname : Unit_Name_Type; Uname : Unit_Name_Type;
Mfile : Natural := No_Mapping_File) Full_Lib_File : File_Name_Type;
Lib_File_Attr : File_Attributes;
Mfile : Natural := No_Mapping_File)
is is
OC1 : constant Positive := Outstanding_Compiles + 1; OC1 : constant Positive := Outstanding_Compiles + 1;
...@@ -2562,14 +2560,15 @@ package body Make is ...@@ -2562,14 +2560,15 @@ package body Make is
pragma Assert (OC1 <= Max_Process); pragma Assert (OC1 <= Max_Process);
pragma Assert (Pid /= Invalid_Pid); pragma Assert (Pid /= Invalid_Pid);
Running_Compile (OC1).Pid := Pid; Running_Compile (OC1) :=
Running_Compile (OC1).Full_Source_File := Sfile; (Pid => Pid,
Running_Compile (OC1).Lib_File := Afile; Full_Source_File => Sfile,
Running_Compile (OC1).Source_Unit := Uname; Lib_File => Afile,
Running_Compile (OC1).Mapping_File := Mfile; Full_Lib_File => Full_Lib_File,
Running_Compile (OC1).Project := Arguments_Project; Lib_File_Attr => Lib_File_Attr,
Running_Compile (OC1).Syntax_Only := Syntax_Only; Source_Unit => Uname,
Running_Compile (OC1).Output_Is_Object := Output_Is_Object; Mapping_File => Mfile,
Project => Arguments_Project);
Outstanding_Compiles := OC1; Outstanding_Compiles := OC1;
end Add_Process; end Add_Process;
...@@ -2579,21 +2578,17 @@ package body Make is ...@@ -2579,21 +2578,17 @@ package body Make is
------------------- -------------------
procedure Await_Compile procedure Await_Compile
(Sfile : out File_Name_Type; (Data : out Compilation_Data;
Afile : out File_Name_Type; OK : out Boolean)
Uname : out Unit_Name_Type;
OK : out Boolean)
is is
Pid : Process_Id; Pid : Process_Id;
Project : Project_Id; Project : Project_Id;
Data : Project_Compilation_Access; Comp_Data : Project_Compilation_Access;
begin begin
pragma Assert (Outstanding_Compiles > 0); pragma Assert (Outstanding_Compiles > 0);
Sfile := No_File; Data := No_Compilation_Data;
Afile := No_File;
Uname := No_Unit_Name;
OK := False; OK := False;
-- The loop here is a work-around for a problem on VMS; in some -- The loop here is a work-around for a problem on VMS; in some
...@@ -2611,21 +2606,19 @@ package body Make is ...@@ -2611,21 +2606,19 @@ package body Make is
for J in Running_Compile'First .. Outstanding_Compiles loop for J in Running_Compile'First .. Outstanding_Compiles loop
if Pid = Running_Compile (J).Pid then if Pid = Running_Compile (J).Pid then
Sfile := Running_Compile (J).Full_Source_File; Data := Running_Compile (J);
Afile := Running_Compile (J).Lib_File;
Uname := Running_Compile (J).Source_Unit;
Syntax_Only := Running_Compile (J).Syntax_Only;
Output_Is_Object := Running_Compile (J).Output_Is_Object;
Project := Running_Compile (J).Project; Project := Running_Compile (J).Project;
-- If a mapping file was used by this compilation, -- If a mapping file was used by this compilation,
-- get its file name for reuse by a subsequent compilation -- get its file name for reuse by a subsequent compilation
if Running_Compile (J).Mapping_File /= No_Mapping_File then if Running_Compile (J).Mapping_File /= No_Mapping_File then
Data := Project_Compilation_Htable.Get Comp_Data := Project_Compilation_Htable.Get
(Project_Compilation, Project); (Project_Compilation, Project);
Data.Last_Free_Indices := Data.Last_Free_Indices + 1; Comp_Data.Last_Free_Indices :=
Data.Free_Mapping_File_Indices (Data.Last_Free_Indices) := Comp_Data.Last_Free_Indices + 1;
Comp_Data.Free_Mapping_File_Indices
(Comp_Data.Last_Free_Indices) :=
Running_Compile (J).Mapping_File; Running_Compile (J).Mapping_File;
end if; end if;
...@@ -2707,11 +2700,13 @@ package body Make is ...@@ -2707,11 +2700,13 @@ package body Make is
-- Collect_Arguments_And_Compile -- -- Collect_Arguments_And_Compile --
----------------------------------- -----------------------------------
procedure Collect_Arguments_And_Compile (Source_Index : Int) is procedure Collect_Arguments_And_Compile
(Full_Source_File : File_Name_Type;
Lib_File : File_Name_Type;
Source_Index : Int;
Pid : out Process_Id;
Process_Created : out Boolean) is
begin begin
-- Process_Created will be set True if an attempt is made to compile
-- the source, that is if it is not in an externally built project.
Process_Created := False; Process_Created := False;
-- If we use mapping file (-P or -C switches), then get one -- If we use mapping file (-P or -C switches), then get one
...@@ -2759,11 +2754,11 @@ package body Make is ...@@ -2759,11 +2754,11 @@ package body Make is
Pid := Pid :=
Compile Compile
(Arguments_Project, (Project => Arguments_Project,
File_Name_Type (Arguments_Path_Name), S => File_Name_Type (Arguments_Path_Name),
Lib_File, L => Lib_File,
Source_Index, Source_Index => Source_Index,
Arguments (1 .. Last_Argument)); Args => Arguments (1 .. Last_Argument));
Process_Created := True; Process_Created := True;
end if; end if;
...@@ -2773,11 +2768,11 @@ package body Make is ...@@ -2773,11 +2768,11 @@ package body Make is
Pid := Pid :=
Compile Compile
(Main_Project, (Project => Main_Project,
Full_Source_File, S => Full_Source_File,
Lib_File, L => Lib_File,
Source_Index, Source_Index => Source_Index,
Arguments (1 .. Last_Argument)); Args => Arguments (1 .. Last_Argument));
Process_Created := True; Process_Created := True;
end if; end if;
end Collect_Arguments_And_Compile; end Collect_Arguments_And_Compile;
...@@ -2994,6 +2989,119 @@ package body Make is ...@@ -2994,6 +2989,119 @@ package body Make is
(Gcc_Path.all, Comp_Args (Args'First .. Comp_Last)); (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
end Compile; end Compile;
-------------------------------
-- Fill_Queue_From_ALI_Files --
-------------------------------
procedure Fill_Queue_From_ALI_Files is
ALI : ALI_Id;
Source_Index : Int;
Sfile : File_Name_Type;
Uname : Unit_Name_Type;
Unit_Name : Name_Id;
Uid : Prj.Unit_Index;
begin
while Good_ALI_Present loop
ALI := Get_Next_Good_ALI;
Source_Index := Unit_Index_Of (ALIs.Table (ALI).Afile);
-- If we are processing the library file corresponding to the
-- main source file check if this source can be a main unit.
if ALIs.Table (ALI).Sfile = Main_Source
and then Source_Index = Main_Index
then
Main_Unit := ALIs.Table (ALI).Main_Program /= None;
end if;
-- The following adds the standard library (s-stalib) to the
-- list of files to be handled by gnatmake: this file and any
-- files it depends on are always included in every bind,
-- even if they are not in the explicit dependency list.
-- Of course, it is not added if Suppress_Standard_Library
-- is True.
-- However, to avoid annoying output about s-stalib.ali being
-- read only, when "-v" is used, we add the standard library
-- only when "-a" is used.
if Need_To_Check_Standard_Library then
Check_Standard_Library;
end if;
-- Now insert in the Q the unmarked source files (i.e. those
-- which have never been inserted in the Q and hence never
-- considered). Only do that if Unique_Compile is False.
if not Unique_Compile then
for J in
ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit
loop
for K in
Units.Table (J).First_With .. Units.Table (J).Last_With
loop
Sfile := Withs.Table (K).Sfile;
Uname := Withs.Table (K).Uname;
-- If project files are used, find the proper source
-- to compile, in case Sfile is the spec, but there
-- is a body.
if Main_Project /= No_Project then
Get_Name_String (Uname);
Name_Len := Name_Len - 2;
Unit_Name := Name_Find;
Uid :=
Units_Htable.Get (Project_Tree.Units_HT, Unit_Name);
if Uid /= Prj.No_Unit_Index then
if Uid.File_Names (Impl) /= null
and then not Uid.File_Names (Impl).Locally_Removed
then
Sfile := Uid.File_Names (Impl).File;
Source_Index := Uid.File_Names (Impl).Index;
elsif Uid.File_Names (Spec) /= null
and then not Uid.File_Names (Spec).Locally_Removed
then
Sfile := Uid.File_Names (Spec).File;
Source_Index := Uid.File_Names (Spec).Index;
end if;
end if;
end if;
Dependencies.Append ((ALIs.Table (ALI).Sfile, Sfile));
if Is_In_Obsoleted (Sfile) then
Executable_Obsolete := True;
end if;
if Sfile = No_File then
Debug_Msg ("Skipping generic:", Withs.Table (K).Uname);
else
Source_Index := Unit_Index_Of (Withs.Table (K).Afile);
if Is_Marked (Sfile, Source_Index) then
Debug_Msg ("Skipping marked file:", Sfile);
elsif not Check_Readonly_Files
and then Is_Internal_File_Name (Sfile, False)
then
Debug_Msg ("Skipping internal file:", Sfile);
else
Insert_Q
(Sfile, Withs.Table (K).Uname, Source_Index);
Mark (Sfile, Source_Index);
end if;
end if;
end loop;
end loop;
end if;
end loop;
end Fill_Queue_From_ALI_Files;
---------------------- ----------------------
-- Get_Mapping_File -- -- Get_Mapping_File --
---------------------- ----------------------
...@@ -3049,6 +3157,29 @@ package body Make is ...@@ -3049,6 +3157,29 @@ package body Make is
return Good_ALI.First <= Good_ALI.Last; return Good_ALI.First <= Good_ALI.Last;
end Good_ALI_Present; end Good_ALI_Present;
--------------------------------
-- Must_Exit_Because_Of_Error --
--------------------------------
function Must_Exit_Because_Of_Error return Boolean is
Data : Compilation_Data;
Success : Boolean;
begin
if Bad_Compilation_Count > 0 and then not Keep_Going then
while Outstanding_Compiles > 0 loop
Await_Compile (Data, Success);
if not Success then
Record_Failure (Data.Full_Source_File, Data.Source_Unit);
end if;
end loop;
return True;
end if;
return False;
end Must_Exit_Because_Of_Error;
-------------------- --------------------
-- Record_Failure -- -- Record_Failure --
-------------------- --------------------
...@@ -3073,295 +3204,284 @@ package body Make is ...@@ -3073,295 +3204,284 @@ package body Make is
Good_ALI.Table (Good_ALI.Last) := A; Good_ALI.Table (Good_ALI.Last) := A;
end Record_Good_ALI; end Record_Good_ALI;
-- Start of processing for Compile_Sources -------------------------------
-- Start_Compile_If_Possible --
begin -------------------------------
pragma Assert (Args'First = 1);
Outstanding_Compiles := 0;
Running_Compile := new Comp_Data_Arr (1 .. Max_Process);
-- Package and Queue initializations
Good_ALI.Init;
if First_Q_Initialization then
Init_Q;
end if;
if Initialize_ALI_Data then function Start_Compile_If_Possible
Initialize_ALI; (Args : Argument_List) return Boolean
Initialize_ALI_Source; is
end if; In_Lib_Dir : Boolean;
Need_To_Compile : Boolean;
-- The following two flags affect the behavior of ALI.Set_Source_Table. Pid : Process_Id;
-- We set Check_Source_Files to True to ensure that source file Process_Created : Boolean;
-- time stamps are checked, and we set All_Sources to False to
-- avoid checking the presence of the source files listed in the Source_File : File_Name_Type;
-- source dependency section of an ali file (which would be a mistake Full_Source_File : File_Name_Type;
-- since the ali file may be obsolete). Source_File_Attr : aliased File_Attributes;
-- The full name of the source file, and its attributes (size,...)
Check_Source_Files := True;
All_Sources := False; Source_Unit : Unit_Name_Type;
Source_Index : Int;
-- Index of the current unit in the current source file
Lib_File : File_Name_Type;
Full_Lib_File : File_Name_Type;
Lib_File_Attr : aliased File_Attributes;
Read_Only : Boolean := False;
ALI : ALI_Id;
-- The ALI file and its attributes (size, stamp,...)
Obj_File : File_Name_Type;
Obj_Stamp : Time_Stamp_Type;
-- The object file
-- Only insert in the Q if it is not already done, to avoid simultaneous begin
-- compilations if -jnnn is used. if not Empty_Q and then Outstanding_Compiles < Max_Process then
Extract_From_Q (Source_File, Source_Unit, Source_Index);
if not Is_Marked (Main_Source, Main_Index) then Osint.Full_Source_Name
Insert_Q (Main_Source, Index => Main_Index); (Source_File,
Mark (Main_Source, Main_Index); Full_File => Full_Source_File,
end if; Attr => Source_File_Attr'Access);
First_Compiled_File := No_File; Lib_File := Osint.Lib_File_Name (Source_File, Source_Index);
Most_Recent_Obj_File := No_File; Osint.Full_Lib_File_Name
Most_Recent_Obj_Stamp := Empty_Time_Stamp; (Lib_File,
Main_Unit := False; Lib_File => Full_Lib_File,
Attr => Lib_File_Attr);
-- Keep looping until there is no more work to do (the Q is empty) -- If this source has already been compiled, the executable is
-- and all the outstanding compilations have terminated -- obsolete.
Make_Loop : while not Empty_Q or else Outstanding_Compiles > 0 loop if Is_In_Obsoleted (Source_File) then
Executable_Obsolete := True;
end if;
-- If the user does not want to keep going in case of errors then In_Lib_Dir := Full_Lib_File /= No_File
-- wait for the remaining outstanding compiles and then exit. and then In_Ada_Lib_Dir (Full_Lib_File);
if Bad_Compilation_Count > 0 and then not Keep_Going then -- Since the following requires a system call, we precompute it
while Outstanding_Compiles > 0 loop -- when needed
Await_Compile
(Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
if not Compilation_OK then if not In_Lib_Dir then
Record_Failure (Full_Source_File, Source_Unit); if Full_Lib_File /= No_File
and then not Check_Readonly_Files
then
Get_Name_String (Full_Lib_File);
Name_Buffer (Name_Len + 1) := ASCII.NUL;
Read_Only := not Is_Writable_File
(Name_Buffer'Address, Lib_File_Attr'Access);
else
Read_Only := False;
end if; end if;
end loop; end if;
exit Make_Loop;
end if;
-- PHASE 1: Check if there is more work that we can do (i.e. the Q
-- is non empty). If there is, do it only if we have not yet used
-- up all the available processes.
if not Empty_Q and then Outstanding_Compiles < Max_Process then
declare
In_Lib_Dir : Boolean;
Source_Index : Int;
-- Index of the current unit in the current source file
begin -- If the library file is an Ada library skip it
Extract_From_Q (Source_File, Source_Unit, Source_Index);
Full_Source_File := Osint.Full_Source_Name (Source_File);
Lib_File := Osint.Lib_File_Name
(Source_File, Source_Index);
-- Compute the location of Lib_File (involves system calls) if In_Lib_Dir then
-- ??? Can we compute at the same time if the file is Verbose_Msg
-- writable, which would save a system call on some systems (Lib_File,
-- (when calling Is_Readonly_Library below) "is in an Ada library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File); -- If the library file is a read-only library skip it, but
-- only if, when using project files, this library file is
-- in the right object directory (a read-only ALI file
-- in the object directory of a project being extended
-- should not be skipped).
-- If this source has already been compiled, the executable is elsif Read_Only
-- obsolete. and then Is_In_Object_Directory (Source_File, Full_Lib_File)
then
Verbose_Msg
(Lib_File,
"is a read-only library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
if Is_In_Obsoleted (Source_File) then -- The source file that we are checking cannot be located
Executable_Obsolete := True;
end if;
In_Lib_Dir := Full_Lib_File /= No_File elsif Full_Source_File = No_File then
and then In_Ada_Lib_Dir (Full_Lib_File); Record_Failure (Source_File, Source_Unit, False);
-- Since the following requires a system call, we precompute it -- Source and library files can be located but are internal
-- when needed -- files
if not In_Lib_Dir then elsif not Check_Readonly_Files
Read_Only := and then Full_Lib_File /= No_File
Full_Lib_File /= No_File and then Is_Internal_File_Name (Source_File, False)
and then not Check_Readonly_Files then
and then Is_Readonly_Library (Full_Lib_File); if Force_Compilations then
Fail
("not allowed to compile """ &
Get_Name_String (Source_File) &
"""; use -a switch, or compile file with " &
"""-gnatg"" switch");
end if; end if;
-- If the library file is an Ada library skip it Verbose_Msg
(Lib_File,
if In_Lib_Dir then "is an internal library",
Verbose_Msg Prefix => " ",
(Lib_File, Minimum_Verbosity => Opt.High);
"is in an Ada library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
-- If the library file is a read-only library skip it, but
-- only if, when using project files, this library file is
-- in the right object directory (a read-only ALI file
-- in the object directory of a project being extended
-- should not be skipped).
elsif Read_Only
and then Is_In_Object_Directory (Source_File, Full_Lib_File)
then
Verbose_Msg
(Lib_File,
"is a read-only library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
-- The source file that we are checking cannot be located -- The source file that we are checking can be located
elsif Full_Source_File = No_File then else
Record_Failure (Source_File, Source_Unit, False); Collect_Arguments (Source_File, Source_Index,
Source_File = Main_Source, Args);
-- Source and library files can be located but are internal -- Do nothing if project of source is externally built
-- files
elsif not Check_Readonly_Files if Arguments_Project = No_Project
and then Full_Lib_File /= No_File or else not Arguments_Project.Externally_Built
and then Is_Internal_File_Name (Source_File, False)
then then
if Force_Compilations then -- Don't waste any time if we have to recompile anyway
Fail
("not allowed to compile """ & Obj_Stamp := Empty_Time_Stamp;
Get_Name_String (Source_File) & Need_To_Compile := Force_Compilations;
"""; use -a switch, or compile file with " &
"""-gnatg"" switch"); if not Force_Compilations then
Check (Source_File => Source_File,
Source_Index => Source_Index,
Is_Main_Source => Source_File = Main_Source,
The_Args => Args,
Lib_File => Lib_File,
Full_Lib_File => Full_Lib_File,
Lib_File_Attr => Lib_File_Attr'Access,
Read_Only => Read_Only,
ALI => ALI,
O_File => Obj_File,
O_Stamp => Obj_Stamp);
Need_To_Compile := (ALI = No_ALI_Id);
end if; end if;
Verbose_Msg if not Need_To_Compile then
(Lib_File, -- The ALI file is up-to-date. Record its Id
"is an internal library",
Prefix => " ",
Minimum_Verbosity => Opt.High);
-- The source file that we are checking can be located
else Record_Good_ALI (ALI);
Collect_Arguments (Source_File, Source_Index,
Source_File = Main_Source, Args);
-- Do nothing if project of source is externally built -- Record the time stamp of the most recent object
-- file as long as no (re)compilations are needed.
if Arguments_Project = No_Project if First_Compiled_File = No_File
or else not Arguments_Project.Externally_Built and then (Most_Recent_Obj_File = No_File
then or else Obj_Stamp > Most_Recent_Obj_Stamp)
-- Don't waste any time if we have to recompile anyway then
Most_Recent_Obj_File := Obj_File;
Obj_Stamp := Empty_Time_Stamp; Most_Recent_Obj_Stamp := Obj_Stamp;
Need_To_Compile := Force_Compilations;
if not Force_Compilations then
Check (Source_File => Source_File,
Source_Index => Source_Index,
Is_Main_Source => Source_File = Main_Source,
The_Args => Args,
Lib_File => Lib_File,
Full_Lib_File => Full_Lib_File,
Read_Only => Read_Only,
ALI => ALI,
O_File => Obj_File,
O_Stamp => Obj_Stamp);
Need_To_Compile := (ALI = No_ALI_Id);
end if; end if;
if not Need_To_Compile then else
-- The ALI file is up-to-date. Record its Id -- Check that switch -x has been used if a source
-- outside of project files need to be compiled.
Record_Good_ALI (ALI);
-- Record the time stamp of the most recent object
-- file as long as no (re)compilations are needed.
if First_Compiled_File = No_File
and then (Most_Recent_Obj_File = No_File
or else Obj_Stamp > Most_Recent_Obj_Stamp)
then
Most_Recent_Obj_File := Obj_File;
Most_Recent_Obj_Stamp := Obj_Stamp;
end if;
else
-- Check that switch -x has been used if a source
-- outside of project files need to be compiled.
if Main_Project /= No_Project if Main_Project /= No_Project
and then Arguments_Project = No_Project and then Arguments_Project = No_Project
and then not External_Unit_Compilation_Allowed and then not External_Unit_Compilation_Allowed
then then
Make_Failed ("external source (" Make_Failed ("external source ("
& Get_Name_String (Source_File) & Get_Name_String (Source_File)
& ") is not part of any project;" & ") is not part of any project;"
& " cannot be compiled without" & " cannot be compiled without"
& " gnatmake switch -x"); & " gnatmake switch -x");
end if; end if;
-- Is this the first file we have to compile? -- Is this the first file we have to compile?
if First_Compiled_File = No_File then if First_Compiled_File = No_File then
First_Compiled_File := Full_Source_File; First_Compiled_File := Full_Source_File;
Most_Recent_Obj_File := No_File; Most_Recent_Obj_File := No_File;
if Do_Not_Execute then if Do_Not_Execute then
exit Make_Loop; -- Exit the main loop
end if; return True;
end if; end if;
end if;
if In_Place_Mode then if In_Place_Mode then
if Full_Lib_File = No_File then
-- If the library file was not found, then save -- If the library file was not found, then save
-- the library file near the source file. -- the library file near the source file.
if Full_Lib_File = No_File then Lib_File := Osint.Lib_File_Name
Lib_File := Osint.Lib_File_Name (Full_Source_File, Source_Index);
(Full_Source_File, Source_Index); Full_Lib_File := Lib_File;
Full_Lib_File := Lib_File;
-- If the library file was found, then save the else
-- library file in the same place. -- If the library file was found, then save the
-- library file in the same place.
else Lib_File := Full_Lib_File;
Lib_File := Full_Lib_File;
end if;
end if; end if;
-- Start the compilation and record it. We can do Lib_File_Attr := Unknown_Attributes;
-- this because there is at least one free process.
Collect_Arguments_And_Compile (Source_Index); else
-- We will recompile, so we'll have to guess the
-- location of the object file based on the command
-- line switches and object_dir
-- Make sure we could successfully start Full_Lib_File := No_File;
-- the Compilation. Lib_File_Attr := Unknown_Attributes;
end if;
if Process_Created then -- Start the compilation and record it. We can do
if Pid = Invalid_Pid then -- this because there is at least one free process.
Record_Failure (Full_Source_File, Source_Unit);
else Collect_Arguments_And_Compile
Add_Process (Full_Source_File => Full_Source_File,
(Pid, Lib_File => Lib_File,
Full_Source_File, Source_Index => Source_Index,
Lib_File, Pid => Pid,
Source_Unit, Process_Created => Process_Created);
Mfile);
end if; -- Make sure we could successfully start
-- the Compilation.
if Process_Created then
if Pid = Invalid_Pid then
Record_Failure (Full_Source_File, Source_Unit);
else
Add_Process
(Pid => Pid,
Sfile => Full_Source_File,
Afile => Lib_File,
Uname => Source_Unit,
Mfile => Mfile,
Full_Lib_File => Full_Lib_File,
Lib_File_Attr => Lib_File_Attr);
end if; end if;
end if; end if;
end if; end if;
end if; end if;
end; end if;
end if; end if;
return False;
end Start_Compile_If_Possible;
-- PHASE 2: Now check if we should wait for a compilation to -----------------------------
-- finish. This is the case if all the available processes are -- Wait_For_Available_Slot --
-- busy compiling sources or there is nothing else to do -----------------------------
-- (that is the Q is empty and there are no good ALIs to process).
procedure Wait_For_Available_Slot is
Compilation_OK : Boolean;
Text : Text_Buffer_Ptr;
ALI : ALI_Id;
Data : Compilation_Data;
begin
if Outstanding_Compiles = Max_Process if Outstanding_Compiles = Max_Process
or else (Empty_Q or else (Empty_Q
and then not Good_ALI_Present and then not Good_ALI_Present
and then Outstanding_Compiles > 0) and then Outstanding_Compiles > 0)
then then
Await_Compile Await_Compile (Data, Compilation_OK);
(Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
if not Compilation_OK then if not Compilation_OK then
Record_Failure (Full_Source_File, Source_Unit); Record_Failure (Data.Full_Source_File, Data.Source_Unit);
end if; end if;
if Compilation_OK or else Keep_Going then if Compilation_OK or else Keep_Going then
...@@ -3382,7 +3502,7 @@ package body Make is ...@@ -3382,7 +3502,7 @@ package body Make is
and Compilation_OK and Compilation_OK
and (Output_Is_Object or Do_Bind_Step); and (Output_Is_Object or Do_Bind_Step);
if Full_Lib_File = No_File then if Data.Full_Lib_File = No_File then
-- Compute the expected location of the ALI file. This -- Compute the expected location of the ALI file. This
-- can be from several places: -- can be from several places:
-- -i => in place mode. In such a case, Full_Lib_File -- -i => in place mode. In such a case, Full_Lib_File
...@@ -3396,14 +3516,21 @@ package body Make is ...@@ -3396,14 +3516,21 @@ package body Make is
if Object_Directory_Path /= null then if Object_Directory_Path /= null then
Name_Len := 0; Name_Len := 0;
Add_Str_To_Name_Buffer (Object_Directory_Path.all); Add_Str_To_Name_Buffer (Object_Directory_Path.all);
Add_Str_To_Name_Buffer (Get_Name_String (Lib_File)); Add_Str_To_Name_Buffer
Full_Lib_File := Name_Find; (Get_Name_String (Data.Lib_File));
Data.Full_Lib_File := Name_Find;
else else
Full_Lib_File := Lib_File; Data.Full_Lib_File := Data.Lib_File;
end if; end if;
-- Invalidate the cache for the attributes, since the
-- file was just created
Data.Lib_File_Attr := Unknown_Attributes;
end if; end if;
Text := Read_Library_Info_From_Full (Full_Lib_File); Text := Read_Library_Info_From_Full
(Data.Full_Lib_File, Data.Lib_File_Attr'Access);
-- Restore Check_Object_Consistency to its initial value -- Restore Check_Object_Consistency to its initial value
...@@ -3417,8 +3544,8 @@ package body Make is ...@@ -3417,8 +3544,8 @@ package body Make is
-- the unit just compiled. -- the unit just compiled.
if Text /= null then if Text /= null then
ALI := ALI := Scan_ALI
Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True); (Data.Lib_File, Text, Ignore_ED => False, Err => True);
if ALI = No_ALI_Id then if ALI = No_ALI_Id then
...@@ -3426,15 +3553,18 @@ package body Make is ...@@ -3426,15 +3553,18 @@ package body Make is
if Compilation_OK then if Compilation_OK then
Inform Inform
(Lib_File, (Data.Lib_File,
"incompatible ALI file, please recompile"); "incompatible ALI file, please recompile");
Record_Failure (Full_Source_File, Source_Unit); Record_Failure
(Data.Full_Source_File, Data.Source_Unit);
end if; end if;
else else
Free (Text);
Record_Good_ALI (ALI); Record_Good_ALI (ALI);
end if; end if;
Free (Text);
-- If we could not read the ALI file that was just generated -- If we could not read the ALI file that was just generated
-- then there could be a problem reading either the ALI or the -- then there could be a problem reading either the ALI or the
-- corresponding object file (if Check_Object_Consistency is -- corresponding object file (if Check_Object_Consistency is
...@@ -3445,137 +3575,71 @@ package body Make is ...@@ -3445,137 +3575,71 @@ package body Make is
else else
if Compilation_OK and not Syntax_Only then if Compilation_OK and not Syntax_Only then
Inform Inform
(Lib_File, (Data.Lib_File,
"WARNING: ALI or object file not found after compile"); "WARNING: ALI or object file not found after compile");
Record_Failure (Full_Source_File, Source_Unit); Record_Failure (Data.Full_Source_File, Data.Source_Unit);
end if; end if;
end if; end if;
end if; end if;
end if; end if;
end Wait_For_Available_Slot;
-- PHASE 3: Check if we recorded good ALI files. If yes process -- Start of processing for Compile_Sources
-- them now in the order in which they have been recorded. There
-- are two occasions in which we record good ali files. The first is
-- in phase 1 when, after scanning an existing ALI file we realize
-- it is up-to-date, the second instance is after a successful
-- compilation.
while Good_ALI_Present loop
ALI := Get_Next_Good_ALI;
declare
Source_Index : Int := Unit_Index_Of (ALIs.Table (ALI).Afile);
begin
-- If we are processing the library file corresponding to the
-- main source file check if this source can be a main unit.
if ALIs.Table (ALI).Sfile = Main_Source and then
Source_Index = Main_Index
then
Main_Unit := ALIs.Table (ALI).Main_Program /= None;
end if;
-- The following adds the standard library (s-stalib) to the begin
-- list of files to be handled by gnatmake: this file and any pragma Assert (Args'First = 1);
-- files it depends on are always included in every bind,
-- even if they are not in the explicit dependency list.
-- Of course, it is not added if Suppress_Standard_Library
-- is True.
-- However, to avoid annoying output about s-stalib.ali being Outstanding_Compiles := 0;
-- read only, when "-v" is used, we add the standard library Running_Compile := new Comp_Data_Arr (1 .. Max_Process);
-- only when "-a" is used.
if Need_To_Check_Standard_Library then -- Package and Queue initializations
Check_Standard_Library;
end if;
-- Now insert in the Q the unmarked source files (i.e. those Good_ALI.Init;
-- which have never been inserted in the Q and hence never
-- considered). Only do that if Unique_Compile is False.
if not Unique_Compile then if First_Q_Initialization then
for J in Init_Q;
ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit end if;
loop
for K in
Units.Table (J).First_With .. Units.Table (J).Last_With
loop
Sfile := Withs.Table (K).Sfile;
Uname := Withs.Table (K).Uname;
-- If project files are used, find the proper source if Initialize_ALI_Data then
-- to compile, in case Sfile is the spec, but there Initialize_ALI;
-- is a body. Initialize_ALI_Source;
end if;
if Main_Project /= No_Project then -- The following two flags affect the behavior of ALI.Set_Source_Table.
declare -- We set Check_Source_Files to True to ensure that source file
Unit_Name : Name_Id; -- time stamps are checked, and we set All_Sources to False to
Uid : Prj.Unit_Index; -- avoid checking the presence of the source files listed in the
-- source dependency section of an ali file (which would be a mistake
-- since the ali file may be obsolete).
begin Check_Source_Files := True;
Get_Name_String (Uname); All_Sources := False;
Name_Len := Name_Len - 2;
Unit_Name := Name_Find;
Uid :=
Units_Htable.Get
(Project_Tree.Units_HT, Unit_Name);
if Uid /= Prj.No_Unit_Index then
if Uid.File_Names (Impl) /= null
and then
not Uid.File_Names (Impl).Locally_Removed
then
Sfile := Uid.File_Names (Impl).File;
Source_Index :=
Uid.File_Names (Impl).Index;
elsif Uid.File_Names (Spec) /= null
and then
not Uid.File_Names (Spec).Locally_Removed
then
Sfile := Uid.File_Names (Spec).File;
Source_Index :=
Uid.File_Names (Spec).Index;
end if;
end if;
end;
end if;
Dependencies.Append ((ALIs.Table (ALI).Sfile, Sfile)); -- Only insert in the Q if it is not already done, to avoid simultaneous
-- compilations if -jnnn is used.
if Is_In_Obsoleted (Sfile) then if not Is_Marked (Main_Source, Main_Index) then
Executable_Obsolete := True; Insert_Q (Main_Source, Index => Main_Index);
end if; Mark (Main_Source, Main_Index);
end if;
if Sfile = No_File then First_Compiled_File := No_File;
Debug_Msg Most_Recent_Obj_File := No_File;
("Skipping generic:", Withs.Table (K).Uname); Most_Recent_Obj_Stamp := Empty_Time_Stamp;
Main_Unit := False;
else -- Keep looping until there is no more work to do (the Q is empty)
Source_Index := -- and all the outstanding compilations have terminated
Unit_Index_Of (Withs.Table (K).Afile);
if Is_Marked (Sfile, Source_Index) then Make_Loop : while not Empty_Q or else Outstanding_Compiles > 0 loop
Debug_Msg ("Skipping marked file:", Sfile); exit Make_Loop when Must_Exit_Because_Of_Error;
exit Make_Loop when Start_Compile_If_Possible (Args);
elsif not Check_Readonly_Files Wait_For_Available_Slot;
and then Is_Internal_File_Name (Sfile, False)
then
Debug_Msg ("Skipping internal file:", Sfile);
else -- ??? Should be done as soon as we add a Good_ALI, wouldn't it avoid
Insert_Q -- the need for a list of good ALI ?
(Sfile, Withs.Table (K).Uname, Source_Index); Fill_Queue_From_ALI_Files;
Mark (Sfile, Source_Index);
end if;
end if;
end loop;
end loop;
end if;
end;
end loop;
if Display_Compilation_Progress then if Display_Compilation_Progress then
Write_Str ("completed "); Write_Str ("completed ");
......
gcc/ada/osint.adb
...@@ -94,16 +94,39 @@ package body Osint is ...@@ -94,16 +94,39 @@ package body Osint is
-- Update the specified path to replace the prefix with the location -- Update the specified path to replace the prefix with the location
-- where GNAT is installed. See the file prefix.c in GCC for details. -- where GNAT is installed. See the file prefix.c in GCC for details.
function Locate_File procedure Locate_File
(N : File_Name_Type; (N : File_Name_Type;
T : File_Type; T : File_Type;
Dir : Natural; Dir : Natural;
Name : String) return File_Name_Type; 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 -- 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 -- index into the Lib_Search_Directories table if T = Library. Otherwise
-- if T = Source, Dir is an index into the Src_Search_Directories table. -- 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 -- Returns the File_Name_Type of the full file name if file found, or
-- No_File if not found. -- 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; function C_String_Length (S : Address) return Integer;
-- Returns length of a C string (zero for a null address) -- Returns length of a C string (zero for a null address)
...@@ -212,18 +235,17 @@ package body Osint is ...@@ -212,18 +235,17 @@ package body Osint is
function File_Hash (F : File_Name_Type) return File_Hash_Num; function File_Hash (F : File_Name_Type) return File_Hash_Num;
-- Compute hash index for use by Simple_HTable -- Compute hash index for use by Simple_HTable
package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable ( type File_Info_Cache is record
Header_Num => File_Hash_Num, File : File_Name_Type;
Element => File_Name_Type, Attr : aliased File_Attributes;
No_Element => No_File, end record;
Key => File_Name_Type, No_File_Info_Cache : constant File_Info_Cache :=
Hash => File_Hash, (No_File, Unknown_Attributes);
Equal => "=");
package File_Stamp_Hash_Table is new GNAT.HTable.Simple_HTable ( package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
Header_Num => File_Hash_Num, Header_Num => File_Hash_Num,
Element => Time_Stamp_Type, Element => File_Info_Cache,
No_Element => Empty_Time_Stamp, No_Element => No_File_Info_Cache,
Key => File_Name_Type, Key => File_Name_Type,
Hash => File_Hash, Hash => File_Hash,
Equal => "="); Equal => "=");
...@@ -959,6 +981,33 @@ package body Osint is ...@@ -959,6 +981,33 @@ package body Osint is
return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length); return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length);
end File_Hash; 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 -- -- File_Stamp --
---------------- ----------------
...@@ -993,6 +1042,22 @@ package body Osint is ...@@ -993,6 +1042,22 @@ package body Osint is
(N : File_Name_Type; (N : File_Name_Type;
T : File_Type) return File_Name_Type T : File_Type) return File_Name_Type
is 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 begin
Get_Name_String (N); Get_Name_String (N);
...@@ -1016,7 +1081,9 @@ package body Osint is ...@@ -1016,7 +1081,9 @@ package body Osint is
(Hostparm.OpenVMS and then (Hostparm.OpenVMS and then
Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg"))) Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
then then
return N; Found := N;
Attr.all := Unknown_Attributes;
return;
-- If we are trying to find the current main file just look in the -- If we are trying to find the current main file just look in the
-- directory where the user said it was. -- directory where the user said it was.
...@@ -1024,7 +1091,8 @@ package body Osint is ...@@ -1024,7 +1091,8 @@ package body Osint is
elsif Look_In_Primary_Directory_For_Current_Main elsif Look_In_Primary_Directory_For_Current_Main
and then Current_Main = N and then Current_Main = N
then 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 -- Otherwise do standard search for source file
...@@ -1042,21 +1110,23 @@ package body Osint is ...@@ -1042,21 +1110,23 @@ package body Osint is
-- return No_File, indicating the file is not a source. -- return No_File, indicating the file is not a source.
if File = Error_File_Name then if File = Error_File_Name then
return No_File; Found := No_File;
else else
return File; Found := File;
end if; end if;
Attr.all := Unknown_Attributes;
return;
end if; end if;
-- First place to look is in the primary directory (i.e. the same -- First place to look is in the primary directory (i.e. the same
-- directory as the source) unless this has been disabled with -I- -- directory as the source) unless this has been disabled with -I-
if Opt.Look_In_Primary_Dir then 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 if Found /= No_File then
return File; return;
end if; end if;
end if; end if;
...@@ -1069,14 +1139,15 @@ package body Osint is ...@@ -1069,14 +1139,15 @@ package body Osint is
end if; end if;
for D in Primary_Directory + 1 .. Last_Dir loop 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 if Found /= No_File then
return File; return;
end if; end if;
end loop; end loop;
return No_File; Attr.all := Unknown_Attributes;
Found := No_File;
end if; end if;
end; end;
end Find_File; end Find_File;
...@@ -1148,9 +1219,28 @@ package body Osint is ...@@ -1148,9 +1219,28 @@ package body Osint is
-- Full_Lib_File_Name -- -- Full_Lib_File_Name --
------------------------ ------------------------
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
-- ??? 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 function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type is
Attr : File_Attributes;
File : File_Name_Type;
begin begin
return Find_File (N, Library); Full_Lib_File_Name (N, File, Attr);
return File;
end Full_Lib_File_Name; end Full_Lib_File_Name;
---------------------------- ----------------------------
...@@ -1189,6 +1279,18 @@ package body Osint is ...@@ -1189,6 +1279,18 @@ package body Osint is
return Smart_Find_File (N, Source); return Smart_Find_File (N, Source);
end Full_Source_Name; 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 -- -- Get_Directory --
------------------- -------------------
...@@ -1470,6 +1572,19 @@ package body Osint is ...@@ -1470,6 +1572,19 @@ package body Osint is
Lib_Search_Directories.Table (Primary_Directory) := new String'(""); Lib_Search_Directories.Table (Primary_Directory) := new String'("");
end Initialize; 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 -- -- Is_Directory_Separator --
---------------------------- ----------------------------
...@@ -1501,6 +1616,71 @@ package body Osint is ...@@ -1501,6 +1616,71 @@ package body Osint is
return not Is_Writable_File (Name_Buffer (1 .. Name_Len)); return not Is_Writable_File (Name_Buffer (1 .. Name_Len));
end Is_Readonly_Library; 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 -- -- Lib_File_Name --
------------------- -------------------
...@@ -1533,11 +1713,13 @@ package body Osint is ...@@ -1533,11 +1713,13 @@ package body Osint is
-- Locate_File -- -- Locate_File --
----------------- -----------------
function Locate_File procedure Locate_File
(N : File_Name_Type; (N : File_Name_Type;
T : File_Type; T : File_Type;
Dir : Natural; Dir : Natural;
Name : String) return File_Name_Type Name : String;
Found : out File_Name_Type;
Attr : access File_Attributes)
is is
Dir_Name : String_Ptr; Dir_Name : String_Ptr;
...@@ -1555,24 +1737,28 @@ package body Osint is ...@@ -1555,24 +1737,28 @@ package body Osint is
end if; end if;
declare declare
Full_Name : String (1 .. Dir_Name'Length + Name'Length); Full_Name : String (1 .. Dir_Name'Length + Name'Length + 1);
begin begin
Full_Name (1 .. Dir_Name'Length) := Dir_Name.all; 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;
Attr.all := Unknown_Attributes;
if not Is_Regular_File (Full_Name) then if not Is_Regular_File (Full_Name'Address, Attr) then
return No_File; Found := No_File;
else else
-- If the file is in the current directory then return N itself -- If the file is in the current directory then return N itself
if Dir_Name'Length = 0 then if Dir_Name'Length = 0 then
return N; Found := N;
else else
Name_Len := Full_Name'Length; Name_Len := Full_Name'Length - 1;
Name_Buffer (1 .. Name_Len) := Full_Name; Name_Buffer (1 .. Name_Len) :=
return Name_Enter; Full_Name (1 .. Full_Name'Last - 1);
Found := Name_Find; -- ??? Was Name_Enter, no obvious reason
end if; end if;
end if; end if;
end; end;
...@@ -1592,11 +1778,13 @@ package body Osint is ...@@ -1592,11 +1778,13 @@ package body Osint is
declare declare
File_Name : constant String := Name_Buffer (1 .. Name_Len); File_Name : constant String := Name_Buffer (1 .. Name_Len);
File : File_Name_Type := No_File; File : File_Name_Type := No_File;
Attr : aliased File_Attributes;
Last_Dir : Natural; Last_Dir : Natural;
begin begin
if Opt.Look_In_Primary_Dir then 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 if File /= No_File and then T = File_Stamp (N) then
return File; return File;
...@@ -1606,7 +1794,7 @@ package body Osint is ...@@ -1606,7 +1794,7 @@ package body Osint is
Last_Dir := Src_Search_Directories.Last; Last_Dir := Src_Search_Directories.Last;
for D in Primary_Directory + 1 .. Last_Dir loop 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 if File /= No_File and then T = File_Stamp (File) then
return File; return File;
...@@ -2110,10 +2298,15 @@ package body Osint is ...@@ -2110,10 +2298,15 @@ package body Osint is
function Read_Library_Info function Read_Library_Info
(Lib_File : File_Name_Type; (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 begin
Find_File (Lib_File, Library, File, Attr'Access);
return Read_Library_Info_From_Full 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); Fatal_Err => Fatal_Err);
end Read_Library_Info; end Read_Library_Info;
...@@ -2123,12 +2316,17 @@ package body Osint is ...@@ -2123,12 +2316,17 @@ package body Osint is
function Read_Library_Info_From_Full function Read_Library_Info_From_Full
(Full_Lib_File : File_Name_Type; (Full_Lib_File : File_Name_Type;
Lib_File_Attr : access File_Attributes;
Fatal_Err : Boolean := False) return Text_Buffer_Ptr Fatal_Err : Boolean := False) return Text_Buffer_Ptr
is is
Lib_FD : File_Descriptor; Lib_FD : File_Descriptor;
-- The file descriptor for the current library file. A negative value -- The file descriptor for the current library file. A negative value
-- indicates failure to open the specified source file. -- 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; Text : Text_Buffer_Ptr;
-- Allocated text buffer -- Allocated text buffer
...@@ -2168,17 +2366,32 @@ package body Osint is ...@@ -2168,17 +2366,32 @@ package body Osint is
end if; end if;
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 -- Check for object file consistency if requested
if Opt.Check_Object_Consistency then 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); Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
if Current_Full_Obj_Stamp (1) = ' ' then if Current_Full_Obj_Stamp (1) = ' ' then
-- When the library is readonly always assume object is consistent -- 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.
Get_Name_String (Current_Full_Lib_Name);
Name_Buffer (Name_Len + 1) := ASCII.NUL;
if Is_Readonly_Library (Current_Full_Lib_Name) then if not Is_Writable_File (Name_Buffer'Address, Lib_File_Attr) then
Current_Full_Obj_Stamp := Current_Full_Lib_Stamp; Current_Full_Obj_Stamp := Current_Full_Lib_Stamp;
elsif Fatal_Err then elsif Fatal_Err then
...@@ -2203,10 +2416,6 @@ package body Osint is ...@@ -2203,10 +2416,6 @@ package body Osint is
-- Read data from the file -- Read data from the file
declare 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; Actual_Len : Integer := 0;
Lo : constant Text_Ptr := 0; Lo : constant Text_Ptr := 0;
...@@ -2482,21 +2691,23 @@ package body Osint is ...@@ -2482,21 +2691,23 @@ package body Osint is
(N : File_Name_Type; (N : File_Name_Type;
T : File_Type) return Time_Stamp_Type T : File_Type) return Time_Stamp_Type
is is
Time_Stamp : Time_Stamp_Type; File : File_Name_Type;
Attr : aliased File_Attributes;
begin begin
if not File_Cache_Enabled then 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; end if;
Time_Stamp := File_Stamp_Hash_Table.Get (N); if File = No_File then
return Empty_Time_Stamp;
if Time_Stamp (1) = ' ' then else
Time_Stamp := File_Stamp (Smart_Find_File (N, T)); Get_Name_String (File);
File_Stamp_Hash_Table.Set (N, Time_Stamp); Name_Buffer (Name_Len + 1) := ASCII.NUL;
return OS_Time_To_GNAT_Time
(File_Time_Stamp (Name_Buffer'Address, Attr'Access));
end if; end if;
return Time_Stamp;
end Smart_File_Stamp; end Smart_File_Stamp;
--------------------- ---------------------
...@@ -2507,21 +2718,38 @@ package body Osint is ...@@ -2507,21 +2718,38 @@ package body Osint is
(N : File_Name_Type; (N : File_Name_Type;
T : File_Type) return File_Name_Type T : File_Type) return File_Name_Type
is is
Full_File_Name : File_Name_Type; File : File_Name_Type;
Attr : File_Attributes;
begin begin
if not File_Cache_Enabled then Smart_Find_File (N, T, File, Attr);
return Find_File (N, T); return File;
end if; end Smart_Find_File;
Full_File_Name := File_Name_Hash_Table.Get (N); ---------------------
-- Smart_Find_File --
---------------------
if Full_File_Name = No_File then procedure Smart_Find_File
Full_File_Name := Find_File (N, T); (N : File_Name_Type;
File_Name_Hash_Table.Set (N, Full_File_Name); T : File_Type;
Found : out File_Name_Type;
Attr : out File_Attributes)
is
Info : File_Info_Cache;
begin
if not File_Cache_Enabled then
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; end if;
return Full_File_Name; Found := Info.File;
Attr := Info.Attr;
end Smart_Find_File; end Smart_Find_File;
---------------------- ----------------------
...@@ -2951,6 +3179,9 @@ package body Osint is ...@@ -2951,6 +3179,9 @@ package body Osint is
-- Package Initialization -- -- Package Initialization --
---------------------------- ----------------------------
procedure Reset_File_Attributes (Attr : System.Address);
pragma Import (C, Reset_File_Attributes, "reset_attributes");
begin begin
Initialization : declare Initialization : declare
...@@ -2966,7 +3197,15 @@ begin ...@@ -2966,7 +3197,15 @@ begin
"__gnat_get_maximum_file_name_length"); "__gnat_get_maximum_file_name_length");
-- Function to get maximum file name length for system -- Function to get maximum file name length for system
Sizeof_File_Attributes : Integer;
pragma Import (C, Sizeof_File_Attributes,
"size_of_file_attributes");
begin begin
pragma Assert (Sizeof_File_Attributes <= File_Attributes_Size);
Reset_File_Attributes (Unknown_Attributes'Address);
Identifier_Character_Set := Get_Default_Identifier_Character_Set; Identifier_Character_Set := Get_Default_Identifier_Character_Set;
Maximum_File_Name_Length := Get_Maximum_File_Name_Length; Maximum_File_Name_Length := Get_Maximum_File_Name_Length;
......
gcc/ada/osint.ads
...@@ -29,6 +29,7 @@ ...@@ -29,6 +29,7 @@
with Namet; use Namet; with Namet; use Namet;
with Types; use Types; with Types; use Types;
with System.Storage_Elements;
with System.OS_Lib; use System.OS_Lib; with System.OS_Lib; use System.OS_Lib;
with System; use System; with System; use System;
...@@ -230,6 +231,47 @@ package Osint is ...@@ -230,6 +231,47 @@ package Osint is
-- this routine called with Name set to "gnat" will return "-lgnat-5.02" -- this routine called with Name set to "gnat" will return "-lgnat-5.02"
-- on UNIX and Windows and -lgnat_5_02 on VMS. -- 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 -- -- Search Dir Routines --
------------------------- -------------------------
...@@ -380,6 +422,10 @@ package Osint is ...@@ -380,6 +422,10 @@ package Osint is
-- using Read_Source_File. Calling this routine entails no source file -- using Read_Source_File. Calling this routine entails no source file
-- directory lookup penalty. -- 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 Full_Source_Name (N : File_Name_Type) return File_Name_Type;
function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_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 -- Returns the full name/time stamp of the source file whose simple name
...@@ -390,6 +436,8 @@ package Osint is ...@@ -390,6 +436,8 @@ package Osint is
-- The source file directory lookup penalty is incurred every single time -- The source file directory lookup penalty is incurred every single time
-- the routines are called unless you have previously called -- the routines are called unless you have previously called
-- Source_File_Data (Cache => True). See below. -- 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; function Current_File_Index return Int;
-- Return the index in its source file of the current main unit -- Return the index in its source file of the current main unit
...@@ -488,10 +536,14 @@ package Osint is ...@@ -488,10 +536,14 @@ package Osint is
function Read_Library_Info_From_Full function Read_Library_Info_From_Full
(Full_Lib_File : File_Name_Type; (Full_Lib_File : File_Name_Type;
Lib_File_Attr : access File_Attributes;
Fatal_Err : Boolean := False) return Text_Buffer_Ptr; Fatal_Err : Boolean := False) return Text_Buffer_Ptr;
-- Same as Read_Library_Info, except Full_Lib_File must contains the full -- 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 -- 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_Library_Info_Name return File_Name_Type;
function Full_Object_File_Name return File_Name_Type; function Full_Object_File_Name return File_Name_Type;
...@@ -508,6 +560,10 @@ package Osint is ...@@ -508,6 +560,10 @@ package Osint is
-- It is an error to call Current_Object_File_Stamp if -- It is an error to call Current_Object_File_Stamp if
-- Opt.Check_Object_Consistency is set to False. -- 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 Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type;
-- Returns the full name of library file N. N should not include -- 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 -- path information. Note that if the file cannot be located No_File is
...@@ -515,6 +571,8 @@ package Osint is ...@@ -515,6 +571,8 @@ package Osint is
-- for the second (this is not an error situation). The full name includes -- for the second (this is not an error situation). The full name includes
-- the appropriate directory information. The library file directory lookup -- the appropriate directory information. The library file directory lookup
-- penalty is incurred every single time this routine is called. -- 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 function Lib_File_Name
(Source_File : File_Name_Type; (Source_File : File_Name_Type;
...@@ -660,4 +718,18 @@ private ...@@ -660,4 +718,18 @@ private
-- detected, the file being written is deleted, and a fatal error is -- detected, the file being written is deleted, and a fatal error is
-- signalled. -- 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; end Osint;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment