mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-18 20:31:00 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR ada/35143 (Serious regression on ACATS results since 4.2.3)

Browse Source 
2008-02-11  Joel Sherrill <joel.sherrill@oarcorp.com>

	PR ada/35143
	* env.c: Add __rtems__ to if defined.
	* s-osinte-rtems.adb: Add To_Target_Priority.  Fix formatting.
	* s-osinte-rtems.ads: Add To_Target_Priority prototype and
	PTHREAD_SCOPE_PROCESS/PTHREAD_SCOPE_SYSTEM constants.  Add
	pragma Convention as required.
	* gsocket.h: Make compile in and out of RTS.
	* Makefile.in: Add system-rtems.ads.  Build DEC extensions.
	Use g-soccon-rtems.ads.
	* g-soccon-rtems.ads, system-rtems.ads: New files.

From-SVN: r132294
This commit is contained in:
Joel Sherrill 2008-02-13 19:04:53 +00:00 committed by Joel Sherrill
parent 29a7754d16
commit 6a333ca04f
8 changed files with 423 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/ada/ChangeLog
View File

@ -1,3 +1,16 @@
2008-02-11 Joel Sherrill <joel.sherrill@oarcorp.com>
PR ada/35143
* env.c: Add __rtems__ to if defined.
* s-osinte-rtems.adb: Add To_Target_Priority. Fix formatting.
* s-osinte-rtems.ads: Add To_Target_Priority prototype and
PTHREAD_SCOPE_PROCESS/PTHREAD_SCOPE_SYSTEM constants. Add
pragma Convention as required.
* gsocket.h: Make compile in and out of RTS.
* Makefile.in: Add system-rtems.ads. Build DEC extensions.
Use g-soccon-rtems.ads.
* g-soccon-rtems.ads, system-rtems.ads: New files.
2008-02-06 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
PR other/35107

9
gcc/ada/Makefile.in
View File

@ -1,5 +1,5 @@
# Makefile for GNU Ada Compiler (GNAT).
# Copyright (C) 1994-2007 Free Software Foundation, Inc.
# Copyright (C) 1994-2008 Free Software Foundation, Inc.
#This file is part of GCC.
@ -1136,6 +1136,7 @@ endif
ifeq ($(strip $(filter-out rtems%,$(osys))),)
LIBGNAT_TARGET_PAIRS = \
system.ads<system-rtems.ads \
a-intnam.ads<a-intnam-rtems.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
@ -1145,9 +1146,9 @@ ifeq ($(strip $(filter-out rtems%,$(osys))),)
s-parame.adb<s-parame-rtems.adb \
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix.ads \
s-auxdec.ads<s-auxdec-empty.ads \
s-auxdec.adb<s-auxdec-empty.adb \
s-tpopsp.adb<s-tpopsp-rtems.adb
s-tpopsp.adb<s-tpopsp-rtems.adb \
g-soccon.ads<g-soccon-rtems.ads \
s-stchop.adb<s-stchop-rtems.adb
endif
ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)

4
gcc/ada/env.c
View File

@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 2005-2007, Free Software Foundation, Inc. *
* Copyright (C) 2005-2008, 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- *
@ -290,7 +290,7 @@ void __gnat_clearenv (void) {
}
#elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
|| (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
|| defined (__NetBSD__) || defined (__OpenBSD__)
|| defined (__NetBSD__) || defined (__OpenBSD__) || defined (__rtems__)
/* On Windows, FreeBSD and MacOS there is no function to clean all the
environment but there is a "clean" way to unset a variable. So go
through the environ table and call __gnat_unsetenv on all entries */

195
gcc/ada/g-soccon-rtems.ads Normal file
View File

@ -0,0 +1,195 @@
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . C O N S T A N T S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2007, 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides target dependent definitions of constant for use
-- by the GNAT.Sockets package (g-socket.ads). This package should not be
-- directly with'ed by an applications program.
-- This is the version for RTEMS
-- This file is generated automatically, do not modify it by hand! Instead,
-- make changes to gen-soccon.c and re-run it on each target.
package GNAT.Sockets.Constants is
--------------
-- Families --
--------------
AF_INET : constant := 2; -- IPv4 address family
AF_INET6 : constant := 28; -- IPv6 address family
-----------
-- Modes --
-----------
SOCK_STREAM : constant := 1; -- Stream socket
SOCK_DGRAM : constant := 2; -- Datagram socket
-------------------
-- Socket errors --
-------------------
EACCES : constant := 13; -- Permission denied
EADDRINUSE : constant := 112; -- Address already in use
EADDRNOTAVAIL : constant := 125; -- Cannot assign address
EAFNOSUPPORT : constant := 106; -- Addr family not supported
EALREADY : constant := 120; -- Operation in progress
EBADF : constant := 9; -- Bad file descriptor
ECONNABORTED : constant := 113; -- Connection aborted
ECONNREFUSED : constant := 111; -- Connection refused
ECONNRESET : constant := 104; -- Connection reset by peer
EDESTADDRREQ : constant := 121; -- Destination addr required
EFAULT : constant := 14; -- Bad address
EHOSTDOWN : constant := 117; -- Host is down
EHOSTUNREACH : constant := 118; -- No route to host
EINPROGRESS : constant := 119; -- Operation now in progress
EINTR : constant := 4; -- Interrupted system call
EINVAL : constant := 22; -- Invalid argument
EIO : constant := 5; -- Input output error
EISCONN : constant := 127; -- Socket already connected
ELOOP : constant := 92; -- Too many symbolic lynks
EMFILE : constant := 24; -- Too many open files
EMSGSIZE : constant := 122; -- Message too long
ENAMETOOLONG : constant := 91; -- Name too long
ENETDOWN : constant := 115; -- Network is down
ENETRESET : constant := 126; -- Disconn. on network reset
ENETUNREACH : constant := 114; -- Network is unreachable
ENOBUFS : constant := 105; -- No buffer space available
ENOPROTOOPT : constant := 109; -- Protocol not available
ENOTCONN : constant := 128; -- Socket not connected
ENOTSOCK : constant := 108; -- Operation on non socket
EOPNOTSUPP : constant := 95; -- Operation not supported
EPFNOSUPPORT : constant := 96; -- Unknown protocol family
EPROTONOSUPPORT : constant := 123; -- Unknown protocol
EPROTOTYPE : constant := 107; -- Unknown protocol type
ESHUTDOWN : constant := 110; -- Cannot send once shutdown
ESOCKTNOSUPPORT : constant := 124; -- Socket type not supported
ETIMEDOUT : constant := 116; -- Connection timed out
ETOOMANYREFS : constant := 129; -- Too many references
EWOULDBLOCK : constant := 11; -- Operation would block
-----------------
-- Host errors --
-----------------
HOST_NOT_FOUND : constant := 1; -- Unknown host
TRY_AGAIN : constant := 2; -- Host name lookup failure
NO_DATA : constant := 4; -- No data record for name
NO_RECOVERY : constant := 3; -- Non recoverable errors
-------------------
-- Control flags --
-------------------
FIONBIO : constant := -2147195266; -- Set/clear non-blocking io
FIONREAD : constant := 1074030207; -- How many bytes to read
--------------------
-- Shutdown modes --
--------------------
SHUT_RD : constant := 0; -- No more recv
SHUT_WR : constant := 1; -- No more send
SHUT_RDWR : constant := 2; -- No more recv/send
---------------------
-- Protocol levels --
---------------------
SOL_SOCKET : constant := 65535; -- Options for socket level
IPPROTO_IP : constant := 0; -- Dummy protocol for IP
IPPROTO_UDP : constant := 17; -- UDP
IPPROTO_TCP : constant := 6; -- TCP
-------------------
-- Request flags --
-------------------
MSG_OOB : constant := 1; -- Process out-of-band data
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-- Flags set on all send(2) calls
--------------------
-- Socket options --
--------------------
TCP_NODELAY : constant := 1; -- Do not coalesce packets
SO_REUSEADDR : constant := 4; -- Bind reuse local address
SO_REUSEPORT : constant := -1; -- Bind reuse port number
SO_KEEPALIVE : constant := 8; -- Enable keep-alive msgs
SO_LINGER : constant := 128; -- Defer close to flush data
SO_BROADCAST : constant := 32; -- Can send broadcast msgs
SO_SNDBUF : constant := 4097; -- Set/get send buffer size
SO_RCVBUF : constant := 4098; -- Set/get recv buffer size
SO_SNDTIMEO : constant := 4101; -- Emission timeout
SO_RCVTIMEO : constant := 4102; -- Reception timeout
SO_ERROR : constant := 4103; -- Get/clear error status
IP_MULTICAST_IF : constant := 9; -- Set/get mcast interface
IP_MULTICAST_TTL : constant := 10; -- Set/get multicast TTL
IP_MULTICAST_LOOP : constant := 11; -- Set/get mcast loopback
IP_ADD_MEMBERSHIP : constant := 12; -- Join a multicast group
IP_DROP_MEMBERSHIP : constant := 13; -- Leave a multicast group
-------------------
-- System limits --
-------------------
IOV_MAX : constant := 1024; -- Maximum writev iovcnt
----------------------
-- Type definitions --
----------------------
-- Sizes (in bytes) of the components of struct timeval
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
----------------------------------------
-- Properties of supported interfaces --
----------------------------------------
Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
----------------------
-- Additional flags --
----------------------
Thread_Blocking_IO : constant Boolean := True;
-- Set False for contexts where socket i/o are process blocking
end GNAT.Sockets.Constants;

12
gcc/ada/gsocket.h
View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 2004-2006, Free Software Foundation, Inc. *
* Copyright (C) 2004-2008, 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- *
@ -139,7 +139,15 @@
#include <sys/time.h>
#endif
#if !(defined (VMS) || defined (__MINGW32__) || defined(__rtems__))
/*
* RTEMS has these .h files but not until you have built RTEMS. When
* IN_RTS, you only have the .h files in the newlib C library.
* Because this file is also included from gen-soccon.c which is built
* to run on RTEMS (not IN_RTS), we must distinguish between IN_RTS
* and using this file to compile gen-soccon.
*/
#if !(defined (VMS) || defined (__MINGW32__) || \
(defined(__rtems__) && defined(IN_RTS)))
#include <sys/socket.h>
#include <netinet/in.h>
#include <netinet/tcp.h>

23
gcc/ada/s-osinte-rtems.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1991-2002 Florida State University --
-- Copyright (C) 1991-2008 Florida State University --
-- --
-- GNARL 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- --
@ -57,6 +57,17 @@ package body System.OS_Interface is
return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
end To_Duration;
------------------------
-- To_Target_Priority --
------------------------
function To_Target_Priority
(Prio : System.Any_Priority) return Interfaces.C.int
is
begin
return Interfaces.C.int (Prio);
end To_Target_Priority;
-----------------
-- To_Timespec --
-----------------
@ -70,7 +81,10 @@ package body System.OS_Interface is
-- If F has negative value due to round-up, adjust for positive F value
if F < 0.0 then S := S - 1; F := F + 1.0; end if;
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return timespec'(tv_sec => S,
tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
@ -89,7 +103,10 @@ package body System.OS_Interface is
-- If F has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then S := S - 1; F := F + 1.0; end if;
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return
struct_timeval'
(tv_sec => S,

11
gcc/ada/s-osinte-rtems.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2008 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -194,6 +194,10 @@ package System.OS_Interface is
SCHED_RR : constant := 2;
SCHED_OTHER : constant := 0;
function To_Target_Priority
(Prio : System.Any_Priority) return Interfaces.C.int;
-- Maps System.Any_Priority to a POSIX priority
-------------
-- Process --
-------------
@ -222,6 +226,7 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
pragma Convention (C, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;
@ -237,6 +242,9 @@ package System.OS_Interface is
PTHREAD_CREATE_DETACHED : constant := 0;
PTHREAD_SCOPE_PROCESS : constant := 0;
PTHREAD_SCOPE_SYSTEM : constant := 1;
-----------
-- Stack --
-----------
@ -460,6 +468,7 @@ package System.OS_Interface is
pragma Import (C, pthread_getspecific, "pthread_getspecific");
type destructor_pointer is access procedure (arg : System.Address);
pragma Convention (C, destructor_pointer);
function pthread_key_create
(key : access pthread_key_t;

168
gcc/ada/system-rtems.ads Normal file
View File

@ -0,0 +1,168 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M --
-- --
-- S p e c --
-- (Compiler Version) --
-- --
-- Copyright (C) 1992-2008 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This version of System is a RTEMS version that is used in building
-- the compiler. This is based as closely as possible on the generic
-- version with the following exceptions:
-- + priority definitions
package System is
pragma Pure;
-- Note that we take advantage of the implementation permission to make
-- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
-- 2005, this is Pure in any case (AI-362).
type Name is (SYSTEM_NAME_GNAT);
System_Name : constant Name := SYSTEM_NAME_GNAT;
-- System-Dependent Named Numbers
Min_Int : constant := Long_Long_Integer'First;
Max_Int : constant := Long_Long_Integer'Last;
Max_Binary_Modulus : constant := 2 ** Long_Long_Integer'Size;
Max_Nonbinary_Modulus : constant := Integer'Last;
Max_Base_Digits : constant := Long_Long_Float'Digits;
Max_Digits : constant := Long_Long_Float'Digits;
Max_Mantissa : constant := 63;
Fine_Delta : constant := 2.0 ** (-Max_Mantissa);
Tick : constant := 0.01;
-- Storage-related Declarations
type Address is private;
Null_Address : constant Address;
Storage_Unit : constant := Standard'Storage_Unit;
Word_Size : constant := Standard'Word_Size;
Memory_Size : constant := 2 ** Standard'Address_Size;
-- Address comparison
function "<" (Left, Right : Address) return Boolean;
function "<=" (Left, Right : Address) return Boolean;
function ">" (Left, Right : Address) return Boolean;
function ">=" (Left, Right : Address) return Boolean;
function "=" (Left, Right : Address) return Boolean;
pragma Import (Intrinsic, "<");
pragma Import (Intrinsic, "<=");
pragma Import (Intrinsic, ">");
pragma Import (Intrinsic, ">=");
pragma Import (Intrinsic, "=");
-- Other System-Dependent Declarations
type Bit_Order is (High_Order_First, Low_Order_First);
Default_Bit_Order : constant Bit_Order :=
Bit_Order'Val (Standard'Default_Bit_Order);
pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
-- Priority-related Declarations (RM D.1)
-- RTEMS POSIX threads support 256 priority levels with 255 being
-- logically the most important. Levels 0 and 255 are reserved.
--
-- 255 is reserved for RTEMS system tasks
-- 247 - 254 correspond to hardware interrupt levels 0 .. 7
-- 246 is a catchall default "interrupt" priority for signals,
-- allowing higher priority than normal tasks, but lower than
-- hardware priority levels. Protected Object ceilings can
-- override these values.
-- 245 is used by the Interrupt_Manager task
-- 0 is reserved for the RTEMS IDLE task and really should not
-- be accessible from Ada but GNAT initializes
-- Current_Priority to 0 so it must be valid
Max_Priority : constant Positive := 244;
Max_Interrupt_Priority : constant Positive := 254;
subtype Any_Priority is Integer range 0 .. 254;
subtype Priority is Any_Priority range 0 .. 244;
subtype Interrupt_Priority is Any_Priority range 245 .. 254;
Default_Priority : constant Priority := 122;
private
type Address is mod Memory_Size;
Null_Address : constant Address := 0;
--------------------------------------
-- System Implementation Parameters --
--------------------------------------
-- These parameters provide information about the target that is used
-- by the compiler. They are in the private part of System, where they
-- can be accessed using the special circuitry in the Targparm unit
-- whose source should be consulted for more detailed descriptions
-- of the individual switch values.
Backend_Divide_Checks : constant Boolean := False;
Backend_Overflow_Checks : constant Boolean := False;
Command_Line_Args : constant Boolean := True;
Configurable_Run_Time : constant Boolean := False;
Denorm : constant Boolean := True;
Duration_32_Bits : constant Boolean := False;
Exit_Status_Supported : constant Boolean := True;
Fractional_Fixed_Ops : constant Boolean := False;
Frontend_Layout : constant Boolean := False;
Machine_Overflows : constant Boolean := False;
Machine_Rounds : constant Boolean := True;
Preallocated_Stacks : constant Boolean := False;
Signed_Zeros : constant Boolean := True;
Stack_Check_Default : constant Boolean := False;
Stack_Check_Probes : constant Boolean := False;
Support_64_Bit_Divides : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
ZCX_By_Default : constant Boolean := False;
GCC_ZCX_Support : constant Boolean := True;
-- One would think you did not have to define this but
-- it is used in the run-time.
OpenVMS : constant Boolean := False;
end System;