aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-10-14 15:29:23 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2013-10-14 15:29:23 +0200
commit5644b7e8e7fcc55fe544949c58ce049039e671c9 (patch)
treee84bb877232a8e1517bc69224d07162ff4e174dc /gcc/ada
parent0895ac082ac9f48ab62051696ac3a61a5fe52939 (diff)
downloadgcc-5644b7e8e7fcc55fe544949c58ce049039e671c9.zip
gcc-5644b7e8e7fcc55fe544949c58ce049039e671c9.tar.gz
gcc-5644b7e8e7fcc55fe544949c58ce049039e671c9.tar.bz2
[multiple changes]
2013-10-14 Vincent Celier <celier@adacore.com> * snames.ads-tmpl: Add new standard name Library_Rpath_Options. 2013-10-14 Tristan Gingold <gingold@adacore.com> * sem_prag.adb (Process_Import_Or_Interface): Allow importing of exception using convention Cpp. * exp_prag.adb (Expand_Pragma_Import_Or_Interface): Expand cpp imported exceptions. * raise-gcc.c (is_handled_by): Filter C++ exception occurrences. * gnat_rm.texi: Document how to import C++ exceptions. 2013-10-14 Jose Ruiz <ruiz@adacore.com> * sem_ch13.adb (Sem_Ch13.Analyze_Aspect_Specification): For Priority and CPU aspects, when checking, issue a warning only if it is obviously not a main program. 2013-10-14 Tristan Gingold <gingold@adacore.com> * adaint.c: Fix condition for AIX. Minor reformatting. From-SVN: r203549
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog23
-rw-r--r--gcc/ada/adaint.c320
-rw-r--r--gcc/ada/exp_prag.adb58
-rw-r--r--gcc/ada/gnat_rm.texi24
-rw-r--r--gcc/ada/raise-gcc.c46
-rw-r--r--gcc/ada/sem_ch13.adb13
-rw-r--r--gcc/ada/sem_prag.adb28
-rw-r--r--gcc/ada/snames.ads-tmpl1
8 files changed, 355 insertions, 158 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ed67161..261885c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2013-10-14 Vincent Celier <celier@adacore.com>
+
+ * snames.ads-tmpl: Add new standard name Library_Rpath_Options.
+
+2013-10-14 Tristan Gingold <gingold@adacore.com>
+
+ * sem_prag.adb (Process_Import_Or_Interface): Allow importing
+ of exception using convention Cpp.
+ * exp_prag.adb (Expand_Pragma_Import_Or_Interface): Expand cpp
+ imported exceptions.
+ * raise-gcc.c (is_handled_by): Filter C++ exception occurrences.
+ * gnat_rm.texi: Document how to import C++ exceptions.
+
+2013-10-14 Jose Ruiz <ruiz@adacore.com>
+
+ * sem_ch13.adb (Sem_Ch13.Analyze_Aspect_Specification): For
+ Priority and CPU aspects, when checking, issue a warning only
+ if it is obviously not a main program.
+
+2013-10-14 Tristan Gingold <gingold@adacore.com>
+
+ * adaint.c: Fix condition for AIX. Minor reformatting.
+
2013-10-14 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_prag.adb, prj.ads: Minor reformatting.
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index ff65bd7..e5a50a8 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -158,9 +158,9 @@ UINT CurrentCodePage;
#define GCC_RESOURCE_H
#include <sys/wait.h>
#elif defined (__nucleus__)
-/* No wait() or waitpid() calls available */
+/* No wait() or waitpid() calls available. */
#else
-/* Default case */
+/* Default case. */
#include <sys/wait.h>
#endif
@@ -182,10 +182,12 @@ UINT CurrentCodePage;
/* Use native 64-bit arithmetic. */
#define unix_time_to_vms(X,Y) \
- { unsigned long long reftime, tmptime = (X); \
+ { \
+ unsigned long long reftime, tmptime = (X); \
$DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
- SYS$BINTIM (&unixtime, &reftime); \
- Y = tmptime * 10000000 + reftime; }
+ SYS$BINTIM (&unixtime, &reftime); \
+ Y = tmptime * 10000000 + reftime; \
+ }
/* descrip.h doesn't have everything ... */
typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) ));
@@ -213,8 +215,8 @@ struct vstring
#define SYI$_ACTIVECPU_CNT 0x111e
extern int LIB$GETSYI (int *, unsigned int *);
-extern unsigned int LIB$CALLG_64
- ( unsigned long long argument_list [], int (*user_procedure)(void));
+extern unsigned int LIB$CALLG_64 (unsigned long long argument_list [],
+ int (*user_procedure)(void));
#else
#include <utime.h>
@@ -266,7 +268,7 @@ extern unsigned int LIB$CALLG_64
#define DIR_SEPARATOR '/'
#endif
-/* Check for cross-compilation */
+/* Check for cross-compilation. */
#if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
#define IS_CROSS 1
int __gnat_is_cross_compiler = 1;
@@ -382,13 +384,14 @@ to_ptr32 (char **ptr64)
int argc;
__char_ptr_char_ptr32 short_argv;
- for (argc=0; ptr64[argc]; argc++);
+ for (argc = 0; ptr64[argc]; argc++)
+ ;
- /* Reallocate argv with 32 bit pointers. */
+ /* Reallocate argv with 32 bit pointers. */
short_argv = (__char_ptr_char_ptr32) decc$malloc
(sizeof (__char_ptr32) * (argc + 1));
- for (argc=0; ptr64[argc]; argc++)
+ for (argc = 0; ptr64[argc]; argc++)
short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
short_argv[argc] = (__char_ptr32) 0;
@@ -405,8 +408,7 @@ static const char ATTR_UNSET = 127;
/* Reset the file attributes as if no system call had been performed */
void
-__gnat_reset_attributes
- (struct file_attributes* attr)
+__gnat_reset_attributes (struct file_attributes* attr)
{
attr->exists = ATTR_UNSET;
@@ -423,8 +425,7 @@ __gnat_reset_attributes
}
OS_Time
-__gnat_current_time
- (void)
+__gnat_current_time (void)
{
time_t res = time (NULL);
return (OS_Time) res;
@@ -435,8 +436,7 @@ __gnat_current_time
long. */
void
-__gnat_current_time_string
- (char *result)
+__gnat_current_time_string (char *result)
{
const char *format = "%Y-%m-%d %H:%M:%S";
/* Format string necessary to describe the ISO 8601 format */
@@ -455,14 +455,8 @@ __gnat_current_time_string
}
void
-__gnat_to_gm_time
- (OS_Time *p_time,
- int *p_year,
- int *p_month,
- int *p_day,
- int *p_hours,
- int *p_mins,
- int *p_secs)
+__gnat_to_gm_time (OS_Time *p_time, int *p_year, int *p_month, int *p_day,
+ int *p_hours, int *p_mins, int *p_secs)
{
struct tm *res;
time_t time = (time_t) *p_time;
@@ -1877,9 +1871,8 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
int
__gnat_file_exists_attr (char* name, struct file_attributes* attr)
{
- if (attr->exists == ATTR_UNSET) {
- __gnat_stat_to_attr (-1, name, attr);
- }
+ if (attr->exists == ATTR_UNSET)
+ __gnat_stat_to_attr (-1, name, attr);
return attr->exists;
}
@@ -1934,9 +1927,8 @@ __gnat_is_absolute_path (char *name, int length)
int
__gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
{
- if (attr->regular == ATTR_UNSET) {
- __gnat_stat_to_attr (-1, name, attr);
- }
+ if (attr->regular == ATTR_UNSET)
+ __gnat_stat_to_attr (-1, name, attr);
return attr->regular;
}
@@ -1945,6 +1937,7 @@ int
__gnat_is_regular_file (char *name)
{
struct file_attributes attr;
+
__gnat_reset_attributes (&attr);
return __gnat_is_regular_file_attr (name, &attr);
}
@@ -1952,9 +1945,8 @@ __gnat_is_regular_file (char *name)
int
__gnat_is_directory_attr (char* name, struct file_attributes* attr)
{
- if (attr->directory == ATTR_UNSET) {
- __gnat_stat_to_attr (-1, name, attr);
- }
+ if (attr->directory == ATTR_UNSET)
+ __gnat_stat_to_attr (-1, name, attr);
return attr->directory;
}
@@ -1963,6 +1955,7 @@ int
__gnat_is_directory (char *name)
{
struct file_attributes attr;
+
__gnat_reset_attributes (&attr);
return __gnat_is_directory_attr (name, &attr);
}
@@ -1994,7 +1987,8 @@ GetDriveTypeFromPath (TCHAR *wfullpath)
/* Is this a relative path, if so get current drive type. */
if (wpath[0] != _T('\\') ||
- (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
+ (_tcslen (wpath) > 2 && wpath[0] == _T('\\')
+ && wpath[1] != _T('\\')))
return GetDriveType (NULL);
UINT result = GetDriveType (wpath);
@@ -2012,7 +2006,8 @@ GetDriveTypeFromPath (TCHAR *wfullpath)
LPTSTR b = _tcschr (p, _T('\\'));
if (b != NULL)
- { /* logical drive \\.\c\dir\file */
+ {
+ /* logical drive \\.\c\dir\file */
*b++ = _T(':');
*b++ = _T('\\');
*b = _T('\0');
@@ -2027,12 +2022,11 @@ GetDriveTypeFromPath (TCHAR *wfullpath)
}
}
-/* This MingW section contains code to work with ACL. */
+/* This MingW section contains code to work with ACL. */
static int
-__gnat_check_OWNER_ACL
-(TCHAR *wname,
- DWORD CheckAccessDesired,
- GENERIC_MAPPING CheckGenericMapping)
+__gnat_check_OWNER_ACL (TCHAR *wname,
+ DWORD CheckAccessDesired,
+ GENERIC_MAPPING CheckGenericMapping)
{
DWORD dwAccessDesired, dwAccessAllowed;
PRIVILEGE_SET PrivilegeSet;
@@ -2051,7 +2045,7 @@ __gnat_check_OWNER_ACL
(GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
return 0;
- /* Obtain the security descriptor. */
+ /* Obtain the security descriptor. */
if (!GetFileSecurity
(wname, OWNER_SECURITY_INFORMATION |
@@ -2099,10 +2093,9 @@ __gnat_check_OWNER_ACL
}
static void
-__gnat_set_OWNER_ACL
-(TCHAR *wname,
- DWORD AccessMode,
- DWORD AccessPermissions)
+__gnat_set_OWNER_ACL (TCHAR *wname,
+ DWORD AccessMode,
+ DWORD AccessPermissions)
{
PACL pOldDACL = NULL;
PACL pNewDACL = NULL;
@@ -2160,26 +2153,27 @@ __gnat_can_use_acl (TCHAR *wname)
int
__gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
{
- if (attr->readable == ATTR_UNSET) {
+ if (attr->readable == ATTR_UNSET)
+ {
#if defined (_WIN32) && !defined (RTX)
- TCHAR wname [GNAT_MAX_PATH_LEN + 2];
- GENERIC_MAPPING GenericMapping;
+ TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+ GENERIC_MAPPING GenericMapping;
- S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+ S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
- if (__gnat_can_use_acl (wname))
- {
- ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
- GenericMapping.GenericRead = GENERIC_READ;
- attr->readable =
- __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
- }
- else
- attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
+ if (__gnat_can_use_acl (wname))
+ {
+ ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+ GenericMapping.GenericRead = GENERIC_READ;
+ attr->readable =
+ __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
+ }
+ else
+ attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
- __gnat_stat_to_attr (-1, name, attr);
+ __gnat_stat_to_attr (-1, name, attr);
#endif
- }
+ }
return attr->readable;
}
@@ -2188,6 +2182,7 @@ int
__gnat_is_readable_file (char *name)
{
struct file_attributes attr;
+
__gnat_reset_attributes (&attr);
return __gnat_is_readable_file_attr (name, &attr);
}
@@ -2195,29 +2190,31 @@ __gnat_is_readable_file (char *name)
int
__gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
{
- if (attr->writable == ATTR_UNSET) {
+ if (attr->writable == ATTR_UNSET)
+ {
#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;
- attr->writable = __gnat_check_OWNER_ACL
+ 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
+ attr->writable =
+ !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
#else
- __gnat_stat_to_attr (-1, name, attr);
+ __gnat_stat_to_attr (-1, name, attr);
#endif
- }
+ }
return attr->writable;
}
@@ -2226,6 +2223,7 @@ int
__gnat_is_writable_file (char *name)
{
struct file_attributes attr;
+
__gnat_reset_attributes (&attr);
return __gnat_is_writable_file_attr (name, &attr);
}
@@ -2233,36 +2231,39 @@ __gnat_is_writable_file (char *name)
int
__gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
{
- if (attr->executable == ATTR_UNSET) {
+ if (attr->executable == ATTR_UNSET)
+ {
#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;
- attr->executable =
- __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
- }
- else
- {
- TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
+ attr->executable =
+ __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
+ }
+ else
+ {
+ TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
- /* look for last .exe */
- if (last)
- while ((l = _tcsstr(last+1, _T(".exe")))) last = l;
+ /* look for last .exe */
+ if (last)
+ while ((l = _tcsstr(last+1, _T(".exe"))))
+ last = l;
- attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
- && (last - wname) == (int) (_tcslen (wname) - 4);
- }
+ attr->executable =
+ GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
+ && (last - wname) == (int) (_tcslen (wname) - 4);
+ }
#else
- __gnat_stat_to_attr (-1, name, attr);
+ __gnat_stat_to_attr (-1, name, attr);
#endif
- }
+ }
return attr->regular && attr->executable;
}
@@ -2271,6 +2272,7 @@ int
__gnat_is_executable_file (char *name)
{
struct file_attributes attr;
+
__gnat_reset_attributes (&attr);
return __gnat_is_executable_file_attr (name, &attr);
}
@@ -2399,19 +2401,20 @@ int
__gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
struct file_attributes* attr)
{
- if (attr->symbolic_link == ATTR_UNSET) {
+ if (attr->symbolic_link == ATTR_UNSET)
+ {
#if defined (__vxworks) || defined (__nucleus__)
- attr->symbolic_link = 0;
+ attr->symbolic_link = 0;
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
- int ret;
- GNAT_STRUCT_STAT statbuf;
- ret = GNAT_LSTAT (name, &statbuf);
- attr->symbolic_link = (!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
- attr->symbolic_link = 0;
+ attr->symbolic_link = 0;
#endif
- }
+ }
return attr->symbolic_link;
}
@@ -2419,9 +2422,9 @@ int
__gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
{
struct file_attributes attr;
+
__gnat_reset_attributes (&attr);
return __gnat_is_symbolic_link_attr (name, &attr);
-
}
#if defined (sun) && defined (__SVR4)
@@ -2576,7 +2579,9 @@ __gnat_number_of_cpus (void)
for locking and unlocking tasks since we do not support multiple
threads on this configuration (Cert run time on native Windows). */
-void dummy (void) {}
+static void dummy (void)
+{
+}
void (*Lock_Task) () = &dummy;
void (*Unlock_Task) () = &dummy;
@@ -2836,8 +2841,8 @@ __gnat_os_exit (int status)
/* Locate file on path, that matches a predicate */
char *
-__gnat_locate_file_with_predicate
- (char *file_name, char *path_val, int (*predicate)(char*))
+__gnat_locate_file_with_predicate (char *file_name, char *path_val,
+ int (*predicate)(char *))
{
char *ptr;
char *file_path = (char *) alloca (strlen (file_name) + 1);
@@ -3118,7 +3123,7 @@ __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
/* Return the next filespec in the list. */
char *
-__gnat_to_canonical_file_list_next ()
+__gnat_to_canonical_file_list_next (void)
{
return new_canonical_filelist[new_canonical_filelist_index++];
}
@@ -3126,7 +3131,7 @@ __gnat_to_canonical_file_list_next ()
/* Free storage used in the wildcard expansion. */
void
-__gnat_to_canonical_file_list_free ()
+__gnat_to_canonical_file_list_free (void)
{
int i;
@@ -3144,7 +3149,7 @@ __gnat_to_canonical_file_list_free ()
/* The functional equivalent of decc$translate_vms routine.
Designed to produce the same output, but is protected against
malformed paths (original version ACCVIOs in this case) and
- does not require VMS-specific DECC RTL */
+ does not require VMS-specific DECC RTL. */
#define NAM$C_MAXRSS 1024
@@ -3161,13 +3166,13 @@ __gnat_translate_vms (char *src)
srcendpos = strchr (src, '\0');
retpos = retbuf;
- /* Look for the node and/or device in front of the path */
+ /* Look for the node and/or device in front of the path. */
pos1 = src;
pos2 = strchr (pos1, ':');
if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':'))
{
- /* There is a node name. "node_name::" becomes "node_name!" */
+ /* There is a node name. "node_name::" becomes "node_name!". */
disp = pos2 - pos1;
strncpy (retbuf, pos1, disp);
retpos [disp] = '!';
@@ -3178,7 +3183,7 @@ __gnat_translate_vms (char *src)
if (pos2)
{
- /* There is a device name. "dev_name:" becomes "/dev_name/" */
+ /* There is a device name. "dev_name:" becomes "/dev_name/". */
*(retpos++) = '/';
disp = pos2 - pos1;
strncpy (retpos, pos1, disp);
@@ -3188,7 +3193,7 @@ __gnat_translate_vms (char *src)
}
else
/* No explicit device; we must look ahead and prepend /sys$disk/ if
- the path is absolute */
+ the path is absolute. */
if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
&& !strchr (".-]>", *(pos1 + 1)))
{
@@ -3196,14 +3201,14 @@ __gnat_translate_vms (char *src)
retpos += 10;
}
- /* Process the path part */
+ /* Process the path part. */
while (*pos1 == '[' || *pos1 == '<')
{
path_present++;
pos1++;
if (*pos1 == ']' || *pos1 == '>')
{
- /* Special case, [] translates to '.' */
+ /* Special case, [] translates to '.'. */
*(retpos++) = '.';
pos1++;
}
@@ -3211,7 +3216,7 @@ __gnat_translate_vms (char *src)
{
/* '[000000' means root dir. It can be present in the middle of
the path due to expansion of logical devices, in which case
- we skip it */
+ we skip it. */
if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
(*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.'))
{
@@ -3220,24 +3225,27 @@ __gnat_translate_vms (char *src)
}
else if (*pos1 == '.')
{
- /* Relative path */
+ /* Relative path. */
*(retpos++) = '.';
}
- /* There is a qualified path */
+ /* There is a qualified path. */
while (*pos1 && *pos1 != ']' && *pos1 != '>')
{
switch (*pos1)
{
case '.':
- /* '.' is used to separate directories. Replace it with '/' but
- only if there isn't already '/' just before */
+ /* '.' is used to separate directories. Replace it with '/'
+ but only if there isn't already '/' just before. */
if (*(retpos - 1) != '/')
*(retpos++) = '/';
pos1++;
- if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.')
+ if (pos1 + 1 < srcendpos
+ && *pos1 == '.'
+ && *(pos1 + 1) == '.')
{
- /* ellipsis refers to entire subtree; replace with '**' */
+ /* Ellipsis refers to entire subtree; replace
+ with '**'. */
*(retpos++) = '*';
*(retpos++) = '*';
*(retpos++) = '/';
@@ -3245,8 +3253,8 @@ __gnat_translate_vms (char *src)
}
break;
case '-' :
- /* When after '.' '[' '<' is equivalent to Unix ".." but there
- may be several in a row */
+ /* When after '.' '[' '<' is equivalent to Unix ".." but
+ there may be several in a row. */
if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
*(pos1 - 1) == '<')
{
@@ -3260,7 +3268,7 @@ __gnat_translate_vms (char *src)
retpos--;
break;
}
- /* otherwise fall through to default */
+ /* Otherwise fall through to default. */
default:
*(retpos++) = *(pos1++);
}
@@ -3500,7 +3508,7 @@ __gnat_to_host_file_spec (char *filespec)
}
void
-__gnat_adjust_os_resource_limits ()
+__gnat_adjust_os_resource_limits (void)
{
SYS$ADJWSL (131072, 0);
}
@@ -3510,8 +3518,8 @@ __gnat_adjust_os_resource_limits ()
/* Dummy functions for Osint import for non-VMS systems. */
int
-__gnat_to_canonical_file_list_init
- (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
+__gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED,
+ int onlydirs ATTRIBUTE_UNUSED)
{
return 0;
}
@@ -3567,7 +3575,7 @@ __gnat_adjust_os_resource_limits (void)
#if defined (__mips_vxworks)
int
-_flush_cache()
+_flush_cache (void)
{
CACHE_USER_FLUSH (0, ENTIRE_CACHE);
}
@@ -3811,9 +3819,9 @@ __gnat_sals_init_using_constructors (void)
we introduce an intermediate procedure to link against the corresponding
one in each situation. */
-extern void GetTimeAsFileTime(LPFILETIME pTime);
+extern void GetTimeAsFileTime (LPFILETIME pTime);
-void GetTimeAsFileTime(LPFILETIME pTime)
+void GetTimeAsFileTime (LPFILETIME pTime)
{
#ifdef RTSS
RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
@@ -3829,7 +3837,9 @@ void GetTimeAsFileTime(LPFILETIME pTime)
extern void __main (void);
-void __main (void) {}
+void __main (void)
+{
+}
#endif /* RTSS */
#endif /* RTX */
@@ -3837,7 +3847,8 @@ void __main (void) {}
#include <pthread.h>
-void *__gnat_lwp_self (void)
+void *
+__gnat_lwp_self (void)
{
return (void *) pthread_self ();
}
@@ -3847,7 +3858,8 @@ void *__gnat_lwp_self (void)
thread. We need to do a system call in order to retrieve this
information. */
#include <sys/syscall.h>
-void *__gnat_lwp_self (void)
+void *
+__gnat_lwp_self (void)
{
return (void *) syscall (__NR_gettid);
}
@@ -3862,27 +3874,32 @@ void *__gnat_lwp_self (void)
/* Dynamic cpu sets */
-cpu_set_t *__gnat_cpu_alloc (size_t count)
+cpu_set_t *
+__gnat_cpu_alloc (size_t count)
{
return CPU_ALLOC (count);
}
-size_t __gnat_cpu_alloc_size (size_t count)
+size_t
+__gnat_cpu_alloc_size (size_t count)
{
return CPU_ALLOC_SIZE (count);
}
-void __gnat_cpu_free (cpu_set_t *set)
+void
+__gnat_cpu_free (cpu_set_t *set)
{
CPU_FREE (set);
}
-void __gnat_cpu_zero (size_t count, cpu_set_t *set)
+void
+__gnat_cpu_zero (size_t count, cpu_set_t *set)
{
CPU_ZERO_S (count, set);
}
-void __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
+void
+__gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
{
/* Ada handles CPU numbers starting from 1, while C identifies the first
CPU by a 0, so we need to adjust. */
@@ -3893,27 +3910,32 @@ void __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
/* Static cpu sets */
-cpu_set_t *__gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
+cpu_set_t *
+__gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
{
return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
}
-size_t __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
+size_t
+__gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
{
return sizeof (cpu_set_t);
}
-void __gnat_cpu_free (cpu_set_t *set)
+void
+__gnat_cpu_free (cpu_set_t *set)
{
free (set);
}
-void __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
+void
+__gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
{
CPU_ZERO (set);
}
-void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
+void
+__gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
{
/* Ada handles CPU numbers starting from 1, while C identifies the first
CPU by a 0, so we need to adjust. */
@@ -3931,7 +3953,7 @@ void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
#include <mach-o/dyld.h>
#elif 0 && defined (__linux__)
#include <link.h>
-#elif defined (__AIX__)
+#elif defined (_AIX)
#include <sys/ldr.h>
#endif
@@ -3947,7 +3969,7 @@ __gnat_get_executable_load_address (void)
return (const void *)map->l_addr;
-#elif defined (__AIX__)
+#elif defined (_AIX)
/* Unfortunately, AIX wants to return the info for all loaded objects,
so we need to increase the buffer if too small. */
size_t blen = 4096;
diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 0ace377..f47ed1a 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -575,6 +575,64 @@ package body Exp_Prag is
if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
Set_Expression (Parent (Def_Id), Empty);
end if;
+ elsif Ekind (Def_Id) = E_Exception
+ and then Convention (Def_Id) = Convention_CPP
+ then
+
+ -- Import a C++ convention
+
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Exdata : List_Id;
+ Lang_Char : Node_Id;
+ Foreign_Data : Node_Id;
+ Rtti_Name : constant Node_Id := Arg3 (N);
+ Dum : constant Entity_Id := Make_Temporary (Loc, 'D');
+
+ begin
+ Exdata := Component_Associations (Expression (Parent (Def_Id)));
+
+ Lang_Char := Next (First (Exdata));
+
+ -- Change the one-character language designator to 'C'
+
+ Rewrite (Expression (Lang_Char),
+ Make_Character_Literal (Loc,
+ Chars => Name_uC,
+ Char_Literal_Value =>
+ UI_From_Int (Character'Pos ('C'))));
+ Analyze (Expression (Lang_Char));
+
+ -- Change the value of Foreign_Data
+
+ Foreign_Data := Next (Next (Next (Next (Lang_Char))));
+
+ Insert_Actions (Def_Id, New_List (
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Dum,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Character, Loc)),
+
+ Make_Pragma (Loc,
+ Chars => Name_Import,
+ Pragma_Argument_Associations => New_List (
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Make_Identifier (Loc, Name_Ada)),
+
+ Make_Pragma_Argument_Association (Loc,
+ Expression => Make_Identifier (Loc, Chars (Dum))),
+
+ Make_Pragma_Argument_Association (Loc,
+ Chars => Name_Link_Name,
+ Expression => Relocate_Node (Rtti_Name))))));
+
+ Rewrite (Expression (Foreign_Data),
+ Unchecked_Convert_To (Standard_A_Char,
+ Make_Attribute_Reference (Loc,
+ Prefix => Make_Identifier (Loc, Chars (Dum)),
+ Attribute_Name => Name_Address)));
+ Analyze (Expression (Foreign_Data));
+ end;
end if;
end Expand_Pragma_Import_Or_Interface;
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index c10ba33..68a2969 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -11963,6 +11963,7 @@ where @var{nnn} is an integer.
@emph{Exception_Name:} nnnnn
@emph{Message:} mmmmm
@emph{PID:} ppp
+@emph{Load address:} 0xhhhh
@emph{Call stack traceback locations:}
0xhhhh 0xhhhh 0xhhhh ... 0xhhh
@end smallexample
@@ -11984,10 +11985,12 @@ present only if the Process Id is nonzero). Currently we are
not making use of this field.
@item
-The Call stack traceback locations line and the following values
-are present only if at least one traceback location was recorded.
-The values are given in C style format, with lower case letters
-for a-f, and only as many digits present as are necessary.
+The Load address line, the Call stack traceback locations line and the
+following values are present only if at least one traceback location was
+recorded. The Load address indicates the address at which the main executable
+was loaded; this line may not be present if operating system hasn't relocated
+the main executable. The values are given in C style format, with lower case
+letters for a-f, and only as many digits present as are necessary.
@end itemize
@noindent
@@ -18874,6 +18877,19 @@ occurrence has no message, and the simple name of the exception identity
contains @samp{Foreign_Exception}. Finalization and awaiting dependent
tasks works properly when such foreign exceptions are propagated.
+It is also possible to import a C++ exception using the following syntax:
+
+@smallexample @c ada
+LOCAL_NAME : exception;
+pragma Import (Cpp,
+ [Entity =>] LOCAL_NAME,
+ [External_Name =>] static_string_EXPRESSION);
+@end smallexample
+
+@noident
+The @code{External_Name} is the name of the C++ RTTI symbol. You can then
+cover a specific C++ exception in an exception handler.
+
@node Interfacing to COBOL
@section Interfacing to COBOL
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index 897dca2..5d32167 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -87,6 +87,36 @@ extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
#define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
#define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
+/* Structure of a C++ exception, represented as a C structure... See
+ unwind-cxx.h for the full definition. */
+
+struct __cxa_exception
+{
+ void *exceptionType;
+ void (*exceptionDestructor)(void *);
+
+ void (*unexpectedHandler)();
+ void (*terminateHandler)();
+
+ struct __cxa_exception *nextException;
+
+ int handlerCount;
+
+#ifdef __ARM_EABI_UNWINDER__
+ struct __cxa_exception* nextPropagatingException;
+
+ int propagationCount;
+#else
+ int handlerSwitchValue;
+ const unsigned char *actionRecord;
+ const unsigned char *languageSpecificData;
+ _Unwind_Ptr catchTemp;
+ void *adjustedPtr;
+#endif
+
+ _Unwind_Exception unwindHeader;
+};
+
/* --------------------------------------------------------------
-- The DB stuff below is there for debugging purposes only. --
-------------------------------------------------------------- */
@@ -882,6 +912,22 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
|| choice == (_Unwind_Ptr) &Foreign_Exception)
return handler;
+ /* C++ exception occurrences. */
+ if (propagated_exception->common.exception_class == CXX_EXCEPTION_CLASS
+ && Language_For (choice) == 'C')
+ {
+ void *choice_typeinfo = Foreign_Data_For (choice);
+ void *except_typeinfo =
+ (((struct __cxa_exception *)
+ ((_Unwind_Exception *)propagated_exception + 1)) - 1)->exceptionType;
+
+ /* Typeinfo are directly compared, which might not be correct if they
+ aren't merged. ??? We should call the == operator if this module is
+ compiled in C++. */
+ if (choice_typeinfo == except_typeinfo)
+ return handler;
+ }
+
return nothing;
}
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 0264d31..aacb84c 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1834,11 +1834,14 @@ package body Sem_Ch13 is
Flag_Non_Static_Expr
("aspect requires static expression!", Expr);
- -- Check whether this is the main subprogram
-
- elsif Current_Sem_Unit /= Main_Unit
- and then
- Cunit_Entity (Current_Sem_Unit) /= Main_Unit_Entity
+ -- Check whether this is the main subprogram. Issue a
+ -- warning only if it is obviously not a main program
+ -- (when it has parameters or when the subprogram is
+ -- within a package).
+
+ elsif Present (Parameter_Specifications
+ (Specification (N)))
+ or else not Is_Compilation_Unit (Defining_Entity (N))
then
-- See ARM D.1 (14/3) and D.16 (12/3)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 661b3d0..133ee6a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -7126,6 +7126,34 @@ package body Sem_Prag is
Check_CPP_Type_Has_No_Defaults (Def_Id);
end if;
+ -- Import a CPP exception
+
+ elsif C = Convention_CPP
+ and then Ekind (Def_Id) = E_Exception
+ then
+ if No (Arg3) then
+ Error_Pragma_Arg
+ ("'External_'Name arguments is required for 'Cpp exception",
+ Arg3);
+ else
+ -- As only a string is allowed, Check_Arg_Is_External_Name
+ -- isn't called.
+ Check_Arg_Is_Static_Expression (Arg3, Standard_String);
+ end if;
+
+ if Present (Arg4) then
+ Error_Pragma_Arg
+ ("Link_Name argument not allowed for imported Cpp exception",
+ Arg4);
+ end if;
+
+ -- Do not call Set_Interface_Name as the name of the exception
+ -- shouldn't be modified (and in particular it shouldn't be
+ -- the External_Name). For exceptions, the External_Name is the
+ -- name of the RTTI structure.
+
+ -- ??? Emit an error if pragma Import/Export_Exception is present
+
elsif Nkind (Parent (Def_Id)) = N_Incomplete_Type_Declaration then
Check_No_Link_Name;
Check_Arg_Count (3);
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 69eb42e..74702f8 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -1302,6 +1302,7 @@ package Snames is
Name_Library_Options : constant Name_Id := N + $;
Name_Library_Partial_Linker : constant Name_Id := N + $;
Name_Library_Reference_Symbol_File : constant Name_Id := N + $;
+ Name_Library_Rpath_Options : constant Name_Id := N + $; -- GB
Name_Library_Standalone : constant Name_Id := N + $;
Name_Library_Encapsulated_Options : constant Name_Id := N + $; -- GB
Name_Library_Encapsulated_Supported : constant Name_Id := N + $; -- GB