Commit 5ae7c3cf by Arnaud Charlet

[multiple changes]

2015-02-20  Arnaud Charlet  <charlet@adacore.com>

	* sysdep.c, expect.c, s-oscons-tmplt.c, gsocket.h, adaint.c: Remove
	obsolete references to RTX, nucleus, VMS.

2015-02-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Fix_Error): For an illegal Type_Invariant'Class
	aspect, use name that mentions Class explicitly, rather than
	compiler-internal name.

2015-02-20  Robert Dewar  <dewar@adacore.com>

	* debug.adb: Add documentation for -gnatd.2 (allow statements
	in decl sequences).
	* par-ch3.adb (P_Identifier_Declarations): Handle
	statement appearing where declaration expected more cleanly.
	(Statement_When_Declaration_Expected): Implement debug flag
	-gnatd.2.

2015-02-20  Jose Ruiz  <ruiz@adacore.com>

	* a-dinopr.ads: Add spec for this package (Unimplemented_Unit).
	* a-dispat.ads (Yield): Include procedure added in Ada 2012.
	* a-dispat.adb (Yield): Implement procedure added in Ada 2012.
	* impunit.adb (Non_Imp_File_Names_05): Mark unit a-dinopr.ads as
	defined by Ada 2005.
	* snames.ads-tmpl (Name_Non_Preemptive_FIFO_Within_Priorities):
	This is the correct name for the dispatching policy (FIFO was
	missing).

2015-02-20  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve_Type_Conversion): If the type of the
	operand is the limited-view of a class-wide type then recover
	the class-wide type of the non-limited view.

From-SVN: r220852
parent 5865a63d
2015-02-20 Arnaud Charlet <charlet@adacore.com> 2015-02-20 Arnaud Charlet <charlet@adacore.com>
* sysdep.c, expect.c, s-oscons-tmplt.c, gsocket.h, adaint.c: Remove
obsolete references to RTX, nucleus, VMS.
2015-02-20 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb (Fix_Error): For an illegal Type_Invariant'Class
aspect, use name that mentions Class explicitly, rather than
compiler-internal name.
2015-02-20 Robert Dewar <dewar@adacore.com>
* debug.adb: Add documentation for -gnatd.2 (allow statements
in decl sequences).
* par-ch3.adb (P_Identifier_Declarations): Handle
statement appearing where declaration expected more cleanly.
(Statement_When_Declaration_Expected): Implement debug flag
-gnatd.2.
2015-02-20 Jose Ruiz <ruiz@adacore.com>
* a-dinopr.ads: Add spec for this package (Unimplemented_Unit).
* a-dispat.ads (Yield): Include procedure added in Ada 2012.
* a-dispat.adb (Yield): Implement procedure added in Ada 2012.
* impunit.adb (Non_Imp_File_Names_05): Mark unit a-dinopr.ads as
defined by Ada 2005.
* snames.ads-tmpl (Name_Non_Preemptive_FIFO_Within_Priorities):
This is the correct name for the dispatching policy (FIFO was
missing).
2015-02-20 Javier Miranda <miranda@adacore.com>
* sem_res.adb (Resolve_Type_Conversion): If the type of the
operand is the limited-view of a class-wide type then recover
the class-wide type of the non-limited view.
2015-02-20 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Makefile.in: Remove references to nucleus. * gcc-interface/Makefile.in: Remove references to nucleus.
* gcc-interface/decl.c (gnat_to_gnu_entity, case E_Procedure): Set * gcc-interface/decl.c (gnat_to_gnu_entity, case E_Procedure): Set
extern_flag to true for Inline_Always subprograms with extern_flag to true for Inline_Always subprograms with
......
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I S P A T C H I N G . N O N _ P R E E M P T I V E --
-- --
-- S p e c --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
-- This unit is not implemented in typical GNAT implementations that lie on
-- top of operating systems, because it is infeasible to implement in such
-- environments.
-- If a target environment provides appropriate support for this package,
-- then the Unimplemented_Unit pragma should be removed from this spec and
-- an appropriate body provided.
package Ada.Dispatching.Non_Preemptive is
pragma Preelaborate (Non_Preemptive);
pragma Unimplemented_Unit;
procedure Yield_To_Higher;
procedure Yield_To_Same_Or_Higher renames Yield;
end Ada.Dispatching.Non_Preemptive;
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . D I S P A T C H I N G --
-- --
-- B o d y --
-- --
-- Copyright (C) 2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Exceptions;
with System.Tasking;
with System.Task_Primitives.Operations;
package body Ada.Dispatching is
procedure Yield is
Self_Id : constant System.Tasking.Task_Id :=
System.Task_Primitives.Operations.Self;
begin
-- If pragma Detect_Blocking is active, Program_Error must be
-- raised if this potentially blocking operation is called from a
-- protected action.
if System.Tasking.Detect_Blocking
and then Self_Id.Common.Protected_Action_Nesting > 0
then
Ada.Exceptions.Raise_Exception
(Program_Error'Identity, "potentially blocking operation");
else
System.Task_Primitives.Operations.Yield;
end if;
end Yield;
end Ada.Dispatching;
...@@ -14,7 +14,9 @@ ...@@ -14,7 +14,9 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
package Ada.Dispatching is package Ada.Dispatching is
pragma Pure (Dispatching); pragma Preelaborate (Dispatching);
procedure Yield;
Dispatching_Policy_Error : exception; Dispatching_Policy_Error : exception;
end Ada.Dispatching; end Ada.Dispatching;
...@@ -108,16 +108,11 @@ extern "C" { ...@@ -108,16 +108,11 @@ extern "C" {
#if defined (__MINGW32__) || defined (__CYGWIN__) #if defined (__MINGW32__) || defined (__CYGWIN__)
#if defined (RTX)
#include <windows.h>
#include <Rtapi.h>
#else
#include "mingw32.h" #include "mingw32.h"
/* Current code page and CCS encoding to use, set in initialize.c. */ /* Current code page and CCS encoding to use, set in initialize.c. */
UINT CurrentCodePage; UINT CurrentCodePage;
UINT CurrentCCSEncoding; UINT CurrentCCSEncoding;
#endif
#include <sys/utime.h> #include <sys/utime.h>
...@@ -157,7 +152,7 @@ UINT CurrentCCSEncoding; ...@@ -157,7 +152,7 @@ UINT CurrentCCSEncoding;
preventing the inclusion of the GCC header from doing anything. */ preventing the inclusion of the GCC header from doing anything. */
# define GCC_RESOURCE_H # define GCC_RESOURCE_H
# include <sys/wait.h> # include <sys/wait.h>
#elif defined (__nucleus__) || defined (__PikeOS__) #elif defined (__PikeOS__)
/* No wait() or waitpid() calls available. */ /* No wait() or waitpid() calls available. */
#else #else
/* Default case. */ /* Default case. */
...@@ -253,7 +248,7 @@ char __gnat_path_separator = PATH_SEPARATOR; ...@@ -253,7 +248,7 @@ char __gnat_path_separator = PATH_SEPARATOR;
const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE; const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
#if defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__) #if defined (__vxworks)
#define GNAT_MAX_PATH_LEN PATH_MAX #define GNAT_MAX_PATH_LEN PATH_MAX
#else #else
...@@ -418,7 +413,7 @@ __gnat_readlink (char *path ATTRIBUTE_UNUSED, ...@@ -418,7 +413,7 @@ __gnat_readlink (char *path ATTRIBUTE_UNUSED,
size_t bufsiz ATTRIBUTE_UNUSED) size_t bufsiz ATTRIBUTE_UNUSED)
{ {
#if defined (_WIN32) \ #if defined (_WIN32) \
|| defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__) || defined(__vxworks) || defined (__PikeOS__)
return -1; return -1;
#else #else
return readlink (path, buf, bufsiz); return readlink (path, buf, bufsiz);
...@@ -434,7 +429,7 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED, ...@@ -434,7 +429,7 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
char *newpath ATTRIBUTE_UNUSED) char *newpath ATTRIBUTE_UNUSED)
{ {
#if defined (_WIN32) \ #if defined (_WIN32) \
|| defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__) || defined(__vxworks) || defined (__PikeOS__)
return -1; return -1;
#else #else
return symlink (oldpath, newpath); return symlink (oldpath, newpath);
...@@ -443,7 +438,7 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED, ...@@ -443,7 +438,7 @@ __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
/* Try to lock a file, return 1 if success. */ /* Try to lock a file, return 1 if success. */
#if defined (__vxworks) || defined (__nucleus__) \ #if defined (__vxworks) \
|| defined (_WIN32) || defined (__PikeOS__) || defined (_WIN32) || defined (__PikeOS__)
/* Version that does not use link. */ /* Version that does not use link. */
...@@ -985,8 +980,6 @@ __gnat_open_new_temp (char *path, int fmode) ...@@ -985,8 +980,6 @@ __gnat_open_new_temp (char *path, int fmode)
return mkstemp (path); return mkstemp (path);
#elif defined (__Lynx__) #elif defined (__Lynx__)
mktemp (path); mktemp (path);
#elif defined (__nucleus__)
return -1;
#else #else
if (mktemp (path) == NULL) if (mktemp (path) == NULL)
return -1; return -1;
...@@ -1063,7 +1056,7 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr) ...@@ -1063,7 +1056,7 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
attr->exists = !ret; attr->exists = !ret;
#if !defined (_WIN32) || defined (RTX) #if !defined (_WIN32)
/* on Windows requires extra system call, see __gnat_is_readable_file_attr */ /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
attr->readable = (!ret && (statbuf.st_mode & S_IRUSR)); attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
attr->writable = (!ret && (statbuf.st_mode & S_IWUSR)); attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
...@@ -1121,15 +1114,7 @@ __gnat_named_file_length (char *name) ...@@ -1121,15 +1114,7 @@ __gnat_named_file_length (char *name)
void void
__gnat_tmp_name (char *tmp_filename) __gnat_tmp_name (char *tmp_filename)
{ {
#ifdef RTX #if defined (__MINGW32__)
/* Variable used to create a series of unique names */
static int counter = 0;
/* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
#elif defined (__MINGW32__)
{ {
char *pname; char *pname;
char prefix[25]; char prefix[25];
...@@ -1205,12 +1190,7 @@ __gnat_tmp_name (char *tmp_filename) ...@@ -1205,12 +1190,7 @@ __gnat_tmp_name (char *tmp_filename)
DIR* __gnat_opendir (char *name) DIR* __gnat_opendir (char *name)
{ {
#if defined (RTX) #if defined (__MINGW32__)
/* Not supported in RTX */
return NULL;
#elif defined (__MINGW32__)
TCHAR wname[GNAT_MAX_PATH_LEN]; TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSC (wname, name, GNAT_MAX_PATH_LEN); S2WSC (wname, name, GNAT_MAX_PATH_LEN);
...@@ -1234,12 +1214,7 @@ DIR* __gnat_opendir (char *name) ...@@ -1234,12 +1214,7 @@ DIR* __gnat_opendir (char *name)
char * char *
__gnat_readdir (DIR *dirp, char *buffer, int *len) __gnat_readdir (DIR *dirp, char *buffer, int *len)
{ {
#if defined (RTX) #if defined (__MINGW32__)
/* Not supported in RTX */
return NULL;
#elif defined (__MINGW32__)
struct _tdirent *dirent = _treaddir ((_TDIR*)dirp); struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
if (dirent != NULL) if (dirent != NULL)
...@@ -1281,12 +1256,7 @@ __gnat_readdir (DIR *dirp, char *buffer, int *len) ...@@ -1281,12 +1256,7 @@ __gnat_readdir (DIR *dirp, char *buffer, int *len)
int __gnat_closedir (DIR *dirp) int __gnat_closedir (DIR *dirp)
{ {
#if defined (RTX) #if defined (__MINGW32__)
/* Not supported in RTX */
return 0;
#elif defined (__MINGW32__)
return _tclosedir ((_TDIR*)dirp); return _tclosedir ((_TDIR*)dirp);
#else #else
...@@ -1306,7 +1276,7 @@ __gnat_readdir_is_thread_safe (void) ...@@ -1306,7 +1276,7 @@ __gnat_readdir_is_thread_safe (void)
#endif #endif
} }
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
/* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */ /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
static const unsigned long long w32_epoch_offset = 11644473600ULL; static const unsigned long long w32_epoch_offset = 11644473600ULL;
...@@ -1354,7 +1324,7 @@ OS_Time ...@@ -1354,7 +1324,7 @@ OS_Time
__gnat_file_time_name_attr (char* name, struct file_attributes* attr) __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
{ {
if (attr->timestamp == (OS_Time)-2) { if (attr->timestamp == (OS_Time)-2) {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
BOOL res; BOOL res;
WIN32_FILE_ATTRIBUTE_DATA fad; WIN32_FILE_ATTRIBUTE_DATA fad;
__time64_t ret = -1; __time64_t ret = -1;
...@@ -1385,7 +1355,7 @@ OS_Time ...@@ -1385,7 +1355,7 @@ OS_Time
__gnat_file_time_fd_attr (int fd, struct file_attributes* attr) __gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
{ {
if (attr->timestamp == (OS_Time)-2) { if (attr->timestamp == (OS_Time)-2) {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
HANDLE h = (HANDLE) _get_osfhandle (fd); HANDLE h = (HANDLE) _get_osfhandle (fd);
time_t ret = win32_filetime (h); time_t ret = win32_filetime (h);
attr->timestamp = (OS_Time) ret; attr->timestamp = (OS_Time) ret;
...@@ -1415,7 +1385,7 @@ __gnat_set_file_time_name (char *name, time_t time_stamp) ...@@ -1415,7 +1385,7 @@ __gnat_set_file_time_name (char *name, time_t time_stamp)
/* Code to implement __gnat_set_file_time_name for these systems. */ /* Code to implement __gnat_set_file_time_name for these systems. */
#elif defined (_WIN32) && !defined (RTX) #elif defined (_WIN32)
union union
{ {
FILETIME ft_time; FILETIME ft_time;
...@@ -1466,8 +1436,7 @@ __gnat_get_libraries_from_registry (void) ...@@ -1466,8 +1436,7 @@ __gnat_get_libraries_from_registry (void)
result[0] = '\0'; result[0] = '\0';
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \ #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
&& ! defined (RTX)
HKEY reg_key; HKEY reg_key;
DWORD name_size, value_size; DWORD name_size, value_size;
...@@ -1699,7 +1668,7 @@ __gnat_is_directory (char *name) ...@@ -1699,7 +1668,7 @@ __gnat_is_directory (char *name)
return __gnat_is_directory_attr (name, &attr); return __gnat_is_directory_attr (name, &attr);
} }
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
/* Returns the same constant as GetDriveType but takes a pathname as /* Returns the same constant as GetDriveType but takes a pathname as
argument. */ argument. */
...@@ -1887,14 +1856,14 @@ __gnat_can_use_acl (TCHAR *wname) ...@@ -1887,14 +1856,14 @@ __gnat_can_use_acl (TCHAR *wname)
return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE; return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
} }
#endif /* defined (_WIN32) && !defined (RTX) */ #endif /* defined (_WIN32) */
int int
__gnat_is_readable_file_attr (char* name, struct file_attributes* attr) __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) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping; GENERIC_MAPPING GenericMapping;
...@@ -1931,7 +1900,7 @@ __gnat_is_writable_file_attr (char* name, struct file_attributes* attr) ...@@ -1931,7 +1900,7 @@ __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) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping; GENERIC_MAPPING GenericMapping;
...@@ -1972,7 +1941,7 @@ __gnat_is_executable_file_attr (char* name, struct file_attributes* attr) ...@@ -1972,7 +1941,7 @@ __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) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping; GENERIC_MAPPING GenericMapping;
...@@ -2019,7 +1988,7 @@ __gnat_is_executable_file (char *name) ...@@ -2019,7 +1988,7 @@ __gnat_is_executable_file (char *name)
void void
__gnat_set_writable (char *name) __gnat_set_writable (char *name)
{ {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2); S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
...@@ -2029,8 +1998,7 @@ __gnat_set_writable (char *name) ...@@ -2029,8 +1998,7 @@ __gnat_set_writable (char *name)
SetFileAttributes SetFileAttributes
(wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY); (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \ #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
! defined(__nucleus__)
GNAT_STRUCT_STAT statbuf; GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0) if (GNAT_STAT (name, &statbuf) == 0)
...@@ -2049,7 +2017,7 @@ __gnat_set_writable (char *name) ...@@ -2049,7 +2017,7 @@ __gnat_set_writable (char *name)
void void
__gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED) __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
{ {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2); S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
...@@ -2057,8 +2025,7 @@ __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED) ...@@ -2057,8 +2025,7 @@ __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
if (__gnat_can_use_acl (wname)) if (__gnat_can_use_acl (wname))
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE); __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \ #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
! defined(__nucleus__)
GNAT_STRUCT_STAT statbuf; GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0) if (GNAT_STAT (name, &statbuf) == 0)
...@@ -2077,7 +2044,7 @@ __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED) ...@@ -2077,7 +2044,7 @@ __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
void void
__gnat_set_non_writable (char *name) __gnat_set_non_writable (char *name)
{ {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2); S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
...@@ -2090,8 +2057,7 @@ __gnat_set_non_writable (char *name) ...@@ -2090,8 +2057,7 @@ __gnat_set_non_writable (char *name)
SetFileAttributes SetFileAttributes
(wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY); (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \ #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
! defined(__nucleus__)
GNAT_STRUCT_STAT statbuf; GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0) if (GNAT_STAT (name, &statbuf) == 0)
...@@ -2105,7 +2071,7 @@ __gnat_set_non_writable (char *name) ...@@ -2105,7 +2071,7 @@ __gnat_set_non_writable (char *name)
void void
__gnat_set_readable (char *name) __gnat_set_readable (char *name)
{ {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2); S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
...@@ -2113,8 +2079,7 @@ __gnat_set_readable (char *name) ...@@ -2113,8 +2079,7 @@ __gnat_set_readable (char *name)
if (__gnat_can_use_acl (wname)) if (__gnat_can_use_acl (wname))
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ); __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \ #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
! defined(__nucleus__)
GNAT_STRUCT_STAT statbuf; GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0) if (GNAT_STAT (name, &statbuf) == 0)
...@@ -2127,7 +2092,7 @@ __gnat_set_readable (char *name) ...@@ -2127,7 +2092,7 @@ __gnat_set_readable (char *name)
void void
__gnat_set_non_readable (char *name) __gnat_set_non_readable (char *name)
{ {
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
TCHAR wname [GNAT_MAX_PATH_LEN + 2]; TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2); S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
...@@ -2135,8 +2100,7 @@ __gnat_set_non_readable (char *name) ...@@ -2135,8 +2100,7 @@ __gnat_set_non_readable (char *name)
if (__gnat_can_use_acl (wname)) if (__gnat_can_use_acl (wname))
__gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ); __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
#elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \ #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
! defined(__nucleus__)
GNAT_STRUCT_STAT statbuf; GNAT_STRUCT_STAT statbuf;
if (GNAT_STAT (name, &statbuf) == 0) if (GNAT_STAT (name, &statbuf) == 0)
...@@ -2152,7 +2116,7 @@ __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED, ...@@ -2152,7 +2116,7 @@ __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
{ {
if (attr->symbolic_link == ATTR_UNSET) if (attr->symbolic_link == ATTR_UNSET)
{ {
#if defined (__vxworks) || defined (__nucleus__) #if defined (__vxworks)
attr->symbolic_link = 0; attr->symbolic_link = 0;
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__) #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
...@@ -2190,8 +2154,7 @@ __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED) ...@@ -2190,8 +2154,7 @@ __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED)
int finished ATTRIBUTE_UNUSED; int finished ATTRIBUTE_UNUSED;
int pid ATTRIBUTE_UNUSED; int pid ATTRIBUTE_UNUSED;
#if defined (__vxworks) || defined(__nucleus__) || defined(RTX) \ #if defined (__vxworks) || defined(__PikeOS__)
|| defined(__PikeOS__)
return -1; return -1;
#elif defined (_WIN32) #elif defined (_WIN32)
...@@ -2309,7 +2272,7 @@ __gnat_number_of_cpus (void) ...@@ -2309,7 +2272,7 @@ __gnat_number_of_cpus (void)
/* WIN32 code to implement a wait call that wait for any child process. */ /* WIN32 code to implement a wait call that wait for any child process. */
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
/* Synchronization code, to be thread safe. */ /* Synchronization code, to be thread safe. */
...@@ -2560,8 +2523,7 @@ int ...@@ -2560,8 +2523,7 @@ int
__gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED) __gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED)
{ {
#if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \ #if defined (__vxworks) || defined (__PikeOS__)
|| defined (__PikeOS__)
/* Not supported. */ /* Not supported. */
return -1; return -1;
...@@ -2601,8 +2563,7 @@ __gnat_portable_wait (int *process_status) ...@@ -2601,8 +2563,7 @@ __gnat_portable_wait (int *process_status)
int status = 0; int status = 0;
int pid = 0; int pid = 0;
#if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \ #if defined (__vxworks) || defined (__PikeOS__)
|| defined (__PikeOS__)
/* Not sure what to do here, so do nothing but return zero. */ /* Not sure what to do here, so do nothing but return zero. */
#elif defined (_WIN32) #elif defined (_WIN32)
...@@ -2779,7 +2740,7 @@ __gnat_locate_exec_on_path (char *exec_name) ...@@ -2779,7 +2740,7 @@ __gnat_locate_exec_on_path (char *exec_name)
{ {
char *apath_val; char *apath_val;
#if defined (_WIN32) && !defined (RTX) #if defined (_WIN32)
TCHAR *wpath_val = _tgetenv (_T("PATH")); TCHAR *wpath_val = _tgetenv (_T("PATH"));
TCHAR *wapath_val; TCHAR *wapath_val;
/* In Win32 systems we expand the PATH as for XP environment /* In Win32 systems we expand the PATH as for XP environment
...@@ -2918,11 +2879,10 @@ int ...@@ -2918,11 +2879,10 @@ int
__gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED, __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
int mode ATTRIBUTE_UNUSED) int mode ATTRIBUTE_UNUSED)
{ {
#if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \ #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
defined (__nucleus__)
return -1; return -1;
#elif defined (_WIN32) && !defined (RTX) #elif defined (_WIN32)
TCHAR wfrom [GNAT_MAX_PATH_LEN + 2]; TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
TCHAR wto [GNAT_MAX_PATH_LEN + 2]; TCHAR wto [GNAT_MAX_PATH_LEN + 2];
BOOL res; BOOL res;
...@@ -3076,37 +3036,6 @@ __gnat_sals_init_using_constructors (void) ...@@ -3076,37 +3036,6 @@ __gnat_sals_init_using_constructors (void)
#endif #endif
} }
#ifdef RTX
/* In RTX mode, the procedure to get the time (as file time) is different
in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
we introduce an intermediate procedure to link against the corresponding
one in each situation. */
extern void GetTimeAsFileTime (LPFILETIME pTime);
void GetTimeAsFileTime (LPFILETIME pTime)
{
#ifdef RTSS
RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
#else
GetSystemTimeAsFileTime (pTime); /* w32 interface */
#endif
}
#ifdef RTSS
/* Add symbol that is required to link. It would otherwise be taken from
libgcc.a and it would try to use the gcc constructors that are not
supported by Microsoft linker. */
extern void __main (void);
void __main (void)
{
}
#endif /* RTSS */
#endif /* RTX */
#if defined (__ANDROID__) #if defined (__ANDROID__)
#include <pthread.h> #include <pthread.h>
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -155,8 +155,8 @@ package body Debug is ...@@ -155,8 +155,8 @@ package body Debug is
-- d8 Force opposite endianness in packed stuff -- d8 Force opposite endianness in packed stuff
-- d9 Allow lock free implementation -- d9 Allow lock free implementation
-- d.1 -- d.1 Enable unnesting of nested procedures
-- d.2 -- d.2 Allow statements in declarative part
-- d.3 -- d.3
-- d.4 -- d.4
-- d.5 -- d.5
...@@ -746,6 +746,14 @@ package body Debug is ...@@ -746,6 +746,14 @@ package body Debug is
-- d9 This allows lock free implementation for protected objects -- d9 This allows lock free implementation for protected objects
-- (see Exp_Ch9). -- (see Exp_Ch9).
-- d.1 Enable unnesting of nested procedures. This special pass does not
-- actually unnest things, but it ensures that a nested procedure
-- does not contain any uplevel references.
-- d.2 Allow statements within declarative parts. This is not usually
-- allowed, but in some debugging contexts (e.g. testing the circuit
-- for unnesting of procedures), it is useful to allow this.
------------------------------------------ ------------------------------------------
-- Documentation for Binder Debug Flags -- -- Documentation for Binder Debug Flags --
------------------------------------------ ------------------------------------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 2001-2014, AdaCore * * Copyright (C) 2001-2015, AdaCore *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -54,8 +54,8 @@ ...@@ -54,8 +54,8 @@
/* ??? See comment in adaint.c. */ /* ??? See comment in adaint.c. */
# define GCC_RESOURCE_H # define GCC_RESOURCE_H
# include <sys/wait.h> # include <sys/wait.h>
#elif defined (__nucleus__) || defined (__PikeOS__) #elif defined (__PikeOS__)
/* No wait.h available on Nucleus */ /* No wait.h available */
#else #else
#include <sys/wait.h> #include <sys/wait.h>
#endif #endif
...@@ -350,7 +350,7 @@ __gnat_expect_poll (int *fd, ...@@ -350,7 +350,7 @@ __gnat_expect_poll (int *fd,
return ready; return ready;
} }
#elif defined (__unix__) && !defined (__nucleus__) #elif defined (__unix__)
#ifdef __hpux__ #ifdef __hpux__
#include <sys/ptyio.h> #include <sys/ptyio.h>
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 2004-2014, Free Software Foundation, Inc. * * Copyright (C) 2004-2015, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -29,7 +29,7 @@ ...@@ -29,7 +29,7 @@
* * * *
****************************************************************************/ ****************************************************************************/
#if defined(__nucleus__) || defined(VTHREADS) || defined(__PikeOS__) #if defined(VTHREADS) || defined(__PikeOS__)
/* Sockets not supported on these platforms. */ /* Sockets not supported on these platforms. */
#undef HAVE_SOCKETS #undef HAVE_SOCKETS
...@@ -251,4 +251,4 @@ ...@@ -251,4 +251,4 @@
# define HAVE_INET_PTON # define HAVE_INET_PTON
#endif #endif
#endif /* defined(__nucleus__) */ #endif /* defined(VTHREADS) */
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2014, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -427,6 +427,7 @@ package body Impunit is ...@@ -427,6 +427,7 @@ package body Impunit is
("a-coorse", T), -- Ada.Containers.Ordered_Sets ("a-coorse", T), -- Ada.Containers.Ordered_Sets
("a-coteio", T), -- Ada.Complex_Text_IO ("a-coteio", T), -- Ada.Complex_Text_IO
("a-direct", T), -- Ada.Directories ("a-direct", T), -- Ada.Directories
("a-dinopr", T), -- Ada.Dispatching.Non_Preemptive
("a-diroro", T), -- Ada.Dispatching.Round_Robin ("a-diroro", T), -- Ada.Dispatching.Round_Robin
("a-disedf", T), -- Ada.Dispatching.EDF ("a-disedf", T), -- Ada.Dispatching.EDF
("a-dispat", T), -- Ada.Dispatching ("a-dispat", T), -- Ada.Dispatching
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1455,6 +1455,16 @@ package body Ch3 is ...@@ -1455,6 +1455,16 @@ package body Ch3 is
else else
Restore_Scan_State (Scan_State); Restore_Scan_State (Scan_State);
-- Reset Token_Node, because it already got changed from an
-- Identifier to a Defining_Identifier, and we don't want that
-- for a statement!
Token_Node :=
Make_Identifier (Sloc (Token_Node), Chars (Token_Node));
-- And now scan out one or more statements
Statement_When_Declaration_Expected (Decls, Done, In_Spec); Statement_When_Declaration_Expected (Decls, Done, In_Spec);
return; return;
end if; end if;
...@@ -4777,6 +4787,12 @@ package body Ch3 is ...@@ -4777,6 +4787,12 @@ package body Ch3 is
if In_Spec then if In_Spec then
null; null;
-- Just ignore it if we are in -gnatd.2 (allow statements to appear
-- in declaration sequences) mode.
elsif Debug_Flag_Dot_2 then
null;
-- In the declarative part case, take a second statement as a sure -- In the declarative part case, take a second statement as a sure
-- sign that we really have a missing BEGIN, and end the declarative -- sign that we really have a missing BEGIN, and end the declarative
-- part now. Note that the caller will fix up the first message to -- part now. Note that the caller will fix up the first message to
...@@ -4790,26 +4806,32 @@ package body Ch3 is ...@@ -4790,26 +4806,32 @@ package body Ch3 is
-- Case of first occurrence of unexpected statement -- Case of first occurrence of unexpected statement
else else
-- If we are in a package spec, then give message of statement -- Do not give error message if we are operating in -gnatd.2 mode
-- not allowed in package spec. This message never gets changed. -- (alllow statements to appear in declarative parts).
if In_Spec then if not Debug_Flag_Dot_2 then
Error_Msg_SC ("statement not allowed in package spec");
-- If in declarative part, then we give the message complaining -- If we are in a package spec, then give message of statement
-- about finding a statement when a declaration is expected. This -- not allowed in package spec. This message never gets changed.
-- gets changed to a complaint about a missing BEGIN if we later
-- find that no BEGIN is present.
else if In_Spec then
Error_Msg_SC ("statement not allowed in declarative part"); Error_Msg_SC ("statement not allowed in package spec");
end if;
-- Capture message Id. This is used for two purposes, first to -- If in declarative part, then we give the message complaining
-- stop multiple messages, see test above, and second, to allow -- about finding a statement when a declaration is expected. This
-- the replacement of the message in the declarative part case. -- gets changed to a complaint about a missing BEGIN if we later
-- find that no BEGIN is present.
Missing_Begin_Msg := Get_Msg_Id; else
Error_Msg_SC ("statement not allowed in declarative part");
end if;
-- Capture message Id. This is used for two purposes, first to
-- stop multiple messages, see test above, and second, to allow
-- the replacement of the message in the declarative part case.
Missing_Begin_Msg := Get_Msg_Id;
end if;
end if; end if;
-- In all cases except the case in which we decided to terminate the -- In all cases except the case in which we decided to terminate the
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2014, Free Software Foundation, Inc. -- -- Copyright (C) 2000-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -108,16 +108,7 @@ pragma Style_Checks ("M32766"); ...@@ -108,16 +108,7 @@ pragma Style_Checks ("M32766");
#include <fcntl.h> #include <fcntl.h>
#include <time.h> #include <time.h>
#if defined (__VMS) #if ! (defined (__vxworks) || defined (__MINGW32__))
/** VMS is unable to do vector IO operations with default value of IOV_MAX,
** so its value is redefined to a small one which is known to work properly.
**/
#undef IOV_MAX
#define IOV_MAX 16
#endif
#if ! (defined (__vxworks) || defined (__VMS) || defined (__MINGW32__) || \
defined (__nucleus__))
# define HAVE_TERMIOS # define HAVE_TERMIOS
#endif #endif
...@@ -286,12 +277,10 @@ package System.OS_Constants is ...@@ -286,12 +277,10 @@ package System.OS_Constants is
-- General platform parameters -- -- General platform parameters --
--------------------------------- ---------------------------------
type OS_Type is (Windows, VMS, Other_OS); type OS_Type is (Windows, Other_OS);
*/ */
#if defined (__MINGW32__) #if defined (__MINGW32__)
# define TARGET_OS "Windows" # define TARGET_OS "Windows"
#elif defined (__VMS)
# define TARGET_OS "VMS"
#else #else
# define TARGET_OS "Other_OS" # define TARGET_OS "Other_OS"
#endif #endif
......
...@@ -5918,6 +5918,17 @@ package body Sem_Prag is ...@@ -5918,6 +5918,17 @@ package body Sem_Prag is
-- Get name from corresponding aspect -- Get name from corresponding aspect
Error_Msg_Name_1 := Original_Aspect_Name (N); Error_Msg_Name_1 := Original_Aspect_Name (N);
if Class_Present (N) then
-- Replace the name with a leading underscore used
-- internally, with a name that is more user-friendly.
if Error_Msg_Name_1 = Name_uType_Invariant then
Error_Msg_Name_1 := Name_Type_Invariant_Class;
end if;
end if;
end if; end if;
-- Return possibly modified message -- Return possibly modified message
......
...@@ -10715,14 +10715,22 @@ package body Sem_Res is ...@@ -10715,14 +10715,22 @@ package body Sem_Res is
begin begin
-- If the type of the operand is a limited view, use the non- -- If the type of the operand is a limited view, use the non-
-- limited view when available. -- limited view when available. If it is a class-wide type,
-- recover class_wide type of the non-limited view.
if From_Limited_With (Opnd) if From_Limited_With (Opnd) then
and then Ekind (Opnd) in Incomplete_Kind if Ekind (Opnd) in Incomplete_Kind
and then Present (Non_Limited_View (Opnd)) and then Present (Non_Limited_View (Opnd))
then then
Opnd := Non_Limited_View (Opnd); Opnd := Non_Limited_View (Opnd);
Set_Etype (Expression (N), Opnd); Set_Etype (Expression (N), Opnd);
elsif Is_Class_Wide_Type (Opnd)
and then Present (Non_Limited_View (Etype (Opnd)))
then
Opnd := Class_Wide_Type (Non_Limited_View (Etype (Opnd)));
Set_Etype (Expression (N), Opnd);
end if;
end if; end if;
if Is_Access_Type (Opnd) then if Is_Access_Type (Opnd) then
......
...@@ -1063,12 +1063,12 @@ package Snames is ...@@ -1063,12 +1063,12 @@ package Snames is
-- for FIFO_Within_Priorities). If new policy names are added, the first -- for FIFO_Within_Priorities). If new policy names are added, the first
-- character must be distinct. -- character must be distinct.
First_Task_Dispatching_Policy_Name : constant Name_Id := N + $; First_Task_Dispatching_Policy_Name : constant Name_Id := N + $;
Name_EDF_Across_Priorities : constant Name_Id := N + $; Name_EDF_Across_Priorities : constant Name_Id := N + $;
Name_FIFO_Within_Priorities : constant Name_Id := N + $; Name_FIFO_Within_Priorities : constant Name_Id := N + $;
Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + $; Name_Non_Preemptive_FIFO_Within_Priorities : constant Name_Id := N + $;
Name_Round_Robin_Within_Priorities : constant Name_Id := N + $; Name_Round_Robin_Within_Priorities : constant Name_Id := N + $;
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + $; Last_Task_Dispatching_Policy_Name : constant Name_Id := N + $;
-- Names of recognized partition elaboration policy identifiers -- Names of recognized partition elaboration policy identifiers
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2014, Free Software Foundation, Inc. * * Copyright (C) 1992-2015, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -58,9 +58,6 @@ ...@@ -58,9 +58,6 @@
#include "tsystem.h" #include "tsystem.h"
#include <fcntl.h> #include <fcntl.h>
#include <sys/stat.h> #include <sys/stat.h>
#ifdef VMS
#include <unixio.h>
#endif
#else #else
#include "config.h" #include "config.h"
#include "system.h" #include "system.h"
...@@ -190,8 +187,6 @@ __gnat_ttyname (int filedes) ...@@ -190,8 +187,6 @@ __gnat_ttyname (int filedes)
#if defined (__CYGWIN__) || defined (__MINGW32__) #if defined (__CYGWIN__) || defined (__MINGW32__)
#include <windows.h> #include <windows.h>
#ifndef RTX
int __gnat_is_windows_xp (void); int __gnat_is_windows_xp (void);
int int
...@@ -216,8 +211,6 @@ __gnat_is_windows_xp (void) ...@@ -216,8 +211,6 @@ __gnat_is_windows_xp (void)
return is_win_xp; return is_win_xp;
} }
#endif /* !RTX */
/* Get the bounds of the stack. The stack pointer is supposed to be /* Get the bounds of the stack. The stack pointer is supposed to be
initialized to BASE when a thread is created and the stack can be extended initialized to BASE when a thread is created and the stack can be extended
to LIMIT before reaching a guard page. to LIMIT before reaching a guard page.
...@@ -279,13 +272,13 @@ __gnat_set_mode (int handle ATTRIBUTE_UNUSED, int mode ATTRIBUTE_UNUSED) ...@@ -279,13 +272,13 @@ __gnat_set_mode (int handle ATTRIBUTE_UNUSED, int mode ATTRIBUTE_UNUSED)
char * char *
__gnat_ttyname (int filedes) __gnat_ttyname (int filedes)
{ {
#if defined (__vxworks) || defined (__nucleus) #if defined (__vxworks)
return ""; return "";
#else #else
extern char *ttyname (int); extern char *ttyname (int);
return ttyname (filedes); return ttyname (filedes);
#endif /* defined (__vxworks) || defined (__nucleus) */ #endif /* defined (__vxworks) */
} }
#endif #endif
...@@ -306,11 +299,6 @@ __gnat_ttyname (int filedes) ...@@ -306,11 +299,6 @@ __gnat_ttyname (int filedes)
# include <termios.h> # include <termios.h>
# endif # endif
#else
# if defined (VMS)
extern char *decc$ga_stdscr;
static int initted = 0;
# endif
#endif #endif
/* Implements the common processing for getc_immediate and /* Implements the common processing for getc_immediate and
...@@ -424,29 +412,6 @@ getc_immediate_common (FILE *stream, ...@@ -424,29 +412,6 @@ getc_immediate_common (FILE *stream,
} }
else else
#elif defined (VMS)
int fd = fileno (stream);
if (isatty (fd))
{
if (initted == 0)
{
decc$bsd_initscr ();
initted = 1;
}
decc$bsd_cbreak ();
*ch = decc$bsd_wgetch (decc$ga_stdscr);
if (*ch == 4)
*end_of_file = 1;
else
*end_of_file = 0;
*avail = 1;
decc$bsd_nocbreak ();
}
else
#elif defined (__MINGW32__) #elif defined (__MINGW32__)
int fd = fileno (stream); int fd = fileno (stream);
int char_waiting; int char_waiting;
...@@ -629,23 +594,6 @@ rts_get_nShowCmd (void) ...@@ -629,23 +594,6 @@ rts_get_nShowCmd (void)
} }
#endif /* WINNT */ #endif /* WINNT */
#ifdef VMS
/* This gets around a problem with using the old threads library on VMS 7.0. */
extern long get_gmtoff (void);
long
get_gmtoff (void)
{
time_t t;
struct tm *ts;
t = time ((time_t) 0);
ts = localtime (&t);
return ts->tm_gmtoff;
}
#endif
/* This value is returned as the time zone offset when a valid value /* This value is returned as the time zone offset when a valid value
cannot be determined. It is simply a bizarre value that will never cannot be determined. It is simply a bizarre value that will never
...@@ -689,25 +637,18 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off) ...@@ -689,25 +637,18 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
{ {
TIME_ZONE_INFORMATION tzi; TIME_ZONE_INFORMATION tzi;
BOOL rtx_active;
DWORD tzi_status; DWORD tzi_status;
#ifdef RTX
rtx_active = 1;
#else
rtx_active = 0;
#endif
(*Lock_Task) (); (*Lock_Task) ();
tzi_status = GetTimeZoneInformation (&tzi); tzi_status = GetTimeZoneInformation (&tzi);
/* Processing for RTX targets or cases where we simply want to extract the /* Cases where we simply want to extract the offset of the current time
offset of the current time zone, regardless of the date. A value of "0" zone, regardless of the date. A value of "0" for flag "is_historic"
for flag "is_historic" signifies that the date is NOT historic, see the signifies that the date is NOT historic, see the
body of Ada.Calendar.UTC_Time_Offset. */ body of Ada.Calendar.UTC_Time_Offset. */
if (rtx_active || *is_historic == 0) { if (*is_historic == 0) {
*off = tzi.Bias; *off = tzi.Bias;
/* The system is operating in the range covered by the StandardDate /* The system is operating in the range covered by the StandardDate
...@@ -775,12 +716,10 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off) ...@@ -775,12 +716,10 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
(*Unlock_Task) (); (*Unlock_Task) ();
} }
#else #elif defined (__Lynx__)
/* On Lynx, all time values are treated in GMT */ /* On Lynx, all time values are treated in GMT */
#if defined (__Lynx__)
/* As of LynxOS 3.1.0a patch level 040, LynuxWorks changes the /* As of LynxOS 3.1.0a patch level 040, LynuxWorks changes the
prototype to the C library function localtime_r from the POSIX.4 prototype to the C library function localtime_r from the POSIX.4
Draft 9 to the POSIX 1.c version. Before this change the following Draft 9 to the POSIX 1.c version. Before this change the following
...@@ -798,13 +737,7 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off) ...@@ -798,13 +737,7 @@ __gnat_localtime_tzoff (const time_t *timer, const int *is_historic, long *off)
#else #else
/* VMS does not need __gnat_localtime_tzoff */ /* Other targets except Lynx and Windows provide a standard localtime_r */
#if defined (VMS)
/* Other targets except Lynx, VMS and Windows provide a standard localtime_r */
#else
#define Lock_Task system__soft_links__lock_task #define Lock_Task system__soft_links__lock_task
extern void (*Lock_Task) (void); extern void (*Lock_Task) (void);
...@@ -898,12 +831,10 @@ __gnat_localtime_tzoff (const time_t *timer ATTRIBUTE_UNUSED, ...@@ -898,12 +831,10 @@ __gnat_localtime_tzoff (const time_t *timer ATTRIBUTE_UNUSED,
#else #else
*off = 0; *off = 0;
#endif #endif /* defined(_AIX) ... */
} }
#endif #endif
#endif
#endif
#ifdef __vxworks #ifdef __vxworks
......
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