aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-01-30 11:24:17 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2012-01-30 11:24:17 +0100
commit25081892c432b0234fd29bdbf970c89f2083eed5 (patch)
tree9d6cf6a29c0a1bdac65791a5798295c1f978b73b /gcc/ada
parent4f0534570bc8bb662747136a348991a964cb022b (diff)
downloadgcc-25081892c432b0234fd29bdbf970c89f2083eed5.zip
gcc-25081892c432b0234fd29bdbf970c89f2083eed5.tar.gz
gcc-25081892c432b0234fd29bdbf970c89f2083eed5.tar.bz2
[multiple changes]
2012-01-30 Robert Dewar <dewar@adacore.com> * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb: Minor reformatting. 2012-01-30 Olivier Hainque <hainque@adacore.com> * sigtramp-ppcvxw.c (CFI_COMMON_REGS): Add rule for r1 back + comments. 2012-01-30 Thomas Quinot <quinot@adacore.com> * gnat_rm.texi, sem_dist.adb, sem_dist.ads, einfo.ads, sem_prag.adb, sem_ch12.adb, sem_attr.adb, aspects.adb, aspects.ads, par-prag.adb, sem_cat.adb, snames.ads-tmpl (Sem_Dist.Is_Valid_Remote_Object_Type): New subprogram (extracted from Sem_Cat.Validate_Remote_Access_Object_Type_Declaration). (Einfo.Is_Remote_Types): Now applies to generic types. Update documentation accordingly. (Sem_Ch12.Analyze_Associations): A RACW type is acceptable as actual for a formal type to which a pragma Remote_Access_Type applies. (Aspects, Par.Prag, Sem_Prag): Support for new pramga/aspect Remote_Access_Type. (Sem_Attr.Analyze_Attribute, case Stub_Type): Attribute can be applied to a generic type if pragma Remote_Access_Type applies, in which case the type of the attribute is System.Partition_Interface.RACW_Stub_Type. From-SVN: r183698
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog28
-rw-r--r--gcc/ada/a-cbdlli.adb8
-rw-r--r--gcc/ada/a-cdlili.adb42
-rw-r--r--gcc/ada/a-cidlli.adb9
-rwxr-xr-xgcc/ada/aspects.adb1
-rwxr-xr-xgcc/ada/aspects.ads6
-rw-r--r--gcc/ada/einfo.ads4
-rw-r--r--gcc/ada/gnat_rm.texi29
-rw-r--r--gcc/ada/par-prag.adb3
-rw-r--r--gcc/ada/sem_attr.adb28
-rw-r--r--gcc/ada/sem_cat.adb73
-rw-r--r--gcc/ada/sem_ch12.adb33
-rw-r--r--gcc/ada/sem_dist.adb46
-rw-r--r--gcc/ada/sem_dist.ads7
-rw-r--r--gcc/ada/sem_prag.adb36
-rw-r--r--gcc/ada/sigtramp-ppcvxw.c16
-rw-r--r--gcc/ada/snames.ads-tmpl2
17 files changed, 258 insertions, 113 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bfc7f2e..f0b84ca 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2012-01-30 Robert Dewar <dewar@adacore.com>
+
+ * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb: Minor reformatting.
+
+2012-01-30 Olivier Hainque <hainque@adacore.com>
+
+ * sigtramp-ppcvxw.c (CFI_COMMON_REGS): Add rule for r1 back +
+ comments.
+
+2012-01-30 Thomas Quinot <quinot@adacore.com>
+
+ * gnat_rm.texi, sem_dist.adb, sem_dist.ads, einfo.ads, sem_prag.adb,
+ sem_ch12.adb, sem_attr.adb, aspects.adb, aspects.ads, par-prag.adb,
+ sem_cat.adb, snames.ads-tmpl (Sem_Dist.Is_Valid_Remote_Object_Type):
+ New subprogram (extracted from
+ Sem_Cat.Validate_Remote_Access_Object_Type_Declaration).
+ (Einfo.Is_Remote_Types): Now applies to generic types. Update
+ documentation accordingly.
+ (Sem_Ch12.Analyze_Associations): A RACW type is acceptable as
+ actual for a formal type to which a pragma Remote_Access_Type
+ applies.
+ (Aspects, Par.Prag, Sem_Prag): Support for new pramga/aspect
+ Remote_Access_Type.
+ (Sem_Attr.Analyze_Attribute, case Stub_Type): Attribute can
+ be applied to a generic type if pragma Remote_Access_Type
+ applies, in which case the type of the attribute is
+ System.Partition_Interface.RACW_Stub_Type.
+
2012-01-27 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Procedure>: Do not set
diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb
index 28c9622..df9bf22 100644
--- a/gcc/ada/a-cbdlli.adb
+++ b/gcc/ada/a-cbdlli.adb
@@ -2275,13 +2275,17 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
return False;
end if;
- if Position.Node = L.First then -- eliminates earlier disjunct
+ -- Eliminate earlier possibility
+
+ if Position.Node = L.First then
return True;
end if;
pragma Assert (N (Position.Node).Prev /= 0);
- if Position.Node = L.Last then -- eliminates earlier disjunct
+ -- ELiminate another possibility
+
+ if Position.Node = L.Last then
return True;
end if;
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb
index 1346e86..cfbcc36 100644
--- a/gcc/ada/a-cdlili.adb
+++ b/gcc/ada/a-cdlili.adb
@@ -2009,6 +2009,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
declare
L : List renames Position.Container.all;
+
begin
if L.Length = 0 then
return False;
@@ -2030,23 +2031,21 @@ package body Ada.Containers.Doubly_Linked_Lists is
return False;
end if;
- if Position.Node.Prev = null
- and then Position.Node /= L.First
- then
+ if Position.Node.Prev = null and then Position.Node /= L.First then
return False;
end if;
- pragma Assert (Position.Node.Prev /= null
- or else Position.Node = L.First);
+ pragma Assert
+ (Position.Node.Prev /= null
+ or else Position.Node = L.First);
- if Position.Node.Next = null
- and then Position.Node /= L.Last
- then
+ if Position.Node.Next = null and then Position.Node /= L.Last then
return False;
end if;
- pragma Assert (Position.Node.Next /= null
- or else Position.Node = L.Last);
+ pragma Assert
+ (Position.Node.Next /= null
+ or else Position.Node = L.Last);
if L.Length = 1 then
return L.First = L.Last;
@@ -2075,13 +2074,11 @@ package body Ada.Containers.Doubly_Linked_Lists is
if L.Length = 2 then
if L.First.Next /= L.Last then
return False;
- end if;
-
- if L.Last.Prev /= L.First then
+ elsif L.Last.Prev /= L.First then
return False;
+ else
+ return True;
end if;
-
- return True;
end if;
if L.First.Next = L.Last then
@@ -2092,13 +2089,17 @@ package body Ada.Containers.Doubly_Linked_Lists is
return False;
end if;
- if Position.Node = L.First then -- eliminates earlier disjunct
+ -- Eliminate earlier possibility
+
+ if Position.Node = L.First then
return True;
end if;
pragma Assert (Position.Node.Prev /= null);
- if Position.Node = L.Last then -- eliminates earlier disjunct
+ -- Eliminate earlier possibility
+
+ if Position.Node = L.Last then
return True;
end if;
@@ -2115,9 +2116,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
if L.Length = 3 then
if L.First.Next /= Position.Node then
return False;
- end if;
-
- if L.Last.Prev /= Position.Node then
+ elsif L.Last.Prev /= Position.Node then
return False;
end if;
end if;
@@ -2134,11 +2133,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
(Stream : not null access Root_Stream_Type'Class;
Item : List)
is
- Node : Node_Access := Item.First;
+ Node : Node_Access;
begin
Count_Type'Base'Write (Stream, Item.Length);
+ Node := Item.First;
while Node /= null loop
Element_Type'Write (Stream, Node.Element);
Node := Node.Next;
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb
index 9d4eea1..cac6e9c 100644
--- a/gcc/ada/a-cidlli.adb
+++ b/gcc/ada/a-cidlli.adb
@@ -2098,6 +2098,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
declare
L : List renames Position.Container.all;
+
begin
if L.Length = 0 then
return False;
@@ -2119,15 +2120,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
return False;
end if;
- if Position.Node.Prev = null
- and then Position.Node /= L.First
- then
+ if Position.Node.Prev = null and then Position.Node /= L.First then
return False;
end if;
- if Position.Node.Next = null
- and then Position.Node /= L.Last
- then
+ if Position.Node.Next = null and then Position.Node /= L.Last then
return False;
end if;
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 5894a46..a0105d9 100755
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -295,6 +295,7 @@ package body Aspects is
Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
Aspect_Priority => Aspect_Priority,
Aspect_Pure_Function => Aspect_Pure_Function,
+ Aspect_Remote_Access_Type => Aspect_Remote_Access_Type,
Aspect_Read => Aspect_Read,
Aspect_Shared => Aspect_Atomic,
Aspect_Size => Aspect_Size,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 2f60cb9..74eee35 100755
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2010-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
@@ -129,6 +129,7 @@ package Aspects is
Aspect_Persistent_BSS, -- GNAT
Aspect_Preelaborable_Initialization,
Aspect_Pure_Function, -- GNAT
+ Aspect_Remote_Access_Type, -- GNAT
Aspect_Shared, -- GNAT (equivalent to Atomic)
Aspect_Suppress_Debug_Info, -- GNAT
Aspect_Unchecked_Union,
@@ -183,6 +184,7 @@ package Aspects is
Aspect_Pure_05 => True,
Aspect_Pure_12 => True,
Aspect_Pure_Function => True,
+ Aspect_Remote_Access_Type => True,
Aspect_Shared => True,
Aspect_Suppress_Debug_Info => True,
Aspect_Test_Case => True,
@@ -299,6 +301,7 @@ package Aspects is
-----------------------------------------
-- Table linking aspect names and id's
+ -- Shouldn't this be automatically generated in Snames???
Aspect_Names : constant array (Aspect_Id) of Name_Id := (
No_Aspect => No_Name,
@@ -357,6 +360,7 @@ package Aspects is
Aspect_Pure_12 => Name_Pure_12,
Aspect_Pure_Function => Name_Pure_Function,
Aspect_Read => Name_Read,
+ Aspect_Remote_Access_Type => Name_Remote_Access_Type,
Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
Aspect_Remote_Types => Name_Remote_Types,
Aspect_Shared => Name_Shared,
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index be60765..6151fc0 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -2721,6 +2721,8 @@ package Einfo is
-- Present in all entities. Set in E_Package and E_Generic_Package
-- entities to which a pragma Remote_Types is applied, and also on
-- entities declared in the visible part of the spec of such a package.
+-- Also set for generic formal types to which pragma Remote_Access_Type
+-- applies.
-- Is_Renaming_Of_Object (Flag112)
-- Present in all entities, set only for a variable or constant for
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index fb2be33..72feb25 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -186,6 +186,7 @@ Implementation Defined Pragmas
* Pragma Profile (Restricted)::
* Pragma Psect_Object::
* Pragma Pure_Function::
+* Pragma Remote_Access_Type::
* Pragma Restriction_Warnings::
* Pragma Shared::
* Pragma Short_Circuit_And_Or::
@@ -824,6 +825,7 @@ consideration, the use of these pragmas should be minimized.
* Pragma Profile (Restricted)::
* Pragma Psect_Object::
* Pragma Pure_Function::
+* Pragma Remote_Access_Type::
* Pragma Restriction_Warnings::
* Pragma Shared::
* Pragma Short_Circuit_And_Or::
@@ -4479,6 +4481,32 @@ function is also considered pure from an optimization point of view, but the
unit is not a Pure unit in the categorization sense. So for example, a function
thus marked is free to @code{with} non-pure units.
+@node Pragma Remote_Access_Type
+@unnumberedsec Pragma Remote_Access_Type
+@findex Remote_Access_Type
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Remote_Access_Type ([Entity =>] formal_access_type_LOCAL_NAME);
+@end smallexample
+
+@noindent
+This pragma appears in the formal part of a generic declaration.
+It specifies an exception to the RM rule from E.2.2(17/2), which forbids
+the use of a remote access to class-wide type as actual for a formal
+access type.
+
+When this pragma applies to a formal access type @code{Entity}, that
+type is treated as a remote access to class-wide type in the generic.
+It must be a formal general access type, and its designated type must
+be the class-wide type of a formal tagged limited private type from the
+same generic declaration.
+
+In the generic unit, the formal type is subject to all restrictions
+pertaining to remote access to class-wide types. At instantiation, the
+actual type must be a remote access to class-wide type.
+
@node Pragma Restriction_Warnings
@unnumberedsec Pragma Restriction_Warnings
@findex Restriction_Warnings
@@ -16803,6 +16831,7 @@ A complete description of the AIs may be found in
@item @code{Predicate} @tab
@item @code{Preelaborable_Initialization} @tab
@item @code{Pure_Function} @tab -- GNAT
+@item @code{Remote_Access_Type} @tab -- GNAT
@item @code{Shared} @tab -- GNAT
@item @code{Size} @tab
@item @code{Storage_Pool} @tab
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index b3d029f..328ddb6 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -1219,6 +1219,7 @@ begin
Pragma_Pure_Function |
Pragma_Queuing_Policy |
Pragma_Relative_Deadline |
+ Pragma_Remote_Access_Type |
Pragma_Remote_Call_Interface |
Pragma_Remote_Types |
Pragma_Restricted_Run_Time |
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 6e1493a..d40f133 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -4636,9 +4636,29 @@ package body Sem_Attr is
Check_Type;
Check_E0;
- if Is_Remote_Access_To_Class_Wide_Type (P_Type) then
- Rewrite (N,
- New_Occurrence_Of (Corresponding_Stub_Type (P_Type), Loc));
+ if Is_Remote_Access_To_Class_Wide_Type (Base_Type (P_Type)) then
+
+ if not Is_Generic_Type (P_Type) then
+ -- For a real RACW [sub]type, use corresponding stub type
+
+ Rewrite (N,
+ New_Occurrence_Of
+ (Corresponding_Stub_Type (Base_Type (P_Type)), Loc));
+
+ else
+ -- For a generic type (that has been marked as an RACW using
+ -- the Remote_Access_Type aspect or pragma), use a generic RACW
+ -- stub type. Note that if the actual is not a remote access
+ -- type, the instantiation will fail.
+
+ -- Note: we go to the underlying type here because the view
+ -- returned by RTE (RE_RACW_Stub_Type) might be incomplete.
+
+ Rewrite (N,
+ New_Occurrence_Of
+ (Underlying_Type (RTE (RE_RACW_Stub_Type)), Loc));
+ end if;
+
else
Error_Attr_P
("prefix of% attribute must be remote access to classwide");
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 4d1794a..d73314d 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -37,6 +37,7 @@ with Opt; use Opt;
with Sem; use Sem;
with Sem_Attr; use Sem_Attr;
with Sem_Aux; use Sem_Aux;
+with Sem_Dist; use Sem_Dist;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
@@ -1661,63 +1662,9 @@ package body Sem_Cat is
----------------------------------------------------
procedure Validate_Remote_Access_Object_Type_Declaration (T : Entity_Id) is
-
- function Is_Valid_Remote_Object_Type (E : Entity_Id) return Boolean;
- -- True if tagged type E is a valid candidate as the root type of the
- -- designated type for a RACW, i.e. a tagged limited private type, or a
- -- limited interface type, or a private extension of such a type.
-
- ---------------------------------
- -- Is_Valid_Remote_Object_Type --
- ---------------------------------
-
- function Is_Valid_Remote_Object_Type (E : Entity_Id) return Boolean is
- P : constant Node_Id := Parent (E);
-
- begin
- pragma Assert (Is_Tagged_Type (E));
-
- -- Simple case: a limited private type
-
- if Nkind (P) = N_Private_Type_Declaration
- and then Is_Limited_Record (E)
- then
- return True;
-
- -- AI05-0060 (Binding Interpretation): A limited interface is a legal
- -- ancestor for the designated type of an RACW type.
-
- elsif Is_Limited_Record (E) and then Is_Limited_Interface (E) then
- return True;
-
- -- A generic tagged limited type is a valid candidate. Limitedness
- -- will be checked again on the actual at instantiation point.
-
- elsif Nkind (P) = N_Formal_Type_Declaration
- and then Ekind (E) = E_Record_Type_With_Private
- and then Is_Generic_Type (E)
- and then Is_Limited_Record (E)
- then
- return True;
-
- -- A private extension declaration is a valid candidate if its parent
- -- type is.
-
- elsif Nkind (P) = N_Private_Extension_Declaration then
- return Is_Valid_Remote_Object_Type (Etype (E));
-
- else
- return False;
- end if;
- end Is_Valid_Remote_Object_Type;
-
- -- Local variables
-
Direct_Designated_Type : Entity_Id;
Desig_Type : Entity_Id;
- -- Start of processing for Validate_Remote_Access_Object_Type_Declaration
-
begin
-- We are called from Analyze_Full_Type_Declaration, and the Nkind of
-- the given node is N_Access_To_Object_Definition.
@@ -1793,18 +1740,16 @@ package body Sem_Cat is
-- The actual parameter of generic instantiation must not be such a
-- type if the formal parameter is of an access type.
- -- On entry, there are five cases
+ -- On entry, there are several cases:
-- 1. called from sem_attr Analyze_Attribute where attribute name is
-- either Storage_Pool or Storage_Size.
-- 2. called from exp_ch4 Expand_N_Allocator
- -- 3. called from sem_ch12 Analyze_Associations
+ -- 3. called from sem_ch4 Analyze_Explicit_Dereference
- -- 4. called from sem_ch4 Analyze_Explicit_Dereference
-
- -- 5. called from sem_res Resolve_Actuals
+ -- 4. called from sem_res Resolve_Actuals
if K = N_Attribute_Reference then
E := Etype (Prefix (N));
@@ -1822,14 +1767,6 @@ package body Sem_Cat is
return;
end if;
- elsif K in N_Has_Entity then
- E := Entity (N);
-
- if Is_Remote_Access_To_Class_Wide_Type (E) then
- Error_Msg_N ("incorrect remote type generic actual", N);
- return;
- end if;
-
-- This subprogram also enforces the checks in E.2.2(13). A value of
-- such type must not be dereferenced unless as controlling operand of
-- a dispatching call. Explicit dereferences not coming from source are
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index a954ccd..ed7357a 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1442,14 +1442,43 @@ package body Sem_Ch12 is
end if;
-- A remote access-to-class-wide type is not a legal actual
- -- for a generic formal of an access type (E.2.2(17)).
+ -- for a generic formal of an access type (E.2.2(17/2)).
+ -- In GNAT an exception to this rule is introduced when
+ -- the formal is marked as remote using implementation
+ -- defined aspect/pragma Remote_Access_Type. In that case
+ -- the actual must be remote as well.
if Nkind (Analyzed_Formal) = N_Formal_Type_Declaration
and then
Nkind (Formal_Type_Definition (Analyzed_Formal)) =
N_Access_To_Object_Definition
then
- Validate_Remote_Access_To_Class_Wide_Type (Match);
+ declare
+ Formal_Ent : constant Entity_Id :=
+ Defining_Identifier (Analyzed_Formal);
+ begin
+ if Is_Remote_Access_To_Class_Wide_Type (Entity (Match))
+ = Is_Remote_Types (Formal_Ent)
+ then
+ -- Remoteness of formal and actual match
+
+ null;
+
+ elsif Is_Remote_Types (Formal_Ent) then
+
+ -- Remote formal, non-remote actual
+
+ Error_Msg_NE
+ ("actual for& must be remote", Match, Formal_Ent);
+
+ else
+ -- Non-remote formal, remote actual
+
+ Error_Msg_NE
+ ("actual for& may not be remote",
+ Match, Formal_Ent);
+ end if;
+ end;
end if;
when N_Formal_Subprogram_Declaration =>
diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb
index f30e55d..072efa2 100644
--- a/gcc/ada/sem_dist.adb
+++ b/gcc/ada/sem_dist.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -287,6 +287,50 @@ package body Sem_Dist is
end case;
end Is_RACW_Stub_Type_Operation;
+ ---------------------------------
+ -- Is_Valid_Remote_Object_Type --
+ ---------------------------------
+
+ function Is_Valid_Remote_Object_Type (E : Entity_Id) return Boolean is
+ P : constant Node_Id := Parent (E);
+
+ begin
+ pragma Assert (Is_Tagged_Type (E));
+
+ -- Simple case: a limited private type
+
+ if Nkind (P) = N_Private_Type_Declaration
+ and then Is_Limited_Record (E)
+ then
+ return True;
+
+ -- AI05-0060 (Binding Interpretation): A limited interface is a legal
+ -- ancestor for the designated type of an RACW type.
+
+ elsif Is_Limited_Record (E) and then Is_Limited_Interface (E) then
+ return True;
+
+ -- A generic tagged limited type is a valid candidate. Limitedness will
+ -- be checked again on the actual at instantiation point.
+
+ elsif Nkind (P) = N_Formal_Type_Declaration
+ and then Ekind (E) = E_Record_Type_With_Private
+ and then Is_Generic_Type (E)
+ and then Is_Limited_Record (E)
+ then
+ return True;
+
+ -- A private extension declaration is a valid candidate if its parent
+ -- type is.
+
+ elsif Nkind (P) = N_Private_Extension_Declaration then
+ return Is_Valid_Remote_Object_Type (Etype (E));
+
+ else
+ return False;
+ end if;
+ end Is_Valid_Remote_Object_Type;
+
------------------------------------
-- Package_Specification_Of_Scope --
------------------------------------
diff --git a/gcc/ada/sem_dist.ads b/gcc/ada/sem_dist.ads
index 38a164a..0381bed 100644
--- a/gcc/ada/sem_dist.ads
+++ b/gcc/ada/sem_dist.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
@@ -40,6 +40,11 @@ package Sem_Dist is
-- (Exp_Dist.PCS_Version_Number) in Rtsfind.RTE.Check_RPC.
-- If no PCS version information is available, 0 is returned.
+ function Is_Valid_Remote_Object_Type (E : Entity_Id) return Boolean;
+ -- True if tagged type E is a valid candidate as the root type of the
+ -- designated type for a RACW, i.e. a tagged limited private type, or a
+ -- limited interface type, or a private extension of such a type.
+
procedure Add_Stub_Constructs (N : Node_Id);
-- Create the stubs constructs for a remote call interface package
-- specification or body or for a shared passive specification. For caller
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 26289cb..b4df53f 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -710,7 +710,7 @@ package body Sem_Prag is
procedure Fix_Error (Msg : in out String);
-- This is called prior to issuing an error message. Msg is a string
- -- which typically contains the substring pragma. If the current pragma
+ -- that typically contains the substring "pragma". If the current pragma
-- comes from an aspect, each such "pragma" substring is replaced with
-- the characters "aspect", and if Error_Msg_Name_1 is Name_Precondition
-- (resp Name_Postcondition) it is changed to Name_Pre (resp Name_Post).
@@ -12890,6 +12890,39 @@ package body Sem_Prag is
end if;
end Relative_Deadline;
+ ------------------------
+ -- Remote_Access_Type --
+ ------------------------
+
+ -- pragma Remote_Access_Type ([Entity =>] formal_type_LOCAL_NAME);
+
+ when Pragma_Remote_Access_Type => Remote_Access_Type : declare
+ E : Entity_Id;
+
+ begin
+ GNAT_Pragma;
+ Check_Arg_Count (1);
+ Check_Optional_Identifier (Arg1, Name_Entity);
+ Check_Arg_Is_Local_Name (Arg1);
+ E := Entity (Get_Pragma_Arg (Arg1));
+
+ if Nkind (Parent (E)) = N_Formal_Type_Declaration
+ and then Ekind (E) = E_General_Access_Type
+ and then Is_Class_Wide_Type (Directly_Designated_Type (E))
+ and then Scope (Root_Type (Directly_Designated_Type (E)))
+ = Scope (E)
+ and then Is_Valid_Remote_Object_Type
+ (Root_Type (Directly_Designated_Type (E)))
+ then
+ Set_Is_Remote_Types (E);
+
+ else
+ Error_Pragma_Arg
+ ("pragma% applies only to formal access to classwide types",
+ Arg1);
+ end if;
+ end Remote_Access_Type;
+
---------------------------
-- Remote_Call_Interface --
---------------------------
@@ -15071,6 +15104,7 @@ package body Sem_Prag is
Pragma_Queuing_Policy => -1,
Pragma_Ravenscar => -1,
Pragma_Relative_Deadline => -1,
+ Pragma_Remote_Access_Type => -1,
Pragma_Remote_Call_Interface => -1,
Pragma_Remote_Types => -1,
Pragma_Restricted_Run_Time => -1,
diff --git a/gcc/ada/sigtramp-ppcvxw.c b/gcc/ada/sigtramp-ppcvxw.c
index a8fc801..bb6945b 100644
--- a/gcc/ada/sigtramp-ppcvxw.c
+++ b/gcc/ada/sigtramp-ppcvxw.c
@@ -6,7 +6,7 @@
* *
* Asm Implementation File *
* *
- * Copyright (C) 2011, Free Software Foundation, Inc. *
+ * Copyright (C) 2011-2012, 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- *
@@ -169,15 +169,23 @@ CR(".cfi_def_cfa " S(CFA_REG) ", 0")
/* Register location blocks
------------------------
- Rules to find registers of interest from the CFA. This should
- comprise all the non-volatile registers relevant to the interrupted
- context. */
+ Rules to find registers of interest from the CFA. This should comprise
+ all the non-volatile registers relevant to the interrupted context.
+
+ Note that we include r1 in this set, unlike the libgcc unwinding
+ fallbacks. This is useful for fallbacks to allow the use of r1 in CFI
+ expressions and the absence of rule for r1 gets compensated by using the
+ target CFA instead. We don't need the expression facility here and
+ setup a fake CFA to allow very simple offset expressions, so having a
+ rule for r1 is the proper thing to do. We for sure have observed
+ crashes in some cases without it. */
#define COMMON_CFI(REG) \
".cfi_offset " S(REGNO_##REG) "," S(REG_SET_##REG)
#define CFI_COMMON_REGS \
CR("# CFI for common registers\n") \
+TCR(COMMON_CFI(GR(1))) \
TCR(COMMON_CFI(GR(2))) \
TCR(COMMON_CFI(GR(3))) \
TCR(COMMON_CFI(GR(4))) \
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index a091047..aecebcd 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -535,6 +535,7 @@ package Snames is
Name_Pure_12 : constant Name_Id := N + $; -- GNAT
Name_Pure_Function : constant Name_Id := N + $; -- GNAT
Name_Relative_Deadline : constant Name_Id := N + $; -- Ada 05
+ Name_Remote_Access_Type : constant Name_Id := N + $; -- GNAT
Name_Remote_Call_Interface : constant Name_Id := N + $;
Name_Remote_Types : constant Name_Id := N + $;
Name_Share_Generic : constant Name_Id := N + $; -- GNAT
@@ -1687,6 +1688,7 @@ package Snames is
Pragma_Pure_12,
Pragma_Pure_Function,
Pragma_Relative_Deadline,
+ Pragma_Remote_Access_Type,
Pragma_Remote_Call_Interface,
Pragma_Remote_Types,
Pragma_Share_Generic,