diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
| -rw-r--r-- | gcc/ada/adaint.c | 543 | ||||
| -rw-r--r-- | gcc/ada/adaint.h | 51 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 980 | ||||
| -rw-r--r-- | gcc/ada/osint.adb | 381 | ||||
| -rw-r--r-- | gcc/ada/osint.ads | 74 |
7 files changed, 1300 insertions, 745 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ad2d9e2..517b01f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,19 @@ 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 unused. (Read_Library_Info_From_Full): New subprogram. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 135d317..e26f3ca 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -324,6 +324,12 @@ const int __gnat_vmsp = 0; #endif +/* Used for Ada bindings */ +const int size_of_file_attributes = sizeof (struct file_attributes); + +/* Reset the file attributes as if no system call had been performed */ +void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr); + /* The __gnat_max_path_len variable is used to export the maximum length of a path name to Ada code. max_path_len is also provided for compatibility with older GNAT versions, please do not use @@ -371,6 +377,24 @@ to_ptr32 (char **ptr64) #define MAYBE_TO_PTR32(argv) argv #endif +void +reset_attributes + (struct file_attributes* attr) +{ + attr->exists = -1; + + attr->writable = -1; + attr->readable = -1; + attr->executable = -1; + + attr->regular = -1; + attr->symbolic_link = -1; + attr->directory = -1; + + attr->timestamp = (OS_Time)-2; + attr->file_length = -1; +} + OS_Time __gnat_current_time (void) @@ -1036,42 +1060,89 @@ __gnat_open_new_temp (char *path, int fmode) return fd < 0 ? -1 : fd; } -/* Return the number of bytes in the specified file. */ +/**************************************************************** + ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information + ** as possible from it, storing the result in a cache for later reuse + ****************************************************************/ -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 @@ -1266,137 +1337,136 @@ win32_filetime (HANDLE h) /* Return a GNAT time stamp given a file name. */ OS_Time -__gnat_file_time_name (char *name) +__gnat_file_time_name_attr (char* name, struct file_attributes* attr) { - + if (attr->timestamp == (OS_Time)-2) { #if defined (__EMX__) || defined (MSDOS) - int fd = open (name, O_RDONLY | O_BINARY); - time_t ret = __gnat_file_time_fd (fd); - close (fd); - return (OS_Time)ret; + int fd = open (name, O_RDONLY | O_BINARY); + time_t ret = __gnat_file_time_fd (fd); + close (fd); + attr->timestamp = (OS_Time)ret; #elif defined (_WIN32) && !defined (RTX) - time_t ret = -1; - TCHAR wname[GNAT_MAX_PATH_LEN]; - - 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. */ @@ -1722,25 +1792,42 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf) #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) { #ifdef __vxworks @@ -1776,23 +1863,39 @@ __gnat_is_absolute_path (char *name, int length) } 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) @@ -1986,95 +2089,111 @@ __gnat_can_use_acl (TCHAR *wname) #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 @@ -2193,21 +2312,31 @@ __gnat_set_non_readable (char *name) } int -__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED) +__gnat_is_symbolic_link_attr (char* name, struct file_attributes* attr) { + if (attr->symbolic_link == -1) { #if defined (__vxworks) || defined (__nucleus__) - return 0; + attr->symbolic_link = 0; #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__) - int ret; - GNAT_STRUCT_STAT statbuf; - - ret = GNAT_LSTAT (name, &statbuf); - return (!ret && S_ISLNK (statbuf.st_mode)); - + int ret; + GNAT_STRUCT_STAT statbuf; + ret = GNAT_LSTAT (name, &statbuf); + attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode)); #else - return 0; + attr->symbolic_link = 0; #endif + } + return attr->symbolic_link; +} + +int +__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED) +{ + struct file_attributes attr; + reset_attributes (&attr); + return __gnat_is_symbolic_link_attr (name, &attr); + } #if defined (sun) && defined (__SVR4) diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 79a1e4e..fbdb4ff 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -68,6 +68,30 @@ typedef long long OS_Time; typedef long OS_Time; #endif +/* A lazy cache for the attributes of a file. On some systems, a single call to + stat() will give all this information, so it is better than doing a system + call every time. On other systems this require several system calls. +*/ + +struct file_attributes { + short exists; + + short writable; + short readable; + short executable; + + short symbolic_link; + short regular; + short directory; + + OS_Time timestamp; + long file_length; +}; +/* WARNING: changing the size here might require changing the constant + * File_Attributes_Size in osint.ads (which should be big enough to + * fit the above struct on any system) + */ + extern int __gnat_max_path_len; extern OS_Time __gnat_current_time (void); extern void __gnat_current_time_string (char *); @@ -121,15 +145,28 @@ extern OS_Time __gnat_file_time_fd (int); extern void __gnat_set_file_time_name (char *, time_t); -extern int __gnat_dup (int); -extern int __gnat_dup2 (int, int); -extern int __gnat_file_exists (char *); -extern int __gnat_is_regular_file (char *); -extern int __gnat_is_absolute_path (char *,int); -extern int __gnat_is_directory (char *); +extern int __gnat_dup (int); +extern int __gnat_dup2 (int, int); +extern int __gnat_file_exists (char *); +extern int __gnat_is_regular_file (char *); +extern int __gnat_is_absolute_path (char *,int); +extern int __gnat_is_directory (char *); extern int __gnat_is_writable_file (char *); extern int __gnat_is_readable_file (char *name); -extern int __gnat_is_executable_file (char *name); +extern int __gnat_is_executable_file (char *name); + +extern void reset_attributes (struct file_attributes* attr); +extern long __gnat_file_length_attr (int, char *, struct file_attributes *); +extern OS_Time __gnat_file_time_name_attr (char *, struct file_attributes *); +extern OS_Time __gnat_file_time_fd_attr (int, struct file_attributes *); +extern int __gnat_file_exists_attr (char *, struct file_attributes *); +extern int __gnat_is_regular_file_attr (char *, struct file_attributes *); +extern int __gnat_is_directory_attr (char *, struct file_attributes *); +extern int __gnat_is_readable_file_attr (char *, struct file_attributes *); +extern int __gnat_is_writable_file_attr (char *, struct file_attributes *); +extern int __gnat_is_executable_file_attr (char *, struct file_attributes *); +extern int __gnat_is_symbolic_link_attr (char *, struct file_attributes *); + extern void __gnat_set_non_writable (char *name); extern void __gnat_set_writable (char *name); extern void __gnat_set_executable (char *name); diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 8119a6d..18739e8 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -190,7 +190,7 @@ package body Bcheck is else ALI_Path_Id := - Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library); + Osint.Full_Lib_File_Name (ALIs.Table (A).Afile); if Osint.Is_Readonly_Library (ALI_Path_Id) then if Tolerate_Consistency_Errors then Error_Msg ("?{ should be recompiled"); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index eec486a..7037d64 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -106,13 +106,17 @@ package body Make is 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; @@ -741,6 +745,7 @@ package body Make is 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; @@ -752,7 +757,9 @@ package body Make is -- 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; @@ -1418,6 +1425,7 @@ package body Make is 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; @@ -1577,12 +1585,12 @@ package body Make is 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; @@ -2418,62 +2426,22 @@ package body Make is 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 @@ -2482,18 +2450,16 @@ package body Make is -- 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 @@ -2501,8 +2467,15 @@ package body Make is 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; @@ -2545,16 +2518,41 @@ package body Make is 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; @@ -2562,14 +2560,15 @@ package body Make is 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; @@ -2579,21 +2578,17 @@ package body Make is ------------------- 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 @@ -2611,21 +2606,19 @@ package body Make is 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; @@ -2707,11 +2700,13 @@ package body Make is -- 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 @@ -2759,11 +2754,11 @@ package body Make is 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; @@ -2773,11 +2768,11 @@ package body Make is 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; @@ -2994,6 +2989,119 @@ package body Make is (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 -- ---------------------- @@ -3049,6 +3157,29 @@ package body Make is 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 -- -------------------- @@ -3073,295 +3204,284 @@ package body Make is 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 @@ -3382,7 +3502,7 @@ package body Make is 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 @@ -3396,14 +3516,21 @@ package body Make is 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 @@ -3417,8 +3544,8 @@ package body Make is -- 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 @@ -3426,15 +3553,18 @@ package body Make is 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 @@ -3445,137 +3575,71 @@ package body Make 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 "); diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 11197f4..a47c594 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -94,16 +94,39 @@ package body Osint is -- Update the specified path to replace the prefix with the location -- where GNAT is installed. See the file prefix.c in GCC for details. - function Locate_File - (N : File_Name_Type; - T : File_Type; - Dir : Natural; - Name : String) return File_Name_Type; + procedure Locate_File + (N : File_Name_Type; + T : File_Type; + Dir : Natural; + Name : String; + Found : out File_Name_Type; + Attr : access File_Attributes); -- See if the file N whose name is Name exists in directory Dir. Dir is an -- index into the Lib_Search_Directories table if T = Library. Otherwise -- if T = Source, Dir is an index into the Src_Search_Directories table. -- Returns the File_Name_Type of the full file name if file found, or -- No_File if not found. + -- On exit, Found is set to the file that was found, and Attr to a cache of + -- its attributes (at least those that have been computed so far). Reusing + -- the cache will save some system calls. + -- Attr is always reset in this call to Unknown_Attributes, even in case of + -- failure + + procedure Find_File + (N : File_Name_Type; + T : File_Type; + Found : out File_Name_Type; + Attr : access File_Attributes); + -- A version of Find_File that also returns a cache of the file attributes + -- for later reuse + + procedure Smart_Find_File + (N : File_Name_Type; + T : File_Type; + Found : out File_Name_Type; + Attr : out File_Attributes); + -- A version of Smart_Find_File that also returns a cache of the file + -- attributes for later reuse function C_String_Length (S : Address) return Integer; -- Returns length of a C string (zero for a null address) @@ -212,18 +235,17 @@ package body Osint is function File_Hash (F : File_Name_Type) return File_Hash_Num; -- Compute hash index for use by Simple_HTable - 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 => "="); @@ -959,6 +981,33 @@ package body Osint is return File_Hash_Num (Int (F) rem File_Hash_Num'Range_Length); end File_Hash; + ----------------- + -- File_Length -- + ----------------- + + function File_Length + (Name : C_File_Name; Attr : access File_Attributes) return Long_Integer + is + function Internal + (F : Integer; N : C_File_Name; A : System.Address) return Long_Integer; + pragma Import (C, Internal, "__gnat_file_length_attr"); + begin + return Internal (-1, Name, Attr.all'Address); + end File_Length; + + --------------------- + -- File_Time_Stamp -- + --------------------- + + function File_Time_Stamp + (Name : C_File_Name; Attr : access File_Attributes) return OS_Time + is + function Internal (N : C_File_Name; A : System.Address) return OS_Time; + pragma Import (C, Internal, "__gnat_file_time_name_attr"); + begin + return Internal (Name, Attr.all'Address); + end File_Time_Stamp; + ---------------- -- File_Stamp -- ---------------- @@ -993,6 +1042,22 @@ package body Osint is (N : File_Name_Type; T : File_Type) return File_Name_Type is + Attr : aliased File_Attributes; + Found : File_Name_Type; + begin + Find_File (N, T, Found, Attr'Access); + return Found; + end Find_File; + + --------------- + -- Find_File -- + --------------- + + procedure Find_File + (N : File_Name_Type; + T : File_Type; + Found : out File_Name_Type; + Attr : access File_Attributes) is begin Get_Name_String (N); @@ -1016,7 +1081,9 @@ package body Osint is (Hostparm.OpenVMS and then Name_Buffer (Name_Len - 2 .. Name_Len) = "_dg"))) then - return N; + Found := N; + Attr.all := Unknown_Attributes; + return; -- If we are trying to find the current main file just look in the -- directory where the user said it was. @@ -1024,7 +1091,8 @@ package body Osint is elsif Look_In_Primary_Directory_For_Current_Main and then Current_Main = N then - return Locate_File (N, T, Primary_Directory, File_Name); + Locate_File (N, T, Primary_Directory, File_Name, Found, Attr); + return; -- Otherwise do standard search for source file @@ -1042,21 +1110,23 @@ package body Osint is -- return No_File, indicating the file is not a source. if File = Error_File_Name then - return No_File; - + Found := No_File; else - return File; + Found := File; end if; + + Attr.all := Unknown_Attributes; + return; end if; -- First place to look is in the primary directory (i.e. the same -- directory as the source) unless this has been disabled with -I- if Opt.Look_In_Primary_Dir then - File := Locate_File (N, T, Primary_Directory, File_Name); + Locate_File (N, T, Primary_Directory, File_Name, Found, Attr); - if File /= No_File then - return File; + if Found /= No_File then + return; end if; end if; @@ -1069,14 +1139,15 @@ package body Osint is end if; for D in Primary_Directory + 1 .. Last_Dir loop - File := Locate_File (N, T, D, File_Name); + Locate_File (N, T, D, File_Name, Found, Attr); - if File /= No_File then - return File; + if Found /= No_File then + return; end if; end loop; - return No_File; + Attr.all := Unknown_Attributes; + Found := No_File; end if; end; end Find_File; @@ -1148,9 +1219,28 @@ package body Osint is -- Full_Lib_File_Name -- ------------------------ + 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; ---------------------------- @@ -1189,6 +1279,18 @@ package body Osint is return Smart_Find_File (N, Source); end Full_Source_Name; + ---------------------- + -- Full_Source_Name -- + ---------------------- + + procedure Full_Source_Name + (N : File_Name_Type; + Full_File : out File_Name_Type; + Attr : access File_Attributes) is + begin + Smart_Find_File (N, Source, Full_File, Attr.all); + end Full_Source_Name; + ------------------- -- Get_Directory -- ------------------- @@ -1470,6 +1572,19 @@ package body Osint is Lib_Search_Directories.Table (Primary_Directory) := new String'(""); end Initialize; + ------------------ + -- Is_Directory -- + ------------------ + + function Is_Directory + (Name : C_File_Name; Attr : access File_Attributes) return Boolean + is + function Internal (N : C_File_Name; A : System.Address) return Integer; + pragma Import (C, Internal, "__gnat_is_directory_attr"); + begin + return Internal (Name, Attr.all'Address) /= 0; + end Is_Directory; + ---------------------------- -- Is_Directory_Separator -- ---------------------------- @@ -1501,6 +1616,71 @@ package body Osint is return not Is_Writable_File (Name_Buffer (1 .. Name_Len)); end Is_Readonly_Library; + ------------------------ + -- Is_Executable_File -- + ------------------------ + + function Is_Executable_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean + is + function Internal (N : C_File_Name; A : System.Address) return Integer; + pragma Import (C, Internal, "__gnat_is_executable_file_attr"); + begin + return Internal (Name, Attr.all'Address) /= 0; + end Is_Executable_File; + + ---------------------- + -- Is_Readable_File -- + ---------------------- + + function Is_Readable_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean + is + function Internal (N : C_File_Name; A : System.Address) return Integer; + pragma Import (C, Internal, "__gnat_is_readable_file_attr"); + begin + return Internal (Name, Attr.all'Address) /= 0; + end Is_Readable_File; + + --------------------- + -- Is_Regular_File -- + --------------------- + + function Is_Regular_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean + is + function Internal (N : C_File_Name; A : System.Address) return Integer; + pragma Import (C, Internal, "__gnat_is_regular_file_attr"); + begin + return Internal (Name, Attr.all'Address) /= 0; + end Is_Regular_File; + + ---------------------- + -- Is_Symbolic_Link -- + ---------------------- + + function Is_Symbolic_Link + (Name : C_File_Name; Attr : access File_Attributes) return Boolean + is + function Internal (N : C_File_Name; A : System.Address) return Integer; + pragma Import (C, Internal, "__gnat_is_symbolic_link_attr"); + begin + return Internal (Name, Attr.all'Address) /= 0; + end Is_Symbolic_Link; + + ---------------------- + -- Is_Writable_File -- + ---------------------- + + function Is_Writable_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean + is + function Internal (N : C_File_Name; A : System.Address) return Integer; + pragma Import (C, Internal, "__gnat_is_writable_file_attr"); + begin + return Internal (Name, Attr.all'Address) /= 0; + end Is_Writable_File; + ------------------- -- Lib_File_Name -- ------------------- @@ -1533,11 +1713,13 @@ package body Osint is -- Locate_File -- ----------------- - function Locate_File - (N : File_Name_Type; - T : File_Type; - Dir : Natural; - Name : String) return File_Name_Type + procedure Locate_File + (N : File_Name_Type; + T : File_Type; + Dir : Natural; + Name : String; + Found : out File_Name_Type; + Attr : access File_Attributes) is Dir_Name : String_Ptr; @@ -1555,24 +1737,28 @@ package body Osint is end if; declare - Full_Name : String (1 .. Dir_Name'Length + Name'Length); + Full_Name : String (1 .. Dir_Name'Length + Name'Length + 1); begin Full_Name (1 .. Dir_Name'Length) := Dir_Name.all; - Full_Name (Dir_Name'Length + 1 .. Full_Name'Length) := Name; + Full_Name (Dir_Name'Length + 1 .. Full_Name'Last - 1) := Name; + Full_Name (Full_Name'Last) := ASCII.NUL; + + 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; @@ -1592,11 +1778,13 @@ package body Osint is declare File_Name : constant String := Name_Buffer (1 .. Name_Len); File : File_Name_Type := No_File; + Attr : aliased File_Attributes; Last_Dir : Natural; begin if Opt.Look_In_Primary_Dir then - File := Locate_File (N, Source, Primary_Directory, File_Name); + Locate_File + (N, Source, Primary_Directory, File_Name, File, Attr'Access); if File /= No_File and then T = File_Stamp (N) then return File; @@ -1606,7 +1794,7 @@ package body Osint is Last_Dir := Src_Search_Directories.Last; for D in Primary_Directory + 1 .. Last_Dir loop - File := Locate_File (N, Source, D, File_Name); + Locate_File (N, Source, D, File_Name, File, Attr'Access); if File /= No_File and then T = File_Stamp (File) then return File; @@ -2110,10 +2298,15 @@ package body Osint is function Read_Library_Info (Lib_File : File_Name_Type; - Fatal_Err : Boolean := False) return Text_Buffer_Ptr is + Fatal_Err : Boolean := False) return Text_Buffer_Ptr + is + File : File_Name_Type; + Attr : aliased File_Attributes; begin + Find_File (Lib_File, Library, File, Attr'Access); return Read_Library_Info_From_Full - (Full_Lib_File => Find_File (Lib_File, Library), + (Full_Lib_File => File, + Lib_File_Attr => Attr'Access, Fatal_Err => Fatal_Err); end Read_Library_Info; @@ -2123,12 +2316,17 @@ package body Osint is function Read_Library_Info_From_Full (Full_Lib_File : File_Name_Type; + Lib_File_Attr : access File_Attributes; Fatal_Err : Boolean := False) return Text_Buffer_Ptr is Lib_FD : File_Descriptor; -- The file descriptor for the current library file. A negative value -- indicates failure to open the specified source file. + Len : Integer; + -- Length of source file text (ALI). If it doesn't fit in an integer + -- we're probably stuck anyway (>2 gigs of source seems a lot!) + Text : Text_Buffer_Ptr; -- Allocated text buffer @@ -2168,17 +2366,32 @@ package body Osint is end if; end if; + -- Compute the length of the file (potentially also preparing other data + -- like the timestamp and whether the file is read-only, for future use) + + Len := Integer (File_Length (Name_Buffer'Address, Lib_File_Attr)); + -- Check for object file consistency if requested if Opt.Check_Object_Consistency then - Current_Full_Lib_Stamp := File_Stamp (Current_Full_Lib_Name); + -- On most systems, this does not result in an extra system call + Current_Full_Lib_Stamp := OS_Time_To_GNAT_Time + (File_Time_Stamp (Name_Buffer'Address, Lib_File_Attr)); + + -- ??? One system call here Current_Full_Obj_Stamp := File_Stamp (Current_Full_Obj_Name); if Current_Full_Obj_Stamp (1) = ' ' then -- When the library is readonly always assume object is consistent + -- The call to Is_Writable_File only results in a system call on + -- some systems, but in most cases it has already been computed as + -- part of the call to File_Length above. + + 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 @@ -2203,10 +2416,6 @@ package body Osint is -- Read data from the file declare - Len : constant Integer := Integer (File_Length (Lib_FD)); - -- Length of source file text. If it doesn't fit in an integer - -- we're probably stuck anyway (>2 gigs of source seems a lot!) - Actual_Len : Integer := 0; Lo : constant Text_Ptr := 0; @@ -2482,21 +2691,23 @@ package body Osint is (N : File_Name_Type; T : File_Type) return Time_Stamp_Type is - Time_Stamp : Time_Stamp_Type; - + File : File_Name_Type; + Attr : aliased File_Attributes; begin if not File_Cache_Enabled then - return File_Stamp (Find_File (N, T)); + Find_File (N, T, File, Attr'Access); + else + Smart_Find_File (N, T, File, Attr); end if; - Time_Stamp := File_Stamp_Hash_Table.Get (N); - - if Time_Stamp (1) = ' ' then - Time_Stamp := File_Stamp (Smart_Find_File (N, T)); - File_Stamp_Hash_Table.Set (N, Time_Stamp); + if File = No_File then + return Empty_Time_Stamp; + else + Get_Name_String (File); + Name_Buffer (Name_Len + 1) := ASCII.NUL; + return OS_Time_To_GNAT_Time + (File_Time_Stamp (Name_Buffer'Address, Attr'Access)); end if; - - return Time_Stamp; end Smart_File_Stamp; --------------------- @@ -2507,21 +2718,38 @@ package body Osint is (N : File_Name_Type; T : File_Type) return File_Name_Type is - Full_File_Name : File_Name_Type; - + File : File_Name_Type; + Attr : File_Attributes; begin - 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; ---------------------- @@ -2951,6 +3179,9 @@ package body Osint is -- Package Initialization -- ---------------------------- + procedure Reset_File_Attributes (Attr : System.Address); + pragma Import (C, Reset_File_Attributes, "reset_attributes"); + begin Initialization : declare @@ -2966,7 +3197,15 @@ begin "__gnat_get_maximum_file_name_length"); -- Function to get maximum file name length for system + Sizeof_File_Attributes : Integer; + pragma Import (C, Sizeof_File_Attributes, + "size_of_file_attributes"); + begin + pragma Assert (Sizeof_File_Attributes <= File_Attributes_Size); + + Reset_File_Attributes (Unknown_Attributes'Address); + Identifier_Character_Set := Get_Default_Identifier_Character_Set; Maximum_File_Name_Length := Get_Maximum_File_Name_Length; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index b129add..741b28a 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -29,6 +29,7 @@ with Namet; use Namet; with Types; use Types; +with System.Storage_Elements; with System.OS_Lib; use System.OS_Lib; with System; use System; @@ -230,6 +231,47 @@ package Osint is -- this routine called with Name set to "gnat" will return "-lgnat-5.02" -- on UNIX and Windows and -lgnat_5_02 on VMS. + --------------------- + -- File attributes -- + --------------------- + -- The following subprograms offer services similar to those found in + -- System.OS_Lib, but with the ability to extra multiple information from + -- a single system call, depending on the system. This can result in fewer + -- system calls when reused. + -- In all these subprograms, the requested value is either read from the + -- File_Attributes parameter (resulting in no system call), or computed + -- from the disk and then cached in the File_Attributes parameter (possibly + -- along with other values). + + type File_Attributes is private; + Unknown_Attributes : constant File_Attributes; + -- A cache for various attributes for a file (length, accessibility,...) + -- This must be initialized to Unknown_Attributes prior to the first call. + + function Is_Directory + (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + function Is_Regular_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + function Is_Symbolic_Link + (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + -- Return the type of the file, + + function File_Length + (Name : C_File_Name; Attr : access File_Attributes) return Long_Integer; + -- Return the length (number of bytes) of the file + + function File_Time_Stamp + (Name : C_File_Name; Attr : access File_Attributes) return OS_Time; + -- Return the time stamp of the file + + function Is_Readable_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + function Is_Executable_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + function Is_Writable_File + (Name : C_File_Name; Attr : access File_Attributes) return Boolean; + -- Return the access rights for the file + ------------------------- -- Search Dir Routines -- ------------------------- @@ -380,6 +422,10 @@ package Osint is -- using Read_Source_File. Calling this routine entails no source file -- directory lookup penalty. + procedure Full_Source_Name + (N : File_Name_Type; + Full_File : out File_Name_Type; + Attr : access File_Attributes); function Full_Source_Name (N : File_Name_Type) return File_Name_Type; function Source_File_Stamp (N : File_Name_Type) return Time_Stamp_Type; -- Returns the full name/time stamp of the source file whose simple name @@ -390,6 +436,8 @@ package Osint is -- The source file directory lookup penalty is incurred every single time -- the routines are called unless you have previously called -- Source_File_Data (Cache => True). See below. + -- The procedural version also returns some file attributes for the ALI + -- file (to save on system calls later on). function Current_File_Index return Int; -- Return the index in its source file of the current main unit @@ -488,10 +536,14 @@ package Osint is function Read_Library_Info_From_Full (Full_Lib_File : File_Name_Type; + Lib_File_Attr : access File_Attributes; Fatal_Err : Boolean := False) return Text_Buffer_Ptr; -- Same as Read_Library_Info, except Full_Lib_File must contains the full -- path to the library file (instead of having Read_Library_Info recompute - -- it) + -- it). + -- Lib_File_Attr should be an initialized set of attributes for the + -- library file (it can be initialized to Unknown_Attributes, but in + -- general will have been initialized by a previous call to Find_File). function Full_Library_Info_Name return File_Name_Type; function Full_Object_File_Name return File_Name_Type; @@ -508,6 +560,10 @@ package Osint is -- It is an error to call Current_Object_File_Stamp if -- Opt.Check_Object_Consistency is set to False. + procedure Full_Lib_File_Name + (N : File_Name_Type; + Lib_File : out File_Name_Type; + Attr : out File_Attributes); function Full_Lib_File_Name (N : File_Name_Type) return File_Name_Type; -- Returns the full name of library file N. N should not include -- path information. Note that if the file cannot be located No_File is @@ -515,6 +571,8 @@ package Osint is -- for the second (this is not an error situation). The full name includes -- the appropriate directory information. The library file directory lookup -- penalty is incurred every single time this routine is called. + -- The procedural version also returns some file attributes for the ALI + -- file (to save on system calls later on). function Lib_File_Name (Source_File : File_Name_Type; @@ -660,4 +718,18 @@ private -- detected, the file being written is deleted, and a fatal error is -- signalled. + File_Attributes_Size : constant Integer := 50; + -- This should be big enough to fit a "struct file_attributes" on any + -- system. It doesn't matter if it is too big (which avoids the need for + -- either mapping the struct exactly or importing the sizeof from C, which + -- would result in dynamic code) + + type File_Attributes is + array (1 .. File_Attributes_Size) + of System.Storage_Elements.Storage_Element; + + Unknown_Attributes : constant File_Attributes := (others => 0); + -- Will be initialized properly at elaboration (for efficiency later on, + -- avoid function calls every time we want to reset the attributes). + end Osint; |