Skip to content

R
riscv-gcc-1
Commit 5644b7e8 by Arnaud Charlet
Options

[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
parent 0895ac08
Showing with 355 additions and 158 deletions
gcc/ada/ChangeLog
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.
......
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;
......
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;
......
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
......
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;
}
......
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)
......
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);
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment