aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-11-23 12:24:48 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2011-11-23 12:24:48 +0100
commitc269a1f5c9c3904c35ed2ac320e6620c7f47ea57 (patch)
tree3801b3b0ce11d58d1c4a23076336e38db3baa05d /gcc
parentf947ee3467dee8ca1b681c459804b02657113e9d (diff)
downloadgcc-c269a1f5c9c3904c35ed2ac320e6620c7f47ea57.zip
gcc-c269a1f5c9c3904c35ed2ac320e6620c7f47ea57.tar.gz
gcc-c269a1f5c9c3904c35ed2ac320e6620c7f47ea57.tar.bz2
[multiple changes]
2011-11-23 Robert Dewar <dewar@adacore.com> * sem_ch9.adb (Analyze_Entry_Declaration): Check for entry family bounds out of range. 2011-11-23 Matthew Heaney <heaney@adacore.com> * a-cohama.adb, a-cihama.adb, a-cbhama.adb (Iterator): Declare type as limited, and remove node component. (First, Next): Forward call to corresponding cursor-based operation. (Iterate): Representation of iterator no longer has node component. 2011-11-23 Yannick Moy <moy@adacore.com> * exp_util.adb: Revert previous change to remove side-effects in Alfa mode, which is not the correct thing to do for renamings. 2011-11-23 Thomas Quinot <quinot@adacore.com> * s-osinte-hpux.ads, s-taprop-vxworks.adb, s-taprop-tru64.adb, s-osinte-vxworks.ads, s-osinte-aix.ads, s-osinte-lynxos.ads, s-osinte-solaris-posix.ads, s-taprop-solaris.adb, a-exetim-posix.adb, s-osinte-irix.ads, s-osinte-solaris.ads, s-oscons-tmplt.c, s-taprop-irix.adb, s-osinte-hpux-dce.ads, Makefile.rtl, s-osinte-tru64.ads, s-osinte-darwin.ads, s-taprop.ads, s-osinte-freebsd.ads, s-osinte-lynxos-3.ads, s-taprop-hpux-dce.adb, s-taprop-posix.adb: Remove hard-coded clock ids; instead, generate them in System.OS_Constants. (System.OS_Constants.CLOCK_RT_Ada): New constant denoting the id of the clock providing Ada.Real_Time.Monotonic_Clock. * thread.c: New file. (__gnat_pthread_condattr_setup): New function. For platforms where CLOCK_RT_Ada is not CLOCK_REALTIME, set appropriate condition variable attribute. 2011-11-23 Yannick Moy <moy@adacore.com> * sem_ch3.adb: Restore the use of Expander_Active instead of Full_Expander_Active, so that the evaluation is forced in Alfa mode too. Otherwise, we end up with an unexpected insertion in a place where it is not supposed to happen, on default parameters of a call. 2011-11-23 Thomas Quinot <quinot@adacore.com> * prj-pp.adb, prj-pp.ads: Minor new addition: wrapper procedure "wpr" for Pretty_Print, for use from within gdb. From-SVN: r181660
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog48
-rw-r--r--gcc/ada/Makefile.rtl4
-rw-r--r--gcc/ada/a-cbhama.adb26
-rw-r--r--gcc/ada/a-cihama.adb30
-rw-r--r--gcc/ada/a-cohama.adb28
-rw-r--r--gcc/ada/a-exetim-posix.adb4
-rw-r--r--gcc/ada/exp_util.adb69
-rw-r--r--gcc/ada/prj-pp.adb11
-rw-r--r--gcc/ada/prj-pp.ads7
-rw-r--r--gcc/ada/s-oscons-tmplt.c50
-rw-r--r--gcc/ada/s-osinte-aix.ads9
-rw-r--r--gcc/ada/s-osinte-darwin.ads9
-rw-r--r--gcc/ada/s-osinte-freebsd.ads12
-rw-r--r--gcc/ada/s-osinte-hpux.ads9
-rw-r--r--gcc/ada/s-osinte-irix.ads11
-rw-r--r--gcc/ada/s-osinte-lynxos-3.ads7
-rw-r--r--gcc/ada/s-osinte-lynxos.ads9
-rw-r--r--gcc/ada/s-osinte-solaris-posix.ads9
-rw-r--r--gcc/ada/s-osinte-solaris.ads7
-rw-r--r--gcc/ada/s-osinte-tru64.ads9
-rw-r--r--gcc/ada/s-osinte-vxworks.ads7
-rw-r--r--gcc/ada/s-taprop-hpux-dce.adb2
-rw-r--r--gcc/ada/s-taprop-irix.adb6
-rw-r--r--gcc/ada/s-taprop-posix.adb14
-rw-r--r--gcc/ada/s-taprop-solaris.adb2
-rw-r--r--gcc/ada/s-taprop-tru64.adb2
-rw-r--r--gcc/ada/s-taprop-vxworks.adb2
-rw-r--r--gcc/ada/s-taprop.ads2
-rw-r--r--gcc/ada/sem_ch3.adb6
-rw-r--r--gcc/ada/sem_ch9.adb54
-rw-r--r--gcc/ada/thread.c50
31 files changed, 336 insertions, 179 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 30486c1..ecf8e6a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,51 @@
+2011-11-23 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch9.adb (Analyze_Entry_Declaration): Check for entry
+ family bounds out of range.
+
+2011-11-23 Matthew Heaney <heaney@adacore.com>
+
+ * a-cohama.adb, a-cihama.adb, a-cbhama.adb (Iterator): Declare
+ type as limited, and remove node component.
+ (First, Next): Forward call to corresponding cursor-based operation.
+ (Iterate): Representation of iterator no longer has node component.
+
+2011-11-23 Yannick Moy <moy@adacore.com>
+
+ * exp_util.adb: Revert previous change to remove side-effects in Alfa
+ mode, which is not the correct thing to do for renamings.
+
+2011-11-23 Thomas Quinot <quinot@adacore.com>
+
+ * s-osinte-hpux.ads, s-taprop-vxworks.adb, s-taprop-tru64.adb,
+ s-osinte-vxworks.ads, s-osinte-aix.ads, s-osinte-lynxos.ads,
+ s-osinte-solaris-posix.ads, s-taprop-solaris.adb, a-exetim-posix.adb,
+ s-osinte-irix.ads, s-osinte-solaris.ads, s-oscons-tmplt.c,
+ s-taprop-irix.adb, s-osinte-hpux-dce.ads, Makefile.rtl,
+ s-osinte-tru64.ads, s-osinte-darwin.ads, s-taprop.ads,
+ s-osinte-freebsd.ads, s-osinte-lynxos-3.ads, s-taprop-hpux-dce.adb,
+ s-taprop-posix.adb: Remove hard-coded clock ids;
+ instead, generate them in System.OS_Constants.
+ (System.OS_Constants.CLOCK_RT_Ada): New constant denoting the
+ id of the clock providing Ada.Real_Time.Monotonic_Clock.
+ * thread.c: New file.
+ (__gnat_pthread_condattr_setup): New function. For platforms where
+ CLOCK_RT_Ada is not CLOCK_REALTIME, set appropriate condition
+ variable attribute.
+
+2011-11-23 Yannick Moy <moy@adacore.com>
+
+ * sem_ch3.adb: Restore the use of Expander_Active instead of
+ Full_Expander_Active, so that the evaluation is forced in Alfa
+ mode too. Otherwise, we end up with an unexpected insertion in a
+ place where it is not supposed to happen, on default parameters
+ of a call.
+
+2011-11-23 Thomas Quinot <quinot@adacore.com>
+
+ * prj-pp.adb, prj-pp.ads: Minor new addition: wrapper procedure "wpr"
+ for Pretty_Print, for use from within gdb.
+
2011-11-23 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Iterator_Loop): Wrap the expanded loop
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 73ef0e7..5c3e307 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -75,7 +75,9 @@ GNATRTL_TASKING_OBJS= \
s-tpoben$(objext) \
s-tpobop$(objext) \
s-tposen$(objext) \
- s-tratas$(objext) $(EXTRA_GNATRTL_TASKING_OBJS)
+ s-tratas$(objext) \
+ thread$(objext) \
+ $(EXTRA_GNATRTL_TASKING_OBJS)
# Objects needed for non-tasking.
GNATRTL_NONTASKING_OBJS= \
diff --git a/gcc/ada/a-cbhama.adb b/gcc/ada/a-cbhama.adb
index d7c75d4..a87db6a 100644
--- a/gcc/ada/a-cbhama.adb
+++ b/gcc/ada/a-cbhama.adb
@@ -41,7 +41,6 @@ package body Ada.Containers.Bounded_Hashed_Maps is
type Iterator is new
Map_Iterator_Interfaces.Forward_Iterator with record
Container : Map_Access;
- Node : Count_Type;
end record;
overriding function First (Object : Iterator) return Cursor;
@@ -424,14 +423,8 @@ package body Ada.Containers.Bounded_Hashed_Maps is
end First;
function First (Object : Iterator) return Cursor is
- M : constant Map_Access := Object.Container;
- N : constant Count_Type := HT_Ops.First (M.all);
begin
- if N = 0 then
- return No_Element;
- else
- return Cursor'(Object.Container.all'Unchecked_Access, N);
- end if;
+ return Object.Container.First;
end First;
-----------------
@@ -675,12 +668,10 @@ package body Ada.Containers.Bounded_Hashed_Maps is
end Iterate;
function Iterate
- (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
is
- Node : constant Count_Type := HT_Ops.First (Container);
- It : constant Iterator := (Container'Unrestricted_Access, Node);
begin
- return It;
+ return Iterator'(Container => Container'Unrestricted_Access);
end Iterate;
---------
@@ -770,11 +761,16 @@ package body Ada.Containers.Bounded_Hashed_Maps is
Position : Cursor) return Cursor
is
begin
- if Position.Node = 0 then
+ if Position.Container = null then
return No_Element;
- else
- return (Object.Container, Next (Position).Node);
end if;
+
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor of Next designates wrong map";
+ end if;
+
+ return Next (Position);
end Next;
-------------------
diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb
index b90c542..84bbdfd 100644
--- a/gcc/ada/a-cihama.adb
+++ b/gcc/ada/a-cihama.adb
@@ -45,10 +45,9 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
procedure Free_Element is
new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
- type Iterator is new
+ type Iterator is limited new
Map_Iterator_Interfaces.Forward_Iterator with record
Container : Map_Access;
- Node : Node_Access;
end record;
overriding function First (Object : Iterator) return Cursor;
@@ -476,14 +475,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
end First;
function First (Object : Iterator) return Cursor is
- M : constant Map_Access := Object.Container;
- N : constant Node_Access := HT_Ops.First (M.HT);
begin
- if N = null then
- return No_Element;
- else
- return Cursor'(Object.Container.all'Unchecked_Access, N);
- end if;
+ return Object.Container.First;
end First;
----------
@@ -715,13 +708,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
B := B - 1;
end Iterate;
- function Iterate (Container : Map)
- return Map_Iterator_Interfaces.Forward_Iterator'class
+ function Iterate
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
is
- Node : constant Node_Access := HT_Ops.First (Container.HT);
- It : constant Iterator := (Container'Unrestricted_Access, Node);
begin
- return It;
+ return Iterator'(Container => Container'Unrestricted_Access);
end Iterate;
---------
@@ -809,11 +800,16 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
function Next (Object : Iterator; Position : Cursor) return Cursor is
begin
- if Position.Node = null then
+ if Position.Container = null then
return No_Element;
- else
- return (Object.Container, Next (Position).Node);
end if;
+
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor of Next designates wrong map";
+ end if;
+
+ return Next (Position);
end Next;
-------------------
diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb
index 351030d..634ccc0 100644
--- a/gcc/ada/a-cohama.adb
+++ b/gcc/ada/a-cohama.adb
@@ -39,10 +39,9 @@ with System; use type System.Address;
package body Ada.Containers.Hashed_Maps is
- type Iterator is new
+ type Iterator is limited new
Map_Iterator_Interfaces.Forward_Iterator with record
Container : Map_Access;
- Node : Node_Access;
end record;
overriding function First (Object : Iterator) return Cursor;
@@ -440,14 +439,8 @@ package body Ada.Containers.Hashed_Maps is
end First;
function First (Object : Iterator) return Cursor is
- M : constant Map_Access := Object.Container;
- N : constant Node_Access := HT_Ops.First (M.HT);
begin
- if N = null then
- return No_Element;
- end if;
-
- return Cursor'(Object.Container.all'Unchecked_Access, N);
+ return Object.Container.First;
end First;
----------
@@ -667,12 +660,10 @@ package body Ada.Containers.Hashed_Maps is
end Iterate;
function Iterate
- (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+ (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
is
- Node : constant Node_Access := HT_Ops.First (Container.HT);
- It : constant Iterator := (Container'Unrestricted_Access, Node);
begin
- return It;
+ return Iterator'(Container => Container'Unrestricted_Access);
end Iterate;
---------
@@ -752,11 +743,16 @@ package body Ada.Containers.Hashed_Maps is
Position : Cursor) return Cursor
is
begin
- if Position.Node = null then
+ if Position.Container = null then
return No_Element;
- else
- return (Object.Container, Next (Position).Node);
end if;
+
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor of Next designates wrong map";
+ end if;
+
+ return Next (Position);
end Next;
-------------------
diff --git a/gcc/ada/a-exetim-posix.adb b/gcc/ada/a-exetim-posix.adb
index 65b21d6..094f2aa 100644
--- a/gcc/ada/a-exetim-posix.adb
+++ b/gcc/ada/a-exetim-posix.adb
@@ -34,6 +34,7 @@
with Ada.Task_Identification; use Ada.Task_Identification;
with Ada.Unchecked_Conversion;
+with System.OS_Constants; use System.OS_Constants;
with System.OS_Interface; use System.OS_Interface;
with Interfaces.C; use Interfaces.C;
@@ -112,9 +113,6 @@ package body Ada.Execution_Time is
pragma Import (C, clock_gettime, "clock_gettime");
-- Function from the POSIX.1b Realtime Extensions library
- CLOCK_THREAD_CPUTIME_ID : constant := 3;
- -- Identifier for the clock returning per-task CPU time
-
begin
if T = Ada.Task_Identification.Null_Task_Id then
raise Program_Error;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c0396b4..c67d011 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6420,19 +6420,9 @@ package body Exp_Util is
-- Start of processing for Remove_Side_Effects
begin
- -- We only need to do removal of side effects if we are generating
- -- actual code. That's because the whole issue of side effects is purely
- -- a run-time issue, and the removal is required only to get proper
- -- behavior at run-time.
-
- -- In the Alfa case, we don't need to remove side effects because formal
- -- verification is performed only on expressions that are provably
- -- side-effect free. If we tried to remove side effects in the Alfa
- -- case, we would get into a mess since in the case of limited types in
- -- particular, removal of side effects involves the use of access types
- -- or references which are not permitted in Alfa mode.
-
- if not Full_Expander_Active then
+ -- Handle cases in which there is nothing to do
+
+ if not Expander_Active then
return;
end if;
@@ -6633,6 +6623,15 @@ package body Exp_Util is
-- Otherwise we generate a reference to the value
else
+ -- An expression which is in Alfa mode is considered side effect free
+ -- if the resulting value is captured by a variable or a constant.
+
+ if Alfa_Mode
+ and then Nkind (Parent (Exp)) = N_Object_Declaration
+ then
+ return;
+ end if;
+
-- Special processing for function calls that return a limited type.
-- We need to build a declaration that will enable build-in-place
-- expansion of the call. This is not done if the context is already
@@ -6667,25 +6666,39 @@ package body Exp_Util is
Def_Id := Make_Temporary (Loc, 'R', Exp);
Set_Etype (Def_Id, Exp_Type);
- Res :=
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Def_Id, Loc));
+ -- The regular expansion of functions with side effects involves the
+ -- generation of an access type to capture the return value found on
+ -- the secondary stack. Since Alfa (and why) cannot process access
+ -- types, use a different approach which ignores the secondary stack
+ -- and "copies" the returned object.
- -- Generate:
- -- type Ann is access all <Exp_Type>;
+ if Alfa_Mode then
+ Res := New_Reference_To (Def_Id, Loc);
+ Ref_Type := Exp_Type;
+
+ -- Regular expansion utilizing an access type and 'reference
- Ref_Type := Make_Temporary (Loc, 'A');
+ else
+ Res :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Def_Id, Loc));
- Ptr_Typ_Decl :=
- Make_Full_Type_Declaration (Loc,
- Defining_Identifier => Ref_Type,
- Type_Definition =>
- Make_Access_To_Object_Definition (Loc,
- All_Present => True,
- Subtype_Indication =>
- New_Reference_To (Exp_Type, Loc)));
+ -- Generate:
+ -- type Ann is access all <Exp_Type>;
- Insert_Action (Exp, Ptr_Typ_Decl);
+ Ref_Type := Make_Temporary (Loc, 'A');
+
+ Ptr_Typ_Decl :=
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Ref_Type,
+ Type_Definition =>
+ Make_Access_To_Object_Definition (Loc,
+ All_Present => True,
+ Subtype_Indication =>
+ New_Reference_To (Exp_Type, Loc)));
+
+ Insert_Action (Exp, Ptr_Typ_Decl);
+ end if;
E := Exp;
if Nkind (E) = N_Explicit_Dereference then
diff --git a/gcc/ada/prj-pp.adb b/gcc/ada/prj-pp.adb
index cf0ae4a..6e9e61b 100644
--- a/gcc/ada/prj-pp.adb
+++ b/gcc/ada/prj-pp.adb
@@ -968,4 +968,15 @@ package body Prj.PP is
Output.Write_Eol;
end Output_Statistics;
+ ---------
+ -- wpr --
+ ---------
+
+ procedure wpr
+ (Project : Prj.Tree.Project_Node_Id;
+ In_Tree : Prj.Tree.Project_Node_Tree_Ref) is
+ begin
+ Pretty_Print (Project, In_Tree, Backward_Compatibility => False);
+ end wpr;
+
end Prj.PP;
diff --git a/gcc/ada/prj-pp.ads b/gcc/ada/prj-pp.ads
index f47e058..771b4c3 100644
--- a/gcc/ada/prj-pp.ads
+++ b/gcc/ada/prj-pp.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2011, 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- --
@@ -91,4 +91,9 @@ private
-- display what Project_Node_Kinds have not been exercised by the call(s)
-- to Pretty_Print. It is used only for testing purposes.
+ procedure wpr
+ (Project : Prj.Tree.Project_Node_Id;
+ In_Tree : Prj.Tree.Project_Node_Tree_Ref);
+ -- Wrapper for use from gdb: call Pretty_Print with default parameters
+
end Prj.PP;
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index ad3d065..d8a6477 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -97,6 +97,7 @@ pragma Style_Checks ("M32766");
#include <string.h>
#include <limits.h>
#include <fcntl.h>
+#include <time.h>
#if defined (__alpha__) && defined (__osf__)
/** Tru64 is unable to do vector IO operations with default value of IOV_MAX,
@@ -1207,6 +1208,55 @@ CND(IP_DROP_MEMBERSHIP, "Leave a multicast group")
#endif
CND(IP_PKTINFO, "Get datagram info")
+#endif /* HAVE_SOCKETS */
+
+/*
+
+ ------------
+ -- Clocks --
+ ------------
+
+*/
+
+#ifdef CLOCK_REALTIME
+CND(CLOCK_REALTIME, "System realtime clock")
+#endif
+
+#ifdef CLOCK_MONOTONIC
+CND(CLOCK_MONOTONIC, "System monotonic clock")
+#endif
+
+#ifdef CLOCK_FASTEST
+CND(CLOCK_FASTEST, "Fastest clock")
+#endif
+
+#if defined (__sgi)
+CND(CLOCK_SGI_FAST, "SGI fast clock")
+CND(CLOCK_SGI_CYCLE, "SGI CPU clock")
+#endif
+
+#if defined(__APPLE__)
+/* There's no clock_gettime or clock_id's on Darwin */
+# define CLOCK_RT_Ada "-1"
+
+#elif defined(FreeBSD) || defined(_AIX)
+/* On these platforms use system provided monotonic clock */
+# define CLOCK_RT_Ada "CLOCK_MONOTONIC"
+
+#elif defined(CLOCK_REALTIME)
+/* By default use CLOCK_REALTIME */
+# define CLOCK_RT_Ada "CLOCK_REALTIME"
+#endif
+
+#ifdef CLOCK_RT_Ada
+CNS(CLOCK_RT_Ada, "Ada realtime clock")
+#endif
+
+#ifndef CLOCK_THREAD_CPUTIME_ID
+# define CLOCK_THREAD_CPUTIME_ID -1
+#endif
+CND(CLOCK_THREAD_CPUTIME_ID, "Thread CPU clock")
+
/*
----------------------
diff --git a/gcc/ada/s-osinte-aix.ads b/gcc/ada/s-osinte-aix.ads
index c8e6608..c89e729 100644
--- a/gcc/ada/s-osinte-aix.ads
+++ b/gcc/ada/s-osinte-aix.ads
@@ -197,10 +197,7 @@ package System.OS_Interface is
type timespec is private;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
- CLOCK_MONOTONIC : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -547,10 +544,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 9;
- CLOCK_MONOTONIC : constant clockid_t := 10;
-
type pthread_attr_t is new System.Address;
pragma Convention (C, pthread_attr_t);
-- typedef struct __pt_attr *pthread_attr_t;
diff --git a/gcc/ada/s-osinte-darwin.ads b/gcc/ada/s-osinte-darwin.ads
index fe2a10a..ff04803 100644
--- a/gcc/ada/s-osinte-darwin.ads
+++ b/gcc/ada/s-osinte-darwin.ads
@@ -183,10 +183,7 @@ package System.OS_Interface is
type timespec is private;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
- CLOCK_MONOTONIC : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -524,10 +521,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 0;
- CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
--
-- Darwin specific signal implementation
--
diff --git a/gcc/ada/s-osinte-freebsd.ads b/gcc/ada/s-osinte-freebsd.ads
index cbd2a2d..b581dae 100644
--- a/gcc/ada/s-osinte-freebsd.ads
+++ b/gcc/ada/s-osinte-freebsd.ads
@@ -200,10 +200,7 @@ package System.OS_Interface is
function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep, "nanosleep");
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
- CLOCK_MONOTONIC : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -643,13 +640,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 0;
- CLOCK_MONOTONIC : constant clockid_t := 0;
- -- On FreeBSD, pthread_cond_timedwait assumes a CLOCK_REALTIME time by
- -- default (unless pthread_condattr_setclock is used to set an alternate
- -- clock).
-
type pthread_t is new System.Address;
type pthread_attr_t is new System.Address;
type pthread_mutex_t is new System.Address;
diff --git a/gcc/ada/s-osinte-hpux.ads b/gcc/ada/s-osinte-hpux.ads
index bc9a709..55729f8 100644
--- a/gcc/ada/s-osinte-hpux.ads
+++ b/gcc/ada/s-osinte-hpux.ads
@@ -180,10 +180,7 @@ package System.OS_Interface is
type timespec is private;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
- CLOCK_MONOTONIC : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -529,10 +526,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 1;
- CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
type pthread_attr_t is new int;
type pthread_condattr_t is new int;
type pthread_mutexattr_t is new int;
diff --git a/gcc/ada/s-osinte-irix.ads b/gcc/ada/s-osinte-irix.ads
index ddeadcb..365a3de 100644
--- a/gcc/ada/s-osinte-irix.ads
+++ b/gcc/ada/s-osinte-irix.ads
@@ -172,11 +172,7 @@ package System.OS_Interface is
type timespec is private;
type timespec_ptr is access all timespec;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
- CLOCK_SGI_FAST : constant clockid_t;
- CLOCK_SGI_CYCLE : constant clockid_t;
+ type clockid_t is new int;
SGI_CYCLECNTR_SIZE : constant := 165;
@@ -486,11 +482,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 1;
- CLOCK_SGI_CYCLE : constant clockid_t := 2;
- CLOCK_SGI_FAST : constant clockid_t := 3;
-
type array_type_9 is array (Integer range 0 .. 4) of long;
type pthread_attr_t is record
X_X_D : array_type_9;
diff --git a/gcc/ada/s-osinte-lynxos-3.ads b/gcc/ada/s-osinte-lynxos-3.ads
index 3d912ee..e8288d9 100644
--- a/gcc/ada/s-osinte-lynxos-3.ads
+++ b/gcc/ada/s-osinte-lynxos-3.ads
@@ -177,9 +177,7 @@ package System.OS_Interface is
type timespec is private;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -516,9 +514,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new unsigned_char;
- CLOCK_REALTIME : constant clockid_t := 0;
-
type st_t is record
stksize : int;
prio : int;
diff --git a/gcc/ada/s-osinte-lynxos.ads b/gcc/ada/s-osinte-lynxos.ads
index 8b998bc..7bcbab6 100644
--- a/gcc/ada/s-osinte-lynxos.ads
+++ b/gcc/ada/s-osinte-lynxos.ads
@@ -197,10 +197,7 @@ package System.OS_Interface is
type timespec is private;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
- CLOCK_MONOTONIC : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -517,10 +514,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new unsigned_char;
- CLOCK_REALTIME : constant clockid_t := 1;
- CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
type st_attr_t is record
stksize : int;
prio : int;
diff --git a/gcc/ada/s-osinte-solaris-posix.ads b/gcc/ada/s-osinte-solaris-posix.ads
index 8781a12..eb17bd4 100644
--- a/gcc/ada/s-osinte-solaris-posix.ads
+++ b/gcc/ada/s-osinte-solaris-posix.ads
@@ -187,10 +187,7 @@ package System.OS_Interface is
type timespec is private;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
- CLOCK_MONOTONIC : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -520,10 +517,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 3;
- CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
-
type pthread_attr_t is record
pthread_attrp : System.Address;
end record;
diff --git a/gcc/ada/s-osinte-solaris.ads b/gcc/ada/s-osinte-solaris.ads
index 03a0c4a..b4baa6d 100644
--- a/gcc/ada/s-osinte-solaris.ads
+++ b/gcc/ada/s-osinte-solaris.ads
@@ -243,9 +243,7 @@ package System.OS_Interface is
type timespec is private;
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t; tp : access timespec) return int;
@@ -531,9 +529,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 0;
-
type array_type_9 is array (0 .. 3) of unsigned_char;
type record_type_3 is record
flag : array_type_9;
diff --git a/gcc/ada/s-osinte-tru64.ads b/gcc/ada/s-osinte-tru64.ads
index 8347172..0fcd422 100644
--- a/gcc/ada/s-osinte-tru64.ads
+++ b/gcc/ada/s-osinte-tru64.ads
@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1995-2011, 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- --
@@ -191,9 +191,7 @@ package System.OS_Interface is
function nanosleep (rqtp, rmtp : access timespec) return int;
pragma Import (C, nanosleep);
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t;
+ type clockid_t is new int;
function clock_gettime
(clock_id : clockid_t;
@@ -506,9 +504,6 @@ private
end record;
pragma Convention (C, timespec);
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 1;
-
type unsigned_long_array is array (Natural range <>) of unsigned_long;
type pthread_t is new System.Address;
diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads
index f5013ea..1997674 100644
--- a/gcc/ada/s-osinte-vxworks.ads
+++ b/gcc/ada/s-osinte-vxworks.ads
@@ -243,9 +243,7 @@ package System.OS_Interface is
end record;
pragma Convention (C, timespec);
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t; -- System wide realtime clock
+ type clockid_t is new int;
function To_Duration (TS : timespec) return Duration;
pragma Inline (To_Duration);
@@ -511,8 +509,5 @@ private
ERROR_PID : constant pid_t := -1;
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 0;
-
type sigset_t is new System.VxWorks.Ext.sigset_t;
end System.OS_Interface;
diff --git a/gcc/ada/s-taprop-hpux-dce.adb b/gcc/ada/s-taprop-hpux-dce.adb
index 346de43..cae17c1 100644
--- a/gcc/ada/s-taprop-hpux-dce.adb
+++ b/gcc/ada/s-taprop-hpux-dce.adb
@@ -555,7 +555,7 @@ package body System.Task_Primitives.Operations is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
- Result := Clock_Gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+ Result := Clock_Gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
diff --git a/gcc/ada/s-taprop-irix.adb b/gcc/ada/s-taprop-irix.adb
index 62cb4f7..dc9f9a8 100644
--- a/gcc/ada/s-taprop-irix.adb
+++ b/gcc/ada/s-taprop-irix.adb
@@ -89,8 +89,6 @@ package body System.Task_Primitives.Operations is
Dispatching_Policy : Character;
pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
- Real_Time_Clock_Id : constant clockid_t := CLOCK_REALTIME;
-
Unblocked_Signal_Mask : aliased sigset_t;
Foreign_Task_Elaborated : aliased Boolean := True;
@@ -572,7 +570,7 @@ package body System.Task_Primitives.Operations is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
- Result := clock_gettime (Real_Time_Clock_Id, TS'Unchecked_Access);
+ Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
@@ -583,7 +581,7 @@ package body System.Task_Primitives.Operations is
function RT_Resolution return Duration is
begin
- -- The clock_getres (Real_Time_Clock_Id) function appears to return
+ -- The clock_getres (OSC.CLOCK_RT_Ada) function appears to return
-- the interrupt resolution of the realtime clock and not the actual
-- resolution of reading the clock. Even though this last value is
-- only guaranteed to be 100 Hz, at least the Origin 200 appears to
diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index 44015cf..4014381 100644
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -171,6 +171,11 @@ package body System.Task_Primitives.Operations is
function To_Address is
new Ada.Unchecked_Conversion (Task_Id, System.Address);
+ function GNAT_pthread_condattr_setup
+ (attr : access pthread_condattr_t) return int;
+ pragma Import (C,
+ GNAT_pthread_condattr_setup, "__gnat_pthread_condattr_setup");
+
-------------------
-- Abort_Handler --
-------------------
@@ -666,7 +671,7 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
Result := clock_gettime
- (clock_id => CLOCK_MONOTONIC, tp => TS'Unchecked_Access);
+ (clock_id => OSC.CLOCK_RT_Ada, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
@@ -869,6 +874,9 @@ package body System.Task_Primitives.Operations is
pragma Assert (Result = 0 or else Result = ENOMEM);
if Result = 0 then
+ Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
+ pragma Assert (Result = 0);
+
Result :=
pthread_cond_init
(Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
@@ -1099,6 +1107,10 @@ package body System.Task_Primitives.Operations is
-- underlying OS entities fails.
raise Storage_Error;
+
+ else
+ Result := GNAT_pthread_condattr_setup (Cond_Attr'Access);
+ pragma Assert (Result = 0);
end if;
Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb
index c98da19..ef0e391 100644
--- a/gcc/ada/s-taprop-solaris.adb
+++ b/gcc/ada/s-taprop-solaris.adb
@@ -773,7 +773,7 @@ package body System.Task_Primitives.Operations is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
- Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+ Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index b0b727d..e4ef466 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -589,7 +589,7 @@ package body System.Task_Primitives.Operations is
TS : aliased timespec;
Result : Interfaces.C.int;
begin
- Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+ Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb
index be76162..3c3e22b 100644
--- a/gcc/ada/s-taprop-vxworks.adb
+++ b/gcc/ada/s-taprop-vxworks.adb
@@ -718,7 +718,7 @@ package body System.Task_Primitives.Operations is
TS : aliased timespec;
Result : int;
begin
- Result := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
+ Result := clock_gettime (OSC.CLOCK_RT_Ada, TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads
index 12fbd71..66b0b5d 100644
--- a/gcc/ada/s-taprop.ads
+++ b/gcc/ada/s-taprop.ads
@@ -34,12 +34,14 @@
with System.Parameters;
with System.Tasking;
+with System.OS_Constants;
with System.OS_Interface;
package System.Task_Primitives.Operations is
pragma Preelaborate;
package ST renames System.Tasking;
+ package OSC renames System.OS_Constants;
package OSI renames System.OS_Interface;
procedure Initialize (Environment_Task : ST.Task_Id);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 1614771..92e1b9d 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -11786,7 +11786,7 @@ package body Sem_Ch3 is
-- needed, since checks may cause duplication of the expressions
-- which must not be reevaluated.
- if Full_Expander_Active then
+ if Expander_Active then
Force_Evaluation (Low_Bound (R));
Force_Evaluation (High_Bound (R));
end if;
@@ -18326,7 +18326,7 @@ package body Sem_Ch3 is
-- if needed, before applying checks, since checks may cause
-- duplication of the expression without forcing evaluation.
- if Full_Expander_Active then
+ if Expander_Active then
Force_Evaluation (Lo);
Force_Evaluation (Hi);
end if;
@@ -18436,7 +18436,7 @@ package body Sem_Ch3 is
-- Case of other than an explicit N_Range node
- elsif Full_Expander_Active then
+ elsif Expander_Active then
Get_Index_Bounds (R, Lo, Hi);
Force_Evaluation (Lo);
Force_Evaluation (Hi);
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 4b284cd..057f0b7 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -905,6 +905,60 @@ package body Sem_Ch9 is
Bad_Predicated_Subtype_Use
("subtype& has predicate, not allowed in entry family",
D_Sdef, Etype (D_Sdef));
+
+ -- Check entry family static bounds outside allowed limits
+
+ -- Note: originally this check was not performed here, but in that
+ -- case the check happens deep in the expander, and the message is
+ -- posted at the wrong location, and omitted in -gnatc mode.
+
+ declare
+ PEI : constant Entity_Id := RTE (RE_Protected_Entry_Index);
+ LB : constant Uint := Expr_Value (Type_Low_Bound (PEI));
+ UB : constant Uint := Expr_Value (Type_High_Bound (PEI));
+
+ LBR : Node_Id;
+ UBR : Node_Id;
+
+ begin
+ if Nkind (D_Sdef) = N_Range then
+ LBR := Low_Bound (D_Sdef);
+ elsif Is_Entity_Name (D_Sdef)
+ and then Is_Type (Entity (D_Sdef))
+ then
+ LBR := Type_Low_Bound (Entity (D_Sdef));
+ else
+ goto Skip_LB;
+ end if;
+
+ if Is_Static_Expression (LBR)
+ and then Expr_Value (LBR) < LB
+ then
+ Error_Msg_Uint_1 := LB;
+ Error_Msg_N ("entry family low bound must be '>'= ^!", D_Sdef);
+ end if;
+
+ <<Skip_LB>>
+ if Nkind (D_Sdef) = N_Range then
+ UBR := High_Bound (D_Sdef);
+ elsif Is_Entity_Name (D_Sdef)
+ and then Is_Type (Entity (D_Sdef))
+ then
+ UBR := Type_High_Bound (Entity (D_Sdef));
+ else
+ goto Skip_UB;
+ end if;
+
+ if Is_Static_Expression (UBR)
+ and then Expr_Value (UBR) > UB
+ then
+ Error_Msg_Uint_1 := UB;
+ Error_Msg_N ("entry family high bound must be '<'= ^!", D_Sdef);
+ end if;
+
+ <<Skip_UB>>
+ null;
+ end;
end if;
-- Decorate Def_Id
diff --git a/gcc/ada/thread.c b/gcc/ada/thread.c
new file mode 100644
index 0000000..da67f7b
--- /dev/null
+++ b/gcc/ada/thread.c
@@ -0,0 +1,50 @@
+/****************************************************************************
+ * *
+ * GNAT COMPILER COMPONENTS *
+ * *
+ * T H R E A D *
+ * *
+ * C Implementation File *
+ * *
+ * Copyright (C) 2011, 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. *
+ * *
+ ****************************************************************************/
+
+/* This file provides utility functions to access the threads API */
+
+#include <pthread.h>
+#include <time.h>
+#include "s-oscons.h"
+
+int
+__gnat_pthread_condattr_setup(pthread_condattr_t *attr) {
+/*
+ * If using a clock other than CLOCK_REALTIME for the Ada Monotonic_Clock,
+ * the corresponding clock id must be set for condition variables.
+ * There are no clock_id's on Darwin.
+ */
+#if defined(__APPLE__) || ((CLOCK_RT_Ada) == (CLOCK_REALTIME))
+ return 0;
+#else
+ return pthread_condattr_setclock (attr, CLOCK_RT_Ada);
+#endif
+}