+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
#endif
+/* Used for Ada bindings */
+const int size_of_file_attributes = sizeof (struct file_attributes);
+
+/* Reset the file attributes as if no system call had been performed */
+void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
+
/* The __gnat_max_path_len variable is used to export the maximum
length of a path name to Ada code. max_path_len is also provided
for compatibility with older GNAT versions, please do not use
#define MAYBE_TO_PTR32(argv) argv
#endif
+void
+reset_attributes
+ (struct file_attributes* attr)
+{
+ attr->exists = -1;
+
+ attr->writable = -1;
+ attr->readable = -1;
+ attr->executable = -1;
+
+ attr->regular = -1;
+ attr->symbolic_link = -1;
+ attr->directory = -1;
+
+ attr->timestamp = (OS_Time)-2;
+ attr->file_length = -1;
+}
+
OS_Time
__gnat_current_time
(void)
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
-__gnat_file_length (int fd)
+void
+__gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
{
- int ret;
GNAT_STRUCT_STAT statbuf;
+ int ret;
- ret = GNAT_FSTAT (fd, &statbuf);
- if (ret || !S_ISREG (statbuf.st_mode))
- return 0;
+ if (fd != -1)
+ ret = GNAT_FSTAT (fd, &statbuf);
+ else
+ ret = __gnat_stat (name, &statbuf);
+
+ attr->regular = (!ret && S_ISREG (statbuf.st_mode));
+ attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
- /* 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. */
+ if (!attr->regular)
+ attr->file_length = 0;
+ else
+ /* st_size may be 32 bits, or 64 bits which is converted to long. We
+ don't return a useful value for files larger than 2 gigabytes in
+ either case. */
+ attr->file_length = statbuf.st_size; /* all systems */
+
+#ifndef __MINGW32__
+ /* on Windows requires extra system call, see comment in __gnat_file_exists_attr */
+ attr->exists = !ret;
+#endif
+
+#if !defined (_WIN32) || defined (RTX)
+ /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
+ attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
+ attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
+ attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
+#endif
+
+#if !defined (__EMX__) && !defined (MSDOS) && (!defined (_WIN32) || defined (RTX))
+ /* on Windows requires extra system call, see __gnat_file_time_name_attr */
+ if (ret != 0) {
+ attr->timestamp = (OS_Time)-1;
+ } else {
+#ifdef VMS
+ /* VMS has file versioning. */
+ attr->timestamp = (OS_Time)statbuf.st_ctime;
+#else
+ attr->timestamp = (OS_Time)statbuf.st_mtime;
+#endif
+ }
+#endif
- return (statbuf.st_size);
}
-/* Return the number of bytes in the specified named file. */
+/****************************************************************
+ ** Return the number of bytes in the specified file
+ ****************************************************************/
long
-__gnat_named_file_length (char *name)
+__gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
{
- int ret;
- GNAT_STRUCT_STAT statbuf;
+ if (attr->file_length == -1) {
+ __gnat_stat_to_attr (fd, name, attr);
+ }
- ret = __gnat_stat (name, &statbuf);
- if (ret || !S_ISREG (statbuf.st_mode))
- return 0;
+ return attr->file_length;
+}
- /* 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. */
+long
+__gnat_file_length (int fd)
+{
+ 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
/* Return a GNAT time stamp given a file name. */
OS_Time
-__gnat_file_time_name (char *name)
+__gnat_file_time_name_attr (char* name, struct file_attributes* attr)
{
-
+ if (attr->timestamp == (OS_Time)-2) {
#if defined (__EMX__) || defined (MSDOS)
- int fd = open (name, O_RDONLY | O_BINARY);
- time_t ret = __gnat_file_time_fd (fd);
- close (fd);
- return (OS_Time)ret;
+ int fd = open (name, O_RDONLY | O_BINARY);
+ time_t ret = __gnat_file_time_fd (fd);
+ close (fd);
+ attr->timestamp = (OS_Time)ret;
#elif defined (_WIN32) && !defined (RTX)
- time_t ret = -1;
- TCHAR wname[GNAT_MAX_PATH_LEN];
-
- S2WSC (wname, name, GNAT_MAX_PATH_LEN);
+ time_t ret = -1;
+ TCHAR wname[GNAT_MAX_PATH_LEN];
+ S2WSC (wname, name, GNAT_MAX_PATH_LEN);
- HANDLE h = CreateFile
- (wname, GENERIC_READ, FILE_SHARE_READ, 0,
- OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
+ HANDLE h = CreateFile
+ (wname, GENERIC_READ, FILE_SHARE_READ, 0,
+ OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
- if (h != INVALID_HANDLE_VALUE)
- {
- ret = win32_filetime (h);
- CloseHandle (h);
- }
- return (OS_Time) ret;
-#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;
+ if (h != INVALID_HANDLE_VALUE) {
+ ret = win32_filetime (h);
+ CloseHandle (h);
+ }
+ attr->timestamp = (OS_Time) ret;
#else
- return (OS_Time)statbuf.st_mtime;
+ __gnat_stat_to_attr (-1, name, attr);
#endif
}
-#endif
+ return attr->timestamp;
+}
+
+OS_Time
+__gnat_file_time_name (char *name)
+{
+ struct file_attributes attr;
+ reset_attributes (&attr);
+ return __gnat_file_time_name_attr (name, &attr);
}
/* Return a GNAT time stamp given a file descriptor. */
OS_Time
-__gnat_file_time_fd (int fd)
+__gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
{
- /* The following workaround code is due to the fact that under EMX and
- DJGPP fstat attempts to convert time values to GMT rather than keep the
- actual OS timestamp of the file. By using the OS2/DOS functions directly
- the GNAT timestamp are independent of this behavior, which is desired to
- facilitate the distribution of GNAT compiled libraries. */
+ if (attr->timestamp == (OS_Time)-2) {
+ /* The following workaround code is due to the fact that under EMX and
+ DJGPP fstat attempts to convert time values to GMT rather than keep the
+ actual OS timestamp of the file. By using the OS2/DOS functions directly
+ the GNAT timestamp are independent of this behavior, which is desired to
+ facilitate the distribution of GNAT compiled libraries. */
#if defined (__EMX__) || defined (MSDOS)
#ifdef __EMX__
- FILESTATUS fs;
- int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
- sizeof (FILESTATUS));
+ FILESTATUS fs;
+ int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
+ sizeof (FILESTATUS));
- unsigned file_year = fs.fdateLastWrite.year;
- unsigned file_month = fs.fdateLastWrite.month;
- unsigned file_day = fs.fdateLastWrite.day;
- unsigned file_hour = fs.ftimeLastWrite.hours;
- unsigned file_min = fs.ftimeLastWrite.minutes;
- unsigned file_tsec = fs.ftimeLastWrite.twosecs;
+ unsigned file_year = fs.fdateLastWrite.year;
+ unsigned file_month = fs.fdateLastWrite.month;
+ unsigned file_day = fs.fdateLastWrite.day;
+ unsigned file_hour = fs.ftimeLastWrite.hours;
+ unsigned file_min = fs.ftimeLastWrite.minutes;
+ unsigned file_tsec = fs.ftimeLastWrite.twosecs;
#else
- struct ftime fs;
- int ret = getftime (fd, &fs);
+ struct ftime fs;
+ int ret = getftime (fd, &fs);
- unsigned file_year = fs.ft_year;
- unsigned file_month = fs.ft_month;
- unsigned file_day = fs.ft_day;
- unsigned file_hour = fs.ft_hour;
- unsigned file_min = fs.ft_min;
- unsigned file_tsec = fs.ft_tsec;
+ unsigned file_year = fs.ft_year;
+ unsigned file_month = fs.ft_month;
+ unsigned file_day = fs.ft_day;
+ unsigned file_hour = fs.ft_hour;
+ unsigned file_min = fs.ft_min;
+ unsigned file_tsec = fs.ft_tsec;
#endif
- /* Calculate the seconds since epoch from the time components. First count
- the whole days passed. The value for years returned by the DOS and OS2
- functions count years from 1980, so to compensate for the UNIX epoch which
- begins in 1970 start with 10 years worth of days and add days for each
- four year period since then. */
+ /* Calculate the seconds since epoch from the time components. First count
+ the whole days passed. The value for years returned by the DOS and OS2
+ functions count years from 1980, so to compensate for the UNIX epoch which
+ begins in 1970 start with 10 years worth of days and add days for each
+ four year period since then. */
- time_t tot_secs;
- int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
- int days_passed = 3652 + (file_year / 4) * 1461;
- int years_since_leap = file_year % 4;
+ time_t tot_secs;
+ int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
+ int days_passed = 3652 + (file_year / 4) * 1461;
+ int years_since_leap = file_year % 4;
- if (years_since_leap == 1)
- days_passed += 366;
- else if (years_since_leap == 2)
- days_passed += 731;
- else if (years_since_leap == 3)
- days_passed += 1096;
+ if (years_since_leap == 1)
+ days_passed += 366;
+ else if (years_since_leap == 2)
+ days_passed += 731;
+ else if (years_since_leap == 3)
+ days_passed += 1096;
- if (file_year > 20)
- days_passed -= 1;
+ if (file_year > 20)
+ days_passed -= 1;
- days_passed += cum_days[file_month - 1];
- if (years_since_leap == 0 && file_year != 20 && file_month > 2)
- days_passed++;
+ days_passed += cum_days[file_month - 1];
+ if (years_since_leap == 0 && file_year != 20 && file_month > 2)
+ days_passed++;
- days_passed += file_day - 1;
+ days_passed += file_day - 1;
- /* OK - have whole days. Multiply -- then add in other parts. */
+ /* OK - have whole days. Multiply -- then add in other parts. */
- tot_secs = days_passed * 86400;
- tot_secs += file_hour * 3600;
- tot_secs += file_min * 60;
- tot_secs += file_tsec * 2;
- return (OS_Time) tot_secs;
+ tot_secs = days_passed * 86400;
+ tot_secs += file_hour * 3600;
+ tot_secs += file_min * 60;
+ tot_secs += file_tsec * 2;
+ attr->timestamp = (OS_Time) tot_secs;
#elif defined (_WIN32) && !defined (RTX)
- HANDLE h = (HANDLE) _get_osfhandle (fd);
- time_t ret = win32_filetime (h);
- return (OS_Time) ret;
+ HANDLE h = (HANDLE) _get_osfhandle (fd);
+ time_t ret = win32_filetime (h);
+ attr->timestamp = (OS_Time) ret;
#else
- GNAT_STRUCT_STAT statbuf;
-
- 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
- }
+ __gnat_stat_to_attr (fd, NULL, attr);
#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. */
#endif
}
+/*************************************************************************
+ ** Check whether a file exists
+ *************************************************************************/
+
int
-__gnat_file_exists (char *name)
+__gnat_file_exists_attr (char* name, struct file_attributes* attr)
{
+ if (attr->exists == -1) {
#ifdef __MINGW32__
- /* On Windows do not use __gnat_stat() because a bug in Microsoft
- _stat() routine. When the system time-zone is set with a negative
- offset the _stat() routine fails on specific files like CON: */
- TCHAR wname [GNAT_MAX_PATH_LEN + 2];
-
- S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
- return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
+ /* On Windows do not use __gnat_stat() because of a bug in Microsoft
+ _stat() routine. When the system time-zone is set with a negative
+ offset the _stat() routine fails on specific files like CON: */
+ TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+ S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+ attr->exists = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
- GNAT_STRUCT_STAT statbuf;
-
- return !__gnat_stat (name, &statbuf);
+ __gnat_stat_to_attr (-1, name, attr);
#endif
+ }
+
+ return attr->exists;
}
+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)
{
#endif
}
+int
+__gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
+{
+ if (attr->regular == -1) {
+ __gnat_stat_to_attr (-1, name, attr);
+ }
+
+ return attr->regular;
+}
+
int
__gnat_is_regular_file (char *name)
{
- int ret;
- GNAT_STRUCT_STAT statbuf;
+ struct file_attributes attr;
+ reset_attributes (&attr);
+ return __gnat_is_regular_file_attr (name, &attr);
+}
- ret = __gnat_stat (name, &statbuf);
- return (!ret && S_ISREG (statbuf.st_mode));
+int
+__gnat_is_directory_attr (char* name, struct file_attributes* attr)
+{
+ if (attr->directory == -1) {
+ __gnat_stat_to_attr (-1, name, attr);
+ }
+
+ return attr->directory;
}
int
__gnat_is_directory (char *name)
{
- int ret;
- GNAT_STRUCT_STAT statbuf;
-
- ret = __gnat_stat (name, &statbuf);
- return (!ret && S_ISDIR (statbuf.st_mode));
+ struct file_attributes attr;
+ reset_attributes (&attr);
+ return __gnat_is_directory_attr (name, &attr);
}
#if defined (_WIN32) && !defined (RTX)
#endif /* defined (_WIN32) && !defined (RTX) */
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)
- TCHAR wname [GNAT_MAX_PATH_LEN + 2];
- GENERIC_MAPPING GenericMapping;
-
- S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+ TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+ GENERIC_MAPPING GenericMapping;
- if (__gnat_can_use_acl (wname))
- {
- 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;
+ S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+ if (__gnat_can_use_acl (wname))
+ {
+ ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+ GenericMapping.GenericRead = GENERIC_READ;
+ attr->readable = __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
+ }
+ else
+ attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
- int ret;
- int mode;
- GNAT_STRUCT_STAT statbuf;
-
- ret = GNAT_STAT (name, &statbuf);
- mode = statbuf.st_mode & S_IRUSR;
- return (!ret && mode);
+ __gnat_stat_to_attr (-1, name, attr);
#endif
+ }
+
+ return attr->readable;
}
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)
- TCHAR wname [GNAT_MAX_PATH_LEN + 2];
- GENERIC_MAPPING GenericMapping;
+ TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+ GENERIC_MAPPING GenericMapping;
- S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+ S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
- if (__gnat_can_use_acl (wname))
- {
- ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
- GenericMapping.GenericWrite = GENERIC_WRITE;
+ if (__gnat_can_use_acl (wname))
+ {
+ ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+ GenericMapping.GenericWrite = GENERIC_WRITE;
- return __gnat_check_OWNER_ACL
- (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
- && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
- }
- else
- return !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
+ attr->writable = __gnat_check_OWNER_ACL
+ (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
+ && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
+ }
+ else
+ attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
#else
- int ret;
- int mode;
- GNAT_STRUCT_STAT statbuf;
-
- ret = GNAT_STAT (name, &statbuf);
- mode = statbuf.st_mode & S_IWUSR;
- return (!ret && mode);
+ __gnat_stat_to_attr (-1, name, attr);
#endif
+ }
+
+ return attr->writable;
}
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)
- TCHAR wname [GNAT_MAX_PATH_LEN + 2];
- GENERIC_MAPPING GenericMapping;
+ TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+ GENERIC_MAPPING GenericMapping;
- S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+ S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
- if (__gnat_can_use_acl (wname))
- {
- ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
- GenericMapping.GenericExecute = GENERIC_EXECUTE;
+ if (__gnat_can_use_acl (wname))
+ {
+ ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+ GenericMapping.GenericExecute = GENERIC_EXECUTE;
- return __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
- }
- else
- return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
- && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
+ attr->executable = __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
+ }
+ else
+ attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
+ && _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
#else
- int ret;
- int mode;
- GNAT_STRUCT_STAT statbuf;
-
- ret = GNAT_STAT (name, &statbuf);
- mode = statbuf.st_mode & S_IXUSR;
- return (!ret && mode);
+ __gnat_stat_to_attr (-1, name, attr);
#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
}
int
-__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
+__gnat_is_symbolic_link_attr (char* name, struct file_attributes* attr)
{
+ if (attr->symbolic_link == -1) {
#if defined (__vxworks) || defined (__nucleus__)
- return 0;
+ attr->symbolic_link = 0;
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
- int ret;
- GNAT_STRUCT_STAT statbuf;
-
- ret = GNAT_LSTAT (name, &statbuf);
- return (!ret && S_ISLNK (statbuf.st_mode));
-
+ int ret;
+ GNAT_STRUCT_STAT statbuf;
+ ret = GNAT_LSTAT (name, &statbuf);
+ attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
#else
- return 0;
+ attr->symbolic_link = 0;
#endif
+ }
+ return attr->symbolic_link;
+}
+
+int
+__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
+{
+ struct file_attributes attr;
+ reset_attributes (&attr);
+ return __gnat_is_symbolic_link_attr (name, &attr);
+
}
#if defined (sun) && defined (__SVR4)
typedef long OS_Time;
#endif
+/* A lazy cache for the attributes of a file. On some systems, a single call to
+ stat() will give all this information, so it is better than doing a system
+ call every time. On other systems this require several system calls.
+*/
+
+struct file_attributes {
+ short exists;
+
+ short writable;
+ short readable;
+ short executable;
+
+ short symbolic_link;
+ short regular;
+ short directory;
+
+ OS_Time timestamp;
+ long file_length;
+};
+/* WARNING: changing the size here might require changing the constant
+ * File_Attributes_Size in osint.ads (which should be big enough to
+ * fit the above struct on any system)
+ */
+
extern int __gnat_max_path_len;
extern OS_Time __gnat_current_time (void);
extern void __gnat_current_time_string (char *);
extern void __gnat_set_file_time_name (char *, time_t);
-extern int __gnat_dup (int);
-extern int __gnat_dup2 (int, int);
-extern int __gnat_file_exists (char *);
-extern int __gnat_is_regular_file (char *);
-extern int __gnat_is_absolute_path (char *,int);
-extern int __gnat_is_directory (char *);
+extern int __gnat_dup (int);
+extern int __gnat_dup2 (int, int);
+extern int __gnat_file_exists (char *);
+extern int __gnat_is_regular_file (char *);
+extern int __gnat_is_absolute_path (char *,int);
+extern int __gnat_is_directory (char *);
extern int __gnat_is_writable_file (char *);
extern int __gnat_is_readable_file (char *name);
-extern int __gnat_is_executable_file (char *name);
+extern int __gnat_is_executable_file (char *name);
+
+extern void reset_attributes (struct file_attributes* attr);
+extern long __gnat_file_length_attr (int, char *, struct file_attributes *);
+extern OS_Time __gnat_file_time_name_attr (char *, struct file_attributes *);
+extern OS_Time __gnat_file_time_fd_attr (int, struct file_attributes *);
+extern int __gnat_file_exists_attr (char *, struct file_attributes *);
+extern int __gnat_is_regular_file_attr (char *, struct file_attributes *);
+extern int __gnat_is_directory_attr (char *, struct file_attributes *);
+extern int __gnat_is_readable_file_attr (char *, struct file_attributes *);
+extern int __gnat_is_writable_file_attr (char *, struct file_attributes *);
+extern int __gnat_is_executable_file_attr (char *, struct file_attributes *);
+extern int __gnat_is_symbolic_link_attr (char *, struct file_attributes *);
+
extern void __gnat_set_non_writable (char *name);
extern void __gnat_set_writable (char *name);
extern void __gnat_set_executable (char *name);
else
ALI_Path_Id :=
- Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
+ Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
if Osint.Is_Readonly_Library (ALI_Path_Id) then
if Tolerate_Consistency_Errors then
Error_Msg ("?{ should be recompiled");
Full_Source_File : File_Name_Type;
Lib_File : File_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;
Project : Project_Id := No_Project;
- Syntax_Only : Boolean := False;
- Output_Is_Object : Boolean := True;
end record;
-- 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_Ptr is access Comp_Data_Arr;
Running_Compile : Comp_Data_Ptr;
The_Args : Argument_List;
Lib_File : File_Name_Type;
Full_Lib_File : File_Name_Type;
+ Lib_File_Attr : access File_Attributes;
Read_Only : Boolean;
ALI : out ALI_Id;
O_File : out File_Name_Type;
-- up-to-date, then the corresponding source file needs to be recompiled.
-- In this case ALI = No_ALI_Id.
-- 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
(E_Stamp : Time_Stamp_Type;
The_Args : Argument_List;
Lib_File : File_Name_Type;
Full_Lib_File : File_Name_Type;
+ Lib_File_Attr : access File_Attributes;
Read_Only : Boolean;
ALI : out ALI_Id;
O_File : out File_Name_Type;
Check_Object_Consistency;
begin
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;
end;
else
- Text := Read_Library_Info_From_Full (Full_Lib_File);
+ Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr);
end if;
Full_Obj_File := Full_Object_File_Name;
Initialize_ALI_Data : Boolean := True;
Max_Process : Positive := 1)
is
- Source_Unit : Unit_Name_Type;
- -- Current source unit
-
- 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;
+ Mfile : Natural := No_Mapping_File;
+ Mapping_File_Arg : String_Access;
+ -- Info on the mapping file
Need_To_Check_Standard_Library : Boolean :=
Check_Readonly_Files
and not Unique_Compile;
- Mapping_File_Arg : String_Access;
-
- Process_Created : Boolean := False;
-
procedure Add_Process
- (Pid : Process_Id;
- Sfile : File_Name_Type;
- Afile : File_Name_Type;
- Uname : Unit_Name_Type;
- Mfile : Natural := No_Mapping_File);
+ (Pid : Process_Id;
+ Sfile : File_Name_Type;
+ Afile : File_Name_Type;
+ Uname : Unit_Name_Type;
+ 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
-- processes and record the full name of the source file Sfile that
-- we are compiling, the name of its library file Afile and the
-- array The_Mapping_File_Names.
procedure Await_Compile
- (Sfile : out File_Name_Type;
- Afile : out File_Name_Type;
- Uname : out Unit_Name_Type;
+ (Data : out Compilation_Data;
OK : out Boolean);
-- Awaits that an outstanding compilation process terminates. When
- -- it does set Sfile to the name of the source file that was compiled
- -- Afile to the name of its library file and Uname to the name of its
- -- unit. Note that this time stamp can be used to check whether the
+ -- it does set Data to the information registered for the corresponding
+ -- call to Add_Process.
+ -- 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 succeeded. Note that Sfile, Afile and Uname could be
- -- resp. No_File, No_File and No_Name if there were no compilations
- -- to wait for.
+ -- compilation succeeded.
+ -- Data could be No_Compilation_Data if there was no compilation to wait
+ -- for.
function Bad_Compilation_Count return Natural;
-- Returns the number of compilation failures
procedure Check_Standard_Library;
-- Check if s-stalib.adb needs to be compiled
- procedure Collect_Arguments_And_Compile (Source_Index : Int);
- -- Collect arguments from project file (if any) and compile
+ 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);
+ -- 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
(Project : Project_Id;
procedure Record_Good_ALI (A : ALI_Id);
-- 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 --
-----------------
procedure Add_Process
- (Pid : Process_Id;
- Sfile : File_Name_Type;
- Afile : File_Name_Type;
- Uname : Unit_Name_Type;
- Mfile : Natural := No_Mapping_File)
+ (Pid : Process_Id;
+ Sfile : File_Name_Type;
+ Afile : File_Name_Type;
+ Uname : Unit_Name_Type;
+ Full_Lib_File : File_Name_Type;
+ Lib_File_Attr : File_Attributes;
+ Mfile : Natural := No_Mapping_File)
is
OC1 : constant Positive := Outstanding_Compiles + 1;
pragma Assert (OC1 <= Max_Process);
pragma Assert (Pid /= Invalid_Pid);
- Running_Compile (OC1).Pid := Pid;
- Running_Compile (OC1).Full_Source_File := Sfile;
- Running_Compile (OC1).Lib_File := Afile;
- Running_Compile (OC1).Source_Unit := Uname;
- Running_Compile (OC1).Mapping_File := Mfile;
- Running_Compile (OC1).Project := Arguments_Project;
- Running_Compile (OC1).Syntax_Only := Syntax_Only;
- Running_Compile (OC1).Output_Is_Object := Output_Is_Object;
+ Running_Compile (OC1) :=
+ (Pid => Pid,
+ Full_Source_File => Sfile,
+ Lib_File => Afile,
+ Full_Lib_File => Full_Lib_File,
+ Lib_File_Attr => Lib_File_Attr,
+ Source_Unit => Uname,
+ Mapping_File => Mfile,
+ Project => Arguments_Project);
Outstanding_Compiles := OC1;
end Add_Process;
-------------------
procedure Await_Compile
- (Sfile : out File_Name_Type;
- Afile : out File_Name_Type;
- Uname : out Unit_Name_Type;
- OK : out Boolean)
+ (Data : out Compilation_Data;
+ OK : out Boolean)
is
Pid : Process_Id;
Project : Project_Id;
- Data : Project_Compilation_Access;
+ Comp_Data : Project_Compilation_Access;
begin
pragma Assert (Outstanding_Compiles > 0);
- Sfile := No_File;
- Afile := No_File;
- Uname := No_Unit_Name;
+ Data := No_Compilation_Data;
OK := False;
-- The loop here is a work-around for a problem on VMS; in some
for J in Running_Compile'First .. Outstanding_Compiles loop
if Pid = Running_Compile (J).Pid then
- Sfile := Running_Compile (J).Full_Source_File;
- 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;
+ Data := Running_Compile (J);
Project := Running_Compile (J).Project;
-- If a mapping file was used by this compilation,
-- get its file name for reuse by a subsequent compilation
if Running_Compile (J).Mapping_File /= No_Mapping_File then
- Data := Project_Compilation_Htable.Get
+ Comp_Data := Project_Compilation_Htable.Get
(Project_Compilation, Project);
- Data.Last_Free_Indices := Data.Last_Free_Indices + 1;
- Data.Free_Mapping_File_Indices (Data.Last_Free_Indices) :=
+ Comp_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;
end if;
-- 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
- -- 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;
-- If we use mapping file (-P or -C switches), then get one
Pid :=
Compile
- (Arguments_Project,
- File_Name_Type (Arguments_Path_Name),
- Lib_File,
- Source_Index,
- Arguments (1 .. Last_Argument));
+ (Project => Arguments_Project,
+ S => File_Name_Type (Arguments_Path_Name),
+ L => Lib_File,
+ Source_Index => Source_Index,
+ Args => Arguments (1 .. Last_Argument));
Process_Created := True;
end if;
Pid :=
Compile
- (Main_Project,
- Full_Source_File,
- Lib_File,
- Source_Index,
- Arguments (1 .. Last_Argument));
+ (Project => Main_Project,
+ S => Full_Source_File,
+ L => Lib_File,
+ Source_Index => Source_Index,
+ Args => Arguments (1 .. Last_Argument));
Process_Created := True;
end if;
end Collect_Arguments_And_Compile;
(Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
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 --
----------------------
return Good_ALI.First <= Good_ALI.Last;
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 --
--------------------
Good_ALI.Table (Good_ALI.Last) := A;
end Record_Good_ALI;
- -- Start of processing for Compile_Sources
-
- 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;
+ -------------------------------
+ -- Start_Compile_If_Possible --
+ -------------------------------
- if Initialize_ALI_Data then
- Initialize_ALI;
- Initialize_ALI_Source;
- end if;
-
- -- The following two flags affect the behavior of ALI.Set_Source_Table.
- -- We set Check_Source_Files to True to ensure that source file
- -- time stamps are checked, and we set All_Sources to False to
- -- 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).
-
- Check_Source_Files := True;
- All_Sources := False;
+ function Start_Compile_If_Possible
+ (Args : Argument_List) return Boolean
+ is
+ In_Lib_Dir : Boolean;
+ Need_To_Compile : Boolean;
+ Pid : Process_Id;
+ Process_Created : Boolean;
+
+ Source_File : File_Name_Type;
+ Full_Source_File : File_Name_Type;
+ Source_File_Attr : aliased File_Attributes;
+ -- The full name of the source file, and its attributes (size,...)
+
+ 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
- -- compilations if -jnnn is used.
+ begin
+ 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
- Insert_Q (Main_Source, Index => Main_Index);
- Mark (Main_Source, Main_Index);
- end if;
+ Osint.Full_Source_Name
+ (Source_File,
+ Full_File => Full_Source_File,
+ Attr => Source_File_Attr'Access);
- First_Compiled_File := No_File;
- Most_Recent_Obj_File := No_File;
- Most_Recent_Obj_Stamp := Empty_Time_Stamp;
- Main_Unit := False;
+ Lib_File := Osint.Lib_File_Name (Source_File, Source_Index);
+ Osint.Full_Lib_File_Name
+ (Lib_File,
+ Lib_File => Full_Lib_File,
+ Attr => Lib_File_Attr);
- -- Keep looping until there is no more work to do (the Q is empty)
- -- and all the outstanding compilations have terminated
+ -- If this source has already been compiled, the executable is
+ -- 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
- -- wait for the remaining outstanding compiles and then exit.
+ In_Lib_Dir := Full_Lib_File /= No_File
+ and then In_Ada_Lib_Dir (Full_Lib_File);
- if Bad_Compilation_Count > 0 and then not Keep_Going then
- while Outstanding_Compiles > 0 loop
- Await_Compile
- (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
+ -- Since the following requires a system call, we precompute it
+ -- when needed
- if not Compilation_OK then
- Record_Failure (Full_Source_File, Source_Unit);
+ if not In_Lib_Dir then
+ 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 loop;
-
- 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
+ end if;
- begin
- 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);
+ -- If the library file is an Ada library skip it
- -- Compute the location of Lib_File (involves system calls)
- -- ??? Can we compute at the same time if the file is
- -- writable, which would save a system call on some systems
- -- (when calling Is_Readonly_Library below)
+ if In_Lib_Dir then
+ Verbose_Msg
+ (Lib_File,
+ "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
- -- obsolete.
+ 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);
- if Is_In_Obsoleted (Source_File) then
- Executable_Obsolete := True;
- end if;
+ -- The source file that we are checking cannot be located
- In_Lib_Dir := Full_Lib_File /= No_File
- and then In_Ada_Lib_Dir (Full_Lib_File);
+ elsif Full_Source_File = No_File then
+ Record_Failure (Source_File, Source_Unit, False);
- -- Since the following requires a system call, we precompute it
- -- when needed
+ -- Source and library files can be located but are internal
+ -- files
- if not In_Lib_Dir then
- Read_Only :=
- Full_Lib_File /= No_File
- and then not Check_Readonly_Files
- and then Is_Readonly_Library (Full_Lib_File);
+ elsif not Check_Readonly_Files
+ and then Full_Lib_File /= No_File
+ and then Is_Internal_File_Name (Source_File, False)
+ then
+ 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;
- -- If the library file is an Ada library skip it
-
- if In_Lib_Dir then
- Verbose_Msg
- (Lib_File,
- "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);
+ Verbose_Msg
+ (Lib_File,
+ "is an internal 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
- Record_Failure (Source_File, Source_Unit, False);
+ else
+ Collect_Arguments (Source_File, Source_Index,
+ Source_File = Main_Source, Args);
- -- Source and library files can be located but are internal
- -- files
+ -- Do nothing if project of source is externally built
- elsif not Check_Readonly_Files
- and then Full_Lib_File /= No_File
- and then Is_Internal_File_Name (Source_File, False)
+ if Arguments_Project = No_Project
+ or else not Arguments_Project.Externally_Built
then
- if Force_Compilations then
- Fail
- ("not allowed to compile """ &
- Get_Name_String (Source_File) &
- """; use -a switch, or compile file with " &
- """-gnatg"" switch");
+ -- Don't waste any time if we have to recompile anyway
+
+ Obj_Stamp := Empty_Time_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,
+ 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;
- Verbose_Msg
- (Lib_File,
- "is an internal library",
- Prefix => " ",
- Minimum_Verbosity => Opt.High);
-
- -- The source file that we are checking can be located
+ if not Need_To_Compile then
+ -- The ALI file is up-to-date. Record its Id
- else
- Collect_Arguments (Source_File, Source_Index,
- Source_File = Main_Source, Args);
+ Record_Good_ALI (ALI);
- -- 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
- or else not Arguments_Project.Externally_Built
- then
- -- Don't waste any time if we have to recompile anyway
-
- Obj_Stamp := Empty_Time_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);
+ 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;
- if not Need_To_Compile then
- -- The ALI file is up-to-date. Record its Id
-
- 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.
+ else
+ -- Check that switch -x has been used if a source
+ -- outside of project files need to be compiled.
- if Main_Project /= No_Project
- and then Arguments_Project = No_Project
- and then not External_Unit_Compilation_Allowed
- then
- Make_Failed ("external source ("
- & Get_Name_String (Source_File)
- & ") is not part of any project;"
- & " cannot be compiled without"
- & " gnatmake switch -x");
- end if;
+ if Main_Project /= No_Project
+ and then Arguments_Project = No_Project
+ and then not External_Unit_Compilation_Allowed
+ then
+ Make_Failed ("external source ("
+ & Get_Name_String (Source_File)
+ & ") is not part of any project;"
+ & " cannot be compiled without"
+ & " gnatmake switch -x");
+ 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
- First_Compiled_File := Full_Source_File;
- Most_Recent_Obj_File := No_File;
+ if First_Compiled_File = No_File then
+ First_Compiled_File := Full_Source_File;
+ Most_Recent_Obj_File := No_File;
- if Do_Not_Execute then
- exit Make_Loop;
- end if;
+ if Do_Not_Execute then
+ -- Exit the main loop
+ return True;
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
-- the library file near the source file.
- if Full_Lib_File = No_File then
- Lib_File := Osint.Lib_File_Name
- (Full_Source_File, Source_Index);
- Full_Lib_File := Lib_File;
+ Lib_File := Osint.Lib_File_Name
+ (Full_Source_File, Source_Index);
+ Full_Lib_File := Lib_File;
- -- If the library file was found, then save the
- -- library file in the same place.
+ else
+ -- If the library file was found, then save the
+ -- library file in the same place.
- else
- Lib_File := Full_Lib_File;
- end if;
+ Lib_File := Full_Lib_File;
end if;
- -- Start the compilation and record it. We can do
- -- this because there is at least one free process.
+ Lib_File_Attr := Unknown_Attributes;
- 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
- -- the Compilation.
+ Full_Lib_File := No_File;
+ Lib_File_Attr := Unknown_Attributes;
+ end if;
- if Process_Created then
- if Pid = Invalid_Pid then
- Record_Failure (Full_Source_File, Source_Unit);
- else
- Add_Process
- (Pid,
- Full_Source_File,
- Lib_File,
- Source_Unit,
- Mfile);
- end if;
+ -- Start the compilation and record it. We can do
+ -- this because there is at least one free process.
+
+ Collect_Arguments_And_Compile
+ (Full_Source_File => Full_Source_File,
+ Lib_File => Lib_File,
+ Source_Index => Source_Index,
+ Pid => Pid,
+ Process_Created => Process_Created);
+
+ -- 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;
+ 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
- -- busy compiling sources or there is nothing else to do
- -- (that is the Q is empty and there are no good ALIs to process).
+ -----------------------------
+ -- Wait_For_Available_Slot --
+ -----------------------------
+ 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
or else (Empty_Q
- and then not Good_ALI_Present
- and then Outstanding_Compiles > 0)
+ and then not Good_ALI_Present
+ and then Outstanding_Compiles > 0)
then
- Await_Compile
- (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
+ Await_Compile (Data, Compilation_OK);
if not Compilation_OK then
- Record_Failure (Full_Source_File, Source_Unit);
+ Record_Failure (Data.Full_Source_File, Data.Source_Unit);
end if;
if Compilation_OK or else Keep_Going then
and Compilation_OK
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
-- can be from several places:
-- -i => in place mode. In such a case, Full_Lib_File
if Object_Directory_Path /= null then
Name_Len := 0;
Add_Str_To_Name_Buffer (Object_Directory_Path.all);
- Add_Str_To_Name_Buffer (Get_Name_String (Lib_File));
- Full_Lib_File := Name_Find;
+ Add_Str_To_Name_Buffer
+ (Get_Name_String (Data.Lib_File));
+ Data.Full_Lib_File := Name_Find;
else
- Full_Lib_File := Lib_File;
+ Data.Full_Lib_File := Data.Lib_File;
end if;
+
+ -- Invalidate the cache for the attributes, since the
+ -- file was just created
+
+ Data.Lib_File_Attr := Unknown_Attributes;
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
-- the unit just compiled.
if Text /= null then
- ALI :=
- Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
+ ALI := Scan_ALI
+ (Data.Lib_File, Text, Ignore_ED => False, Err => True);
if ALI = No_ALI_Id then
if Compilation_OK then
Inform
- (Lib_File,
+ (Data.Lib_File,
"incompatible ALI file, please recompile");
- Record_Failure (Full_Source_File, Source_Unit);
+ Record_Failure
+ (Data.Full_Source_File, Data.Source_Unit);
end if;
+
else
- Free (Text);
Record_Good_ALI (ALI);
end if;
+ Free (Text);
+
-- If we could not read the ALI file that was just generated
-- then there could be a problem reading either the ALI or the
-- corresponding object file (if Check_Object_Consistency is
else
if Compilation_OK and not Syntax_Only then
Inform
- (Lib_File,
+ (Data.Lib_File,
"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 Wait_For_Available_Slot;
- -- PHASE 3: 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.
-
- 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;
+ -- Start of processing for Compile_Sources
- -- 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.
+ begin
+ pragma Assert (Args'First = 1);
- -- 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.
+ Outstanding_Compiles := 0;
+ Running_Compile := new Comp_Data_Arr (1 .. Max_Process);
- if Need_To_Check_Standard_Library then
- Check_Standard_Library;
- end if;
+ -- Package and Queue initializations
- -- 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.
+ Good_ALI.Init;
- 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 First_Q_Initialization then
+ Init_Q;
+ end if;
- -- If project files are used, find the proper source
- -- to compile, in case Sfile is the spec, but there
- -- is a body.
+ if Initialize_ALI_Data then
+ Initialize_ALI;
+ Initialize_ALI_Source;
+ end if;
- if Main_Project /= No_Project then
- declare
- Unit_Name : Name_Id;
- Uid : Prj.Unit_Index;
+ -- The following two flags affect the behavior of ALI.Set_Source_Table.
+ -- We set Check_Source_Files to True to ensure that source file
+ -- time stamps are checked, and we set All_Sources to False to
+ -- 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
- 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;
- end if;
+ Check_Source_Files := True;
+ All_Sources := False;
- 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
- Executable_Obsolete := True;
- end if;
+ if not Is_Marked (Main_Source, Main_Index) then
+ Insert_Q (Main_Source, Index => Main_Index);
+ Mark (Main_Source, Main_Index);
+ end if;
- if Sfile = No_File then
- Debug_Msg
- ("Skipping generic:", Withs.Table (K).Uname);
+ First_Compiled_File := No_File;
+ Most_Recent_Obj_File := No_File;
+ Most_Recent_Obj_Stamp := Empty_Time_Stamp;
+ Main_Unit := False;
- else
- Source_Index :=
- Unit_Index_Of (Withs.Table (K).Afile);
+ -- Keep looping until there is no more work to do (the Q is empty)
+ -- and all the outstanding compilations have terminated
- if Is_Marked (Sfile, Source_Index) then
- Debug_Msg ("Skipping marked file:", Sfile);
+ Make_Loop : while not Empty_Q or else Outstanding_Compiles > 0 loop
+ exit Make_Loop when Must_Exit_Because_Of_Error;
+ exit Make_Loop when Start_Compile_If_Possible (Args);
- elsif not Check_Readonly_Files
- and then Is_Internal_File_Name (Sfile, False)
- then
- Debug_Msg ("Skipping internal file:", Sfile);
+ Wait_For_Available_Slot;
- 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;
- end loop;
+ -- ??? Should be done as soon as we add a Good_ALI, wouldn't it avoid
+ -- the need for a list of good ALI ?
+ Fill_Queue_From_ALI_Files;
if Display_Compilation_Progress then
Write_Str ("completed ");
-- Update the specified path to replace the prefix with the location
-- where GNAT is installed. See the file prefix.c in GCC for details.
- function Locate_File
- (N : File_Name_Type;
- T : File_Type;
- Dir : Natural;
- Name : String) return File_Name_Type;
+ procedure Locate_File
+ (N : File_Name_Type;
+ T : File_Type;
+ Dir : Natural;
+ Name : String;
+ Found : out File_Name_Type;
+ Attr : access File_Attributes);
-- See if the file N whose name is Name exists in directory Dir. Dir is an
-- index into the Lib_Search_Directories table if T = Library. Otherwise
-- if T = Source, Dir is an index into the Src_Search_Directories table.
-- Returns the File_Name_Type of the full file name if file found, or
-- No_File if not found.
+ -- On exit, Found is set to the file that was found, and Attr to a cache of
+ -- its attributes (at least those that have been computed so far). Reusing
+ -- the cache will save some system calls.
+ -- Attr is always reset in this call to Unknown_Attributes, even in case of
+ -- failure
+
+ procedure Find_File
+ (N : File_Name_Type;
+ T : File_Type;
+ Found : out File_Name_Type;
+ Attr : access File_Attributes);
+ -- A version of Find_File that also returns a cache of the file attributes
+ -- for later reuse
+
+ procedure Smart_Find_File
+ (N : File_Name_Type;
+ T : File_Type;
+ Found : out File_Name_Type;
+ Attr : out File_Attributes);
+ -- A version of Smart_Find_File that also returns a cache of the file
+ -- attributes for later reuse
function C_String_Length (S : Address) return Integer;
-- Returns length of a C string (zero for a null address)
function File_Hash (F : File_Name_Type) return File_Hash_Num;
-- Compute hash index for use by Simple_HTable
- package File_Name_Hash_Table is new GNAT.HTable.Simple_HTable (
- Header_Num => File_Hash_Num,
- Element => File_Name_Type,
- No_Element => No_File,
- Key => File_Name_Type,
- Hash => File_Hash,
- Equal => "=");
+ type File_Info_Cache is record
+ File : File_Name_Type;
+ Attr : aliased File_Attributes;
+ end record;
+ No_File_Info_Cache : constant File_Info_Cache :=
+ (No_File, Unknown_Attributes);
- package File_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,
- Element => Time_Stamp_Type,
- No_Element => Empty_Time_Stamp,
+ Element => File_Info_Cache,
+ No_Element => No_File_Info_Cache,
Key => File_Name_Type,
Hash => File_Hash,
Equal => "=");
return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length);
end File_Hash;
+ -----------------
+ -- File_Length --
+ -----------------
+
+ function File_Length
+ (Name : C_File_Name; Attr : access File_Attributes) return Long_Integer
+ is
+ function Internal
+ (F : Integer; N : C_File_Name; A : System.Address) return Long_Integer;
+ pragma Import (C, Internal, "__gnat_file_length_attr");
+ begin
+ return Internal (-1, Name, Attr.all'Address);
+ end File_Length;
+
+ ---------------------
+ -- File_Time_Stamp --
+ ---------------------
+
+ function File_Time_Stamp
+ (Name : C_File_Name; Attr : access File_Attributes) return OS_Time
+ is
+ function Internal (N : C_File_Name; A : System.Address) return OS_Time;
+ pragma Import (C, Internal, "__gnat_file_time_name_attr");
+ begin
+ return Internal (Name, Attr.all'Address);
+ end File_Time_Stamp;
+
----------------
-- File_Stamp --
----------------
(N : File_Name_Type;
T : File_Type) return File_Name_Type
is
+ Attr : aliased File_Attributes;
+ Found : File_Name_Type;
+ begin
+ Find_File (N, T, Found, Attr'Access);
+ return Found;
+ end Find_File;
+
+ ---------------
+ -- Find_File --
+ ---------------
+
+ procedure Find_File
+ (N : File_Name_Type;
+ T : File_Type;
+ Found : out File_Name_Type;
+ Attr : access File_Attributes) is
begin
Get_Name_String (N);
(Hostparm.OpenVMS and then
Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg")))
then
- return N;
+ Found := N;
+ Attr.all := Unknown_Attributes;
+ return;
-- If we are trying to find the current main file just look in the
-- directory where the user said it was.
elsif Look_In_Primary_Directory_For_Current_Main
and then Current_Main = N
then
- return Locate_File (N, T, Primary_Directory, File_Name);
+ Locate_File (N, T, Primary_Directory, File_Name, Found, Attr);
+ return;
-- Otherwise do standard search for source file
-- return No_File, indicating the file is not a source.
if File = Error_File_Name then
- return No_File;
-
+ Found := No_File;
else
- return File;
+ Found := File;
end if;
+
+ Attr.all := Unknown_Attributes;
+ return;
end if;
-- First place to look is in the primary directory (i.e. the same
-- directory as the source) unless this has been disabled with -I-
if Opt.Look_In_Primary_Dir then
- File := Locate_File (N, T, Primary_Directory, File_Name);
+ Locate_File (N, T, Primary_Directory, File_Name, Found, Attr);
- if File /= No_File then
- return File;
+ if Found /= No_File then
+ return;
end if;
end if;
end if;
for D in Primary_Directory + 1 .. Last_Dir loop
- File := Locate_File (N, T, D, File_Name);
+ Locate_File (N, T, D, File_Name, Found, Attr);
- if File /= No_File then
- return File;
+ if Found /= No_File then
+ return;
end if;
end loop;
- return No_File;
+ Attr.all := Unknown_Attributes;
+ Found := No_File;
end if;
end;
end Find_File;
-- 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
+ Attr : File_Attributes;
+ File : File_Name_Type;
begin
- return Find_File (N, Library);
+ Full_Lib_File_Name (N, File, Attr);
+ return File;
end Full_Lib_File_Name;
----------------------------
return Smart_Find_File (N, Source);
end Full_Source_Name;
+ ----------------------
+ -- Full_Source_Name --
+ ----------------------
+
+ procedure Full_Source_Name
+ (N : File_Name_Type;
+ Full_File : out File_Name_Type;
+ Attr : access File_Attributes) is
+ begin
+ Smart_Find_File (N, Source, Full_File, Attr.all);
+ end Full_Source_Name;
+
-------------------
-- Get_Directory --
-------------------
Lib_Search_Directories.Table (Primary_Directory) := new String'("");
end Initialize;
+ ------------------
+ -- Is_Directory --
+ ------------------
+
+ function Is_Directory
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean
+ is
+ function Internal (N : C_File_Name; A : System.Address) return Integer;
+ pragma Import (C, Internal, "__gnat_is_directory_attr");
+ begin
+ return Internal (Name, Attr.all'Address) /= 0;
+ end Is_Directory;
+
----------------------------
-- Is_Directory_Separator --
----------------------------
return not Is_Writable_File (Name_Buffer (1 .. Name_Len));
end Is_Readonly_Library;
+ ------------------------
+ -- Is_Executable_File --
+ ------------------------
+
+ function Is_Executable_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean
+ is
+ function Internal (N : C_File_Name; A : System.Address) return Integer;
+ pragma Import (C, Internal, "__gnat_is_executable_file_attr");
+ begin
+ return Internal (Name, Attr.all'Address) /= 0;
+ end Is_Executable_File;
+
+ ----------------------
+ -- Is_Readable_File --
+ ----------------------
+
+ function Is_Readable_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean
+ is
+ function Internal (N : C_File_Name; A : System.Address) return Integer;
+ pragma Import (C, Internal, "__gnat_is_readable_file_attr");
+ begin
+ return Internal (Name, Attr.all'Address) /= 0;
+ end Is_Readable_File;
+
+ ---------------------
+ -- Is_Regular_File --
+ ---------------------
+
+ function Is_Regular_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean
+ is
+ function Internal (N : C_File_Name; A : System.Address) return Integer;
+ pragma Import (C, Internal, "__gnat_is_regular_file_attr");
+ begin
+ return Internal (Name, Attr.all'Address) /= 0;
+ end Is_Regular_File;
+
+ ----------------------
+ -- Is_Symbolic_Link --
+ ----------------------
+
+ function Is_Symbolic_Link
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean
+ is
+ function Internal (N : C_File_Name; A : System.Address) return Integer;
+ pragma Import (C, Internal, "__gnat_is_symbolic_link_attr");
+ begin
+ return Internal (Name, Attr.all'Address) /= 0;
+ end Is_Symbolic_Link;
+
+ ----------------------
+ -- Is_Writable_File --
+ ----------------------
+
+ function Is_Writable_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean
+ is
+ function Internal (N : C_File_Name; A : System.Address) return Integer;
+ pragma Import (C, Internal, "__gnat_is_writable_file_attr");
+ begin
+ return Internal (Name, Attr.all'Address) /= 0;
+ end Is_Writable_File;
+
-------------------
-- Lib_File_Name --
-------------------
-- Locate_File --
-----------------
- function Locate_File
- (N : File_Name_Type;
- T : File_Type;
- Dir : Natural;
- Name : String) return File_Name_Type
+ procedure Locate_File
+ (N : File_Name_Type;
+ T : File_Type;
+ Dir : Natural;
+ Name : String;
+ Found : out File_Name_Type;
+ Attr : access File_Attributes)
is
Dir_Name : String_Ptr;
end if;
declare
- Full_Name : String (1 .. Dir_Name'Length + Name'Length);
+ Full_Name : String (1 .. Dir_Name'Length + Name'Length + 1);
begin
Full_Name (1 .. Dir_Name'Length) := Dir_Name.all;
- Full_Name (Dir_Name'Length + 1 .. Full_Name'Length) := Name;
+ Full_Name (Dir_Name'Length + 1 .. Full_Name'Last - 1) := Name;
+ Full_Name (Full_Name'Last) := ASCII.NUL;
+
+ Attr.all := Unknown_Attributes;
- if not Is_Regular_File (Full_Name) then
- return No_File;
+ if not Is_Regular_File (Full_Name'Address, Attr) then
+ Found := No_File;
else
-- If the file is in the current directory then return N itself
if Dir_Name'Length = 0 then
- return N;
+ Found := N;
else
- Name_Len := Full_Name'Length;
- Name_Buffer (1 .. Name_Len) := Full_Name;
- return Name_Enter;
+ Name_Len := Full_Name'Length - 1;
+ Name_Buffer (1 .. Name_Len) :=
+ Full_Name (1 .. Full_Name'Last - 1);
+ Found := Name_Find; -- ??? Was Name_Enter, no obvious reason
end if;
end if;
end;
declare
File_Name : constant String := Name_Buffer (1 .. Name_Len);
File : File_Name_Type := No_File;
+ Attr : aliased File_Attributes;
Last_Dir : Natural;
begin
if Opt.Look_In_Primary_Dir then
- File := Locate_File (N, Source, Primary_Directory, File_Name);
+ Locate_File
+ (N, Source, Primary_Directory, File_Name, File, Attr'Access);
if File /= No_File and then T = File_Stamp (N) then
return File;
Last_Dir := Src_Search_Directories.Last;
for D in Primary_Directory + 1 .. Last_Dir loop
- File := Locate_File (N, Source, D, File_Name);
+ Locate_File (N, Source, D, File_Name, File, Attr'Access);
if File /= No_File and then T = File_Stamp (File) then
return File;
function Read_Library_Info
(Lib_File : File_Name_Type;
- Fatal_Err : Boolean := False) return Text_Buffer_Ptr is
+ Fatal_Err : Boolean := False) return Text_Buffer_Ptr
+ is
+ File : File_Name_Type;
+ Attr : aliased File_Attributes;
begin
+ Find_File (Lib_File, Library, File, Attr'Access);
return Read_Library_Info_From_Full
- (Full_Lib_File => Find_File (Lib_File, Library),
+ (Full_Lib_File => File,
+ Lib_File_Attr => Attr'Access,
Fatal_Err => Fatal_Err);
end Read_Library_Info;
function Read_Library_Info_From_Full
(Full_Lib_File : File_Name_Type;
+ Lib_File_Attr : access File_Attributes;
Fatal_Err : Boolean := False) return Text_Buffer_Ptr
is
Lib_FD : File_Descriptor;
-- The file descriptor for the current library file. A negative value
-- indicates failure to open the specified source file.
+ Len : Integer;
+ -- Length of source file text (ALI). If it doesn't fit in an integer
+ -- we're probably stuck anyway (>2 gigs of source seems a lot!)
+
Text : Text_Buffer_Ptr;
-- Allocated text buffer
end if;
end if;
+ -- Compute the length of the file (potentially also preparing other data
+ -- like the timestamp and whether the file is read-only, for future use)
+
+ Len := Integer (File_Length (Name_Buffer'Address, Lib_File_Attr));
+
-- Check for object file consistency if requested
if Opt.Check_Object_Consistency then
- Current_Full_Lib_Stamp := File_Stamp (Current_Full_Lib_Name);
+ -- On most systems, this does not result in an extra system call
+ Current_Full_Lib_Stamp := OS_Time_To_GNAT_Time
+ (File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr));
+
+ -- ??? One system call here
Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name);
if Current_Full_Obj_Stamp (1) = ' ' then
-- When the library is readonly always assume object is consistent
+ -- The call to Is_Writable_File only results in a system call on
+ -- some systems, but in most cases it has already been computed as
+ -- part of the call to File_Length above.
+
+ 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;
elsif Fatal_Err then
-- Read data from the file
declare
- Len : constant Integer := Integer (File_Length (Lib_FD));
- -- Length of source file text. If it doesn't fit in an integer
- -- we're probably stuck anyway (>2 gigs of source seems a lot!)
-
Actual_Len : Integer := 0;
Lo : constant Text_Ptr := 0;
(N : File_Name_Type;
T : File_Type) return Time_Stamp_Type
is
- Time_Stamp : Time_Stamp_Type;
-
+ File : File_Name_Type;
+ Attr : aliased File_Attributes;
begin
if not File_Cache_Enabled then
- return File_Stamp (Find_File (N, T));
+ Find_File (N, T, File, Attr'Access);
+ else
+ Smart_Find_File (N, T, File, Attr);
end if;
- Time_Stamp := File_Stamp_Hash_Table.Get (N);
-
- if Time_Stamp (1) = ' ' then
- Time_Stamp := File_Stamp (Smart_Find_File (N, T));
- File_Stamp_Hash_Table.Set (N, Time_Stamp);
+ if File = No_File then
+ return Empty_Time_Stamp;
+ else
+ Get_Name_String (File);
+ Name_Buffer (Name_Len + 1) := ASCII.NUL;
+ return OS_Time_To_GNAT_Time
+ (File_Time_Stamp (Name_Buffer'Address, Attr'Access));
end if;
-
- return Time_Stamp;
end Smart_File_Stamp;
---------------------
(N : File_Name_Type;
T : File_Type) return File_Name_Type
is
- Full_File_Name : File_Name_Type;
-
+ File : File_Name_Type;
+ Attr : File_Attributes;
begin
- if not File_Cache_Enabled then
- return Find_File (N, T);
- end if;
+ Smart_Find_File (N, T, File, Attr);
+ return File;
+ end Smart_Find_File;
- Full_File_Name := File_Name_Hash_Table.Get (N);
+ ---------------------
+ -- Smart_Find_File --
+ ---------------------
- if Full_File_Name = No_File then
- Full_File_Name := Find_File (N, T);
- File_Name_Hash_Table.Set (N, Full_File_Name);
+ procedure Smart_Find_File
+ (N : File_Name_Type;
+ T : File_Type;
+ Found : out File_Name_Type;
+ Attr : out File_Attributes)
+ is
+ Info : File_Info_Cache;
+
+ begin
+ if not File_Cache_Enabled then
+ 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;
- return Full_File_Name;
+ Found := Info.File;
+ Attr := Info.Attr;
end Smart_Find_File;
----------------------
-- Package Initialization --
----------------------------
+ procedure Reset_File_Attributes (Attr : System.Address);
+ pragma Import (C, Reset_File_Attributes, "reset_attributes");
+
begin
Initialization : declare
"__gnat_get_maximum_file_name_length");
-- Function to get maximum file name length for system
+ Sizeof_File_Attributes : Integer;
+ pragma Import (C, Sizeof_File_Attributes,
+ "size_of_file_attributes");
+
begin
+ pragma Assert (Sizeof_File_Attributes <= File_Attributes_Size);
+
+ Reset_File_Attributes (Unknown_Attributes'Address);
+
Identifier_Character_Set := Get_Default_Identifier_Character_Set;
Maximum_File_Name_Length := Get_Maximum_File_Name_Length;
with Namet; use Namet;
with Types; use Types;
+with System.Storage_Elements;
with System.OS_Lib; use System.OS_Lib;
with System; use System;
-- this routine called with Name set to "gnat" will return "-lgnat-5.02"
-- on UNIX and Windows and -lgnat_5_02 on VMS.
+ ---------------------
+ -- File attributes --
+ ---------------------
+ -- The following subprograms offer services similar to those found in
+ -- System.OS_Lib, but with the ability to extra multiple information from
+ -- a single system call, depending on the system. This can result in fewer
+ -- system calls when reused.
+ -- In all these subprograms, the requested value is either read from the
+ -- File_Attributes parameter (resulting in no system call), or computed
+ -- from the disk and then cached in the File_Attributes parameter (possibly
+ -- along with other values).
+
+ type File_Attributes is private;
+ Unknown_Attributes : constant File_Attributes;
+ -- A cache for various attributes for a file (length, accessibility,...)
+ -- This must be initialized to Unknown_Attributes prior to the first call.
+
+ function Is_Directory
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean;
+ function Is_Regular_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean;
+ function Is_Symbolic_Link
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean;
+ -- Return the type of the file,
+
+ function File_Length
+ (Name : C_File_Name; Attr : access File_Attributes) return Long_Integer;
+ -- Return the length (number of bytes) of the file
+
+ function File_Time_Stamp
+ (Name : C_File_Name; Attr : access File_Attributes) return OS_Time;
+ -- Return the time stamp of the file
+
+ function Is_Readable_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean;
+ function Is_Executable_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean;
+ function Is_Writable_File
+ (Name : C_File_Name; Attr : access File_Attributes) return Boolean;
+ -- Return the access rights for the file
+
-------------------------
-- Search Dir Routines --
-------------------------
-- using Read_Source_File. Calling this routine entails no source file
-- directory lookup penalty.
+ procedure Full_Source_Name
+ (N : File_Name_Type;
+ Full_File : out File_Name_Type;
+ Attr : access File_Attributes);
function Full_Source_Name (N : File_Name_Type) return File_Name_Type;
function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type;
-- Returns the full name/time stamp of the source file whose simple name
-- The source file directory lookup penalty is incurred every single time
-- the routines are called unless you have previously called
-- Source_File_Data (Cache => True). See below.
+ -- The procedural version also returns some file attributes for the ALI
+ -- file (to save on system calls later on).
function Current_File_Index return Int;
-- Return the index in its source file of the current main unit
function Read_Library_Info_From_Full
(Full_Lib_File : File_Name_Type;
+ Lib_File_Attr : access File_Attributes;
Fatal_Err : Boolean := False) return Text_Buffer_Ptr;
-- Same as Read_Library_Info, except Full_Lib_File must contains the full
-- path to the library file (instead of having Read_Library_Info recompute
- -- it)
+ -- it).
+ -- Lib_File_Attr should be an initialized set of attributes for the
+ -- library file (it can be initialized to Unknown_Attributes, but in
+ -- general will have been initialized by a previous call to Find_File).
function Full_Library_Info_Name return File_Name_Type;
function Full_Object_File_Name return File_Name_Type;
-- It is an error to call Current_Object_File_Stamp if
-- Opt.Check_Object_Consistency is set to False.
+ procedure Full_Lib_File_Name
+ (N : File_Name_Type;
+ Lib_File : out File_Name_Type;
+ Attr : out File_Attributes);
function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type;
-- Returns the full name of library file N. N should not include
-- path information. Note that if the file cannot be located No_File is
-- for the second (this is not an error situation). The full name includes
-- the appropriate directory information. The library file directory lookup
-- penalty is incurred every single time this routine is called.
+ -- The procedural version also returns some file attributes for the ALI
+ -- file (to save on system calls later on).
function Lib_File_Name
(Source_File : File_Name_Type;
-- detected, the file being written is deleted, and a fatal error is
-- signalled.
+ File_Attributes_Size : constant Integer := 50;
+ -- This should be big enough to fit a "struct file_attributes" on any
+ -- system. It doesn't matter if it is too big (which avoids the need for
+ -- either mapping the struct exactly or importing the sizeof from C, which
+ -- would result in dynamic code)
+
+ type File_Attributes is
+ array (1 .. File_Attributes_Size)
+ of System.Storage_Elements.Storage_Element;
+
+ Unknown_Attributes : constant File_Attributes := (others => 0);
+ -- Will be initialized properly at elaboration (for efficiency later on,
+ -- avoid function calls every time we want to reset the attributes).
+
end Osint;
projects / thirdparty / gcc.git / commitdiff
