Skip to content

R
riscv-gcc-1
Commit 5ae7c3cf by Arnaud Charlet
Options

[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
Showing with 231 additions and 134 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/a-dinopr.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/a-dispat.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/a-dispat.ads
...@@ -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;
gcc/ada/debug.adb
...@@ -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 --
------------------------------------------ ------------------------------------------
......
gcc/ada/expect.c
...@@ -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>
......
gcc/ada/gsocket.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) */
gcc/ada/impunit.adb
...@@ -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
......
gcc/ada/par-ch3.adb
...@@ -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
......
gcc/ada/s-oscons-tmplt.c
...@@ -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
......
gcc/ada/sem_prag.adb
...@@ -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
......
gcc/ada/sem_res.adb
...@@ -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
......
gcc/ada/snames.ads-tmpl
...@@ -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
......
gcc/ada/sysdep.c
...@@ -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