FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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
This commit is contained in:
Arnaud Charlet 2012-01-30 11:24:17 +01:00
parent 4f0534570b
commit 25081892c4
17 changed files with 258 additions and 113 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gcc/ada/ChangeLog
View file

@ -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

8
gcc/ada/a-cbdlli.adb
View file

@ -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;

38
gcc/ada/a-cdlili.adb
View file

@ -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,22 +2031,20 @@ 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
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
pragma Assert
(Position.Node.Next /= null
or else Position.Node = L.Last);
if L.Length = 1 then
@ -2075,14 +2074,12 @@ 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;
end if;
else
return True;
end if;
end if;
if L.First.Next = L.Last then
return False;
@ -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;

9
gcc/ada/a-cidlli.adb
View file

@ -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;

1
gcc/ada/aspects.adb
View file

@ -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,

4
gcc/ada/aspects.ads
View file

@ -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,

4
gcc/ada/einfo.ads
View file

@ -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

29
gcc/ada/gnat_rm.texi
View file

@ -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

3
gcc/ada/par-prag.adb
View file

@ -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 |

26
gcc/ada/sem_attr.adb
View file

@ -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
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 (P_Type), Loc));
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");

73
gcc/ada/sem_cat.adb
View file

@ -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

33
gcc/ada/sem_ch12.adb
View file

@ -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 =>

46
gcc/ada/sem_dist.adb
View file

@ -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 --
------------------------------------

7
gcc/ada/sem_dist.ads
View file

@ -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

36
gcc/ada/sem_prag.adb
View file

@ -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,

16
gcc/ada/sigtramp-ppcvxw.c
View file

@ -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))) \

2
gcc/ada/snames.ads-tmpl
View file

@ -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,