===================================================================
@@ -8378,6 +8378,113 @@ package body Sem_Prag is
Arg_First_Optional_Parameter => First_Optional_Parameter);
end Import_Valued_Procedure;
+ -----------------
+ -- Independent --
+ -----------------
+
+ -- pragma Independent (LOCAL_NAME);
+
+ when Pragma_Independent => Independent : declare
+ E_Id : Node_Id;
+ E : Entity_Id;
+ D : Node_Id;
+ K : Node_Kind;
+
+ begin
+ Check_Ada_83_Warning;
+ Ada_2012_Pragma;
+ Check_No_Identifiers;
+ Check_Arg_Count (1);
+ Check_Arg_Is_Local_Name (Arg1);
+ E_Id := Expression (Arg1);
+
+ if Etype (E_Id) = Any_Type then
+ return;
+ end if;
+
+ E := Entity (E_Id);
+ D := Declaration_Node (E);
+ K := Nkind (D);
+
+ if Is_Type (E) then
+ if Rep_Item_Too_Early (E, N)
+ or else
+ Rep_Item_Too_Late (E, N)
+ then
+ return;
+ else
+ Check_First_Subtype (Arg1);
+ end if;
+
+ elsif K = N_Object_Declaration
+ or else (K = N_Component_Declaration
+ and then Original_Record_Component (E) = E)
+ then
+ if Rep_Item_Too_Late (E, N) then
+ return;
+ end if;
+
+ else
+ Error_Pragma_Arg
+ ("inappropriate entity for pragma%", Arg1);
+ end if;
+
+ Independence_Checks.Append ((N, E));
+ end Independent;
+
+ ----------------------------
+ -- Independent_Components --
+ ----------------------------
+
+ -- pragma Atomic_Components (array_LOCAL_NAME);
+
+ -- This processing is shared by Volatile_Components
+
+ when Pragma_Independent_Components => Independent_Components : declare
+ E_Id : Node_Id;
+ E : Entity_Id;
+ D : Node_Id;
+ K : Node_Kind;
+
+ begin
+ Check_Ada_83_Warning;
+ Ada_2012_Pragma;
+ Check_No_Identifiers;
+ Check_Arg_Count (1);
+ Check_Arg_Is_Local_Name (Arg1);
+ E_Id := Expression (Arg1);
+
+ if Etype (E_Id) = Any_Type then
+ return;
+ end if;
+
+ E := Entity (E_Id);
+
+ if Rep_Item_Too_Early (E, N)
+ or else
+ Rep_Item_Too_Late (E, N)
+ then
+ return;
+ end if;
+
+ D := Declaration_Node (E);
+ K := Nkind (D);
+
+ if (K = N_Full_Type_Declaration
+ and then (Is_Array_Type (E) or else Is_Record_Type (E)))
+ or else
+ ((Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
+ and then Nkind (D) = N_Object_Declaration
+ and then Nkind (Object_Definition (D)) =
+ N_Constrained_Array_Definition)
+ then
+ Independence_Checks.Append ((N, E));
+
+ else
+ Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
+ end if;
+ end Independent_Components;
+
------------------------
-- Initialize_Scalars --
------------------------
@@ -12971,6 +13078,8 @@ package body Sem_Prag is
Pragma_Import_Object => 0,
Pragma_Import_Procedure => 0,
Pragma_Import_Valued_Procedure => 0,
+ Pragma_Independent => 0,
+ Pragma_Independent_Components => 0,
Pragma_Initialize_Scalars => -1,
Pragma_Inline => 0,
Pragma_Inline_Always => 0,
===================================================================
@@ -704,6 +704,7 @@ begin
Treepr.Tree_Dump;
Sem_Ch13.Validate_Unchecked_Conversions;
Sem_Ch13.Validate_Address_Clauses;
+ Sem_Ch13.Validate_Independence;
Errout.Output_Messages;
Namet.Finalize;
@@ -880,6 +881,7 @@ begin
Sem_Ch13.Validate_Unchecked_Conversions;
Sem_Ch13.Validate_Address_Clauses;
+ Sem_Ch13.Validate_Independence;
Errout.Finalize (Last_Call => True);
Errout.Output_Messages;
Treepr.Tree_Dump;
@@ -913,6 +915,7 @@ begin
then
Sem_Ch13.Validate_Unchecked_Conversions;
Sem_Ch13.Validate_Address_Clauses;
+ Sem_Ch13.Validate_Independence;
Errout.Finalize (Last_Call => True);
Errout.Output_Messages;
Write_ALI (Object => False);
@@ -980,6 +983,11 @@ begin
Sem_Ch13.Validate_Address_Clauses;
+ -- Validate independence pragmas (again using values annotated by
+ -- the back end for component layout etc.)
+
+ Sem_Ch13.Validate_Independence;
+
-- Now we complete output of errors, rep info and the tree info. These
-- are delayed till now, since it is perfectly possible for gigi to
-- generate errors, modify the tree (in particular by setting flags
===================================================================
@@ -1131,6 +1131,8 @@ begin
Pragma_Import_Object |
Pragma_Import_Procedure |
Pragma_Import_Valued_Procedure |
+ Pragma_Independent |
+ Pragma_Independent_Components |
Pragma_Initialize_Scalars |
Pragma_Inline |
Pragma_Inline_Always |
===================================================================
@@ -52,7 +52,6 @@ with Sem_Warn; use Sem_Warn;
with Snames; use Snames;
with Stand; use Stand;
with Sinfo; use Sinfo;
-with Table;
with Targparm; use Targparm;
with Ttypes; use Ttypes;
with Tbuild; use Tbuild;
@@ -4174,6 +4173,8 @@ package body Sem_Ch13 is
procedure Initialize is
begin
+ Address_Clause_Checks.Init;
+ Independence_Checks.Init;
Unchecked_Conversions.Init;
end Initialize;
@@ -5069,6 +5070,292 @@ package body Sem_Ch13 is
end loop;
end Validate_Address_Clauses;
+ ---------------------------
+ -- Validate_Independence --
+ ---------------------------
+
+ procedure Validate_Independence is
+ SU : constant Uint := UI_From_Int (System_Storage_Unit);
+ N : Node_Id;
+ E : Entity_Id;
+ IC : Boolean;
+ Comp : Entity_Id;
+ Addr : Node_Id;
+ P : Node_Id;
+
+ procedure Check_Array_Type (Atyp : Entity_Id);
+ -- Checks if the array type Atyp has independent components, and
+ -- if not, outputs an appropriate set of error messages.
+
+ procedure No_Independence;
+ -- Output message that independence cannot be guaranteed
+
+ function OK_Component (C : Entity_Id) return Boolean;
+ -- Checks one component to see if it is independently accessible, and
+ -- if so yields True, otherwise yields False if independent access
+ -- cannot be guaranteed. This is a conservative routine, it only
+ -- returns True if it knows for sure, it returns False if it knows
+ -- there is a problem, or it cannot be sure there is no problem.
+
+ procedure Reason_Bad_Component (C : Entity_Id);
+ -- Outputs continuation message if a reason can be determined for
+ -- the component C being bad.
+
+ ----------------------
+ -- Check_Array_Type --
+ ----------------------
+
+ procedure Check_Array_Type (Atyp : Entity_Id) is
+ Ctyp : constant Entity_Id := Component_Type (Atyp);
+
+ begin
+ -- OK if no alignment clause, no pack, and no component size
+
+ if not Has_Component_Size_Clause (Atyp)
+ and then not Has_Alignment_Clause (Atyp)
+ and then not Is_Packed (Atyp)
+ then
+ return;
+ end if;
+
+ -- Check actual component size
+
+ if not Known_Component_Size (Atyp)
+ or else not (Addressable (Component_Size (Atyp))
+ and then Component_Size (Atyp) < 64)
+ or else Component_Size (Atyp) mod Esize (Ctyp) /= 0
+ then
+ No_Independence;
+
+ -- Bad component size, check reason
+
+ if Has_Component_Size_Clause (Atyp) then
+ P :=
+ Get_Attribute_Definition_Clause
+ (Atyp, Attribute_Component_Size);
+
+ if Present (P) then
+ Error_Msg_Sloc := Sloc (P);
+ Error_Msg_N ("\because of Component_Size clause#", N);
+ return;
+ end if;
+ end if;
+
+ if Is_Packed (Atyp) then
+ P := Get_Rep_Pragma (Atyp, Name_Pack);
+
+ if Present (P) then
+ Error_Msg_Sloc := Sloc (P);
+ Error_Msg_N ("\because of pragma Pack#", N);
+ return;
+ end if;
+ end if;
+
+ -- No reason found, just return
+
+ return;
+ end if;
+
+ -- Array type is OK independence-wise
+
+ return;
+ end Check_Array_Type;
+
+ ---------------------
+ -- No_Independence --
+ ---------------------
+
+ procedure No_Independence is
+ begin
+ if Pragma_Name (N) = Name_Independent then
+ Error_Msg_NE
+ ("independence cannot be guaranteed for&", N, E);
+ else
+ Error_Msg_NE
+ ("independent components cannot be guaranteed for&", N, E);
+ end if;
+ end No_Independence;
+
+ ------------------
+ -- OK_Component --
+ ------------------
+
+ function OK_Component (C : Entity_Id) return Boolean is
+ Rec : constant Entity_Id := Scope (C);
+ Ctyp : constant Entity_Id := Etype (C);
+
+ begin
+ -- OK if no component clause, no Pack, and no alignment clause
+
+ if No (Component_Clause (C))
+ and then not Is_Packed (Rec)
+ and then not Has_Alignment_Clause (Rec)
+ then
+ return True;
+ end if;
+
+ -- Here we look at the actual component layout. A component is
+ -- addressable if its size is a multiple of the Esize of the
+ -- component type, and its starting position in the record has
+ -- appropriate alignment, and the record itself has appropriate
+ -- alignment to guarantee the component alignment.
+
+ -- Make sure sizes are static, always assume the worst for any
+ -- cases where we cannot check static values.
+
+ if not (Known_Static_Esize (C)
+ and then Known_Static_Esize (Ctyp))
+ then
+ return False;
+ end if;
+
+ -- Size of component must be addressable or greater than 64 bits
+ -- and a multiple of bytes.
+
+ if not Addressable (Esize (C))
+ and then Esize (C) < Uint_64
+ then
+ return False;
+ end if;
+
+ -- Check size is proper multiple
+
+ if Esize (C) mod Esize (Ctyp) /= 0 then
+ return False;
+ end if;
+
+ -- Check alignment of component is OK
+
+ if not Known_Component_Bit_Offset (C)
+ or else Component_Bit_Offset (C) < Uint_0
+ or else Component_Bit_Offset (C) mod Esize (Ctyp) /= 0
+ then
+ return False;
+ end if;
+
+ -- Check alignment of record type is OK
+
+ if not Known_Alignment (Rec)
+ or else (Alignment (Rec) * SU) mod Esize (Ctyp) /= 0
+ then
+ return False;
+ end if;
+
+ -- All tests passed, component is addressable
+
+ return True;
+ end OK_Component;
+
+ --------------------------
+ -- Reason_Bad_Component --
+ --------------------------
+
+ procedure Reason_Bad_Component (C : Entity_Id) is
+ Rec : constant Entity_Id := Scope (C);
+ Ctyp : constant Entity_Id := Etype (C);
+
+ begin
+ -- If component clause present assume that's the problem
+
+ if Present (Component_Clause (C)) then
+ Error_Msg_Sloc := Sloc (Component_Clause (C));
+ Error_Msg_N ("\because of Component_Clause#", N);
+ return;
+ end if;
+
+ -- If pragma Pack clause present, assume that's the problem
+
+ if Is_Packed (Rec) then
+ P := Get_Rep_Pragma (Rec, Name_Pack);
+
+ if Present (P) then
+ Error_Msg_Sloc := Sloc (P);
+ Error_Msg_N ("\because of pragma Pack#", N);
+ return;
+ end if;
+ end if;
+
+ -- See if record has bad alignment clause
+
+ if Has_Alignment_Clause (Rec)
+ and then Known_Alignment (Rec)
+ and then (Alignment (Rec) * SU) mod Esize (Ctyp) /= 0
+ then
+ P := Get_Attribute_Definition_Clause (Rec, Attribute_Alignment);
+
+ if Present (P) then
+ Error_Msg_Sloc := Sloc (P);
+ Error_Msg_N ("\because of Alignment clause#", N);
+ end if;
+ end if;
+
+ -- Couldn't find a reason, so return without a message
+
+ return;
+ end Reason_Bad_Component;
+
+ -- Start of processing for Validate_Independence
+
+ begin
+ for J in Independence_Checks.First .. Independence_Checks.Last loop
+ N := Independence_Checks.Table (J).N;
+ E := Independence_Checks.Table (J).E;
+ IC := Pragma_Name (N) = Name_Independent_Components;
+
+ -- Deal with component case
+
+ if Ekind (E) = E_Discriminant or else Ekind (E) = E_Component then
+ if not OK_Component (E) then
+ No_Independence;
+ Reason_Bad_Component (E);
+ goto Continue;
+ end if;
+ end if;
+
+ -- Deal with record with Independent_Components
+
+ if IC and then Is_Record_Type (E) then
+ Comp := First_Component_Or_Discriminant (E);
+ while Present (Comp) loop
+ if not OK_Component (Comp) then
+ No_Independence;
+ Reason_Bad_Component (Comp);
+ goto Continue;
+ end if;
+
+ Next_Component_Or_Discriminant (Comp);
+ end loop;
+ end if;
+
+ -- Deal with address clause case
+
+ if Is_Object (E) then
+ Addr := Address_Clause (E);
+
+ if Present (Addr) then
+ No_Independence;
+ Error_Msg_Sloc := Sloc (Addr);
+ Error_Msg_N ("\because of Address clause#", N);
+ goto Continue;
+ end if;
+ end if;
+
+ -- Deal with independent components for array type
+
+ if IC and then Is_Array_Type (E) then
+ Check_Array_Type (E);
+ end if;
+
+ -- Deal with independent components for array object
+
+ if IC and then Is_Object (E) and then Is_Array_Type (Etype (E)) then
+ Check_Array_Type (Etype (E));
+ end if;
+
+ <<Continue>> null;
+ end loop;
+ end Validate_Independence;
+
-----------------------------------
-- Validate_Unchecked_Conversion --
-----------------------------------
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2010, 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- --
@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
+with Table;
with Types; use Types;
with Uintp; use Uintp;
@@ -167,10 +168,10 @@ package Sem_Ch13 is
-- back end as required.
procedure Validate_Unchecked_Conversions;
- -- This routine is called after calling the backend to validate
- -- unchecked conversions for size and alignment appropriateness.
- -- The reason it is called that late is to take advantage of any
- -- back-annotation of size and alignment performed by the backend.
+ -- This routine is called after calling the backend to validate unchecked
+ -- conversions for size and alignment appropriateness. The reason it is
+ -- called that late is to take advantage of any back-annotation of size
+ -- and alignment performed by the backend.
procedure Validate_Address_Clauses;
-- This is called after the back end has been called (and thus after the
@@ -178,4 +179,34 @@ package Sem_Ch13 is
-- table of saved address clauses checking for suspicious alignments and
-- if necessary issuing warnings.
+ procedure Validate_Independence;
+ -- This is called after the back end has been called (and thus after the
+ -- layout of components has been back annotated). It goes through the
+ -- table of saved pragma Independent[_Component] entries, checking that
+ -- independence can be achieved, and if necessary issuing error mssags.
+
+ -------------------------------------
+ -- Table for Validate_Independence --
+ -------------------------------------
+
+ -- If a legal pragma Independent or Independent_Components is given for
+ -- an entity, then an entry is made in this table, to be checked by a
+ -- call to Validate_Independence after back annotation of layout is done.
+
+ type Independence_Check_Record is record
+ N : Node_Id;
+ -- The pragma Independent or Independent_Components
+
+ E : Entity_Id;
+ -- The entity to which it applies
+ end record;
+
+ package Independence_Checks is new Table.Table (
+ Table_Component_Type => Independence_Check_Record,
+ Table_Index_Type => Int,
+ Table_Low_Bound => 1,
+ Table_Initial => 20,
+ Table_Increment => 200,
+ Table_Name => "Independence_Checks");
+
end Sem_Ch13;
===================================================================
@@ -312,9 +312,13 @@ package Snames is
-- may be found in the appropriate section in unit Sem_Prag in file
-- sem-prag.adb, and they are documented in the GNAT reference manual.
- -- The entries marked Ada05 are Ada 2005 pragmas. They are implemented in
- -- Ada 83 and Ada 95 mode as well, where they are technically considered to
- -- be implementation dependent pragmas.
+ -- The entries marked Ada 05 are Ada 2005 pragmas. They are implemented
+ -- in Ada 83 and Ada 95 mode as well, where they are technically considered
+ -- to be implementation dependent pragmas.
+
+ -- The entries marked Ada 12 are Ada 2012 pragmas. They are implemented
+ -- in Ada 83, Ada 95, and Ada 2005 mode as well, where they are technically
+ -- considered to be implementation dependent pragmas.
-- The entries marked VMS are VMS specific pragmas that are recognized
-- only in OpenVMS versions of GNAT. They are ignored in other versions
@@ -407,7 +411,7 @@ package Snames is
Name_All_Calls_Remote : constant Name_Id := N + $;
Name_Annotate : constant Name_Id := N + $; -- GNAT
- -- Note: AST_Entry is not in this list because its name matches -- VMS
+ -- Note: AST_Entry is not in this list because its name matches -- VMS
-- the name of the corresponding attribute. However, it is
-- included in the definition of the type Pragma_Id, and the
-- functions Get_Pragma_Id and Is_Pragma_Id correctly recognize
@@ -452,13 +456,15 @@ package Snames is
Name_Import_Object : constant Name_Id := N + $; -- GNAT
Name_Import_Procedure : constant Name_Id := N + $; -- GNAT
Name_Import_Valued_Procedure : constant Name_Id := N + $; -- GNAT
+ Name_Independent : constant Name_Id := N + $; -- Ada 12
+ Name_Independent_Components : constant Name_Id := N + $; -- Ada 12
Name_Inline : constant Name_Id := N + $;
Name_Inline_Always : constant Name_Id := N + $; -- GNAT
Name_Inline_Generic : constant Name_Id := N + $; -- GNAT
Name_Inspection_Point : constant Name_Id := N + $;
-- Note: Interface is not in this list because its name -- GNAT
- -- matches an Ada 2005 keyword. However it is included in
+ -- matches an Ada 05 keyword. However it is included in
-- the definition of the type Attribute_Id, and the functions
-- Get_Pragma_Id and Is_Pragma_Id correctly recognize and
-- process Name_Storage_Size.
@@ -1172,7 +1178,7 @@ package Snames is
Name_Unaligned_Valid : constant Name_Id := N + $;
- -- Ada 2005 reserved words
+ -- Ada 05 reserved words
First_2005_Reserved_Word : constant Name_Id := N + $;
Name_Interface : constant Name_Id := N + $;
@@ -1531,6 +1537,8 @@ package Snames is
Pragma_Import_Object,
Pragma_Import_Procedure,
Pragma_Import_Valued_Procedure,
+ Pragma_Independent,
+ Pragma_Independent_Components,
Pragma_Inline,
Pragma_Inline_Always,
Pragma_Inline_Generic,
This patch implements AI05-0009, which describes two new pragmas, Independent and Independent_Components. The following examples show these pragmas in action: 1. package Indeperr is 2. -- Incorrect syntax cases 3. 4. type R is record 5. a : Integer; 6. pragma Independent (a); -- OK 7. b : Integer; 8. pragma Independent_Components (b); -- ERROR | >>> inappropriate entity for pragma "Independent_Components" 9. end record; 10. 11. a : integer; 12. pragma Independent (a); -- OK 13. 14. b : integer; 15. pragma Independent_Components (b); -- ERROR | >>> inappropriate entity for pragma "Independent_Components" 16. 17. xxx : exception; 18. pragma Independent (xxx); -- ERROR | >>> inappropriate entity for pragma "Independent" 19. end; 1. package Indeperrx is 2. -- Cases of independence not guaranteed 3. 4. a : integer; 5. pragma Independent (a); -- OK 6. 7. x : array (1 .. 10) of integer; 8. pragma Independent_Components (x); -- OK 9. 10. b1 : array (1 .. 10) of Boolean; 11. pragma Independent_Components (b1); -- OK 12. 13. type b2 is array (1 .. 10) of Boolean; 14. pragma Independent_Components (b2); -- ERROR | >>> independent components cannot be guaranteed for "b2" >>> because of pragma Pack at line 15 15. pragma Pack (b2); 16. 17. type b3 is array (1 .. 10) of Boolean; 18. pragma Independent_Components (b3); -- ERROR | >>> independent components cannot be guaranteed for "b3" >>> because of Component_Size clause at line 19 19. for b3'Component_Size use 1; 20. 21. type b4 is array (1 .. 10) of Boolean; 22. pragma Independent_Components (b4); -- OK 23. for b4'Component_Size use 16; 24. 25. v1 : Integer; 26. v2 : integer; 27. for v2'address use v1'address; 28. pragma Independent (v2); -- ERROR | >>> independence cannot be guaranteed for "v2" >>> because of Address clause at line 27 29. 30. type rr1 is record 31. A, B : Character; 32. end record; 33. pragma Independent_Components (RR1); -- OK 34. 35. type rr2 is record 36. A, B : Character; 37. end record; 38. pragma Independent_Components (RR2); -- OK 39. 40. for RR2 use record 41. A at 0 range 0 .. 31; 42. B at 4 range 0 .. 31; 43. end record; 44. 45. type rr3 is record 46. A, B : Character; 47. end record; 48. pragma Independent_Components (RR3); -- ERROR | >>> independent components cannot be guaranteed for "rr3" >>> because of Component_Clause at line 51 49. 50. for RR3 use record 51. A at 0 range 0 .. 9; 52. B at 0 range 10 .. 19; 53. end record; 54. 55. type rr4 is record 56. A, B : Boolean; 57. pragma Independent (A); -- OK 58. end record; 59. 60. type rr5 is record 61. A, B : Boolean; 62. pragma Independent (A); -- ERROR | >>> independence cannot be guaranteed for "A" >>> because of pragma Pack at line 64 63. end record; 64. pragma Pack (rr5); 65. 66. type rr6 is record 67. A, B : Boolean; 68. pragma Independent (B); -- ERROR | >>> independence cannot be guaranteed for "B" >>> because of Component_Clause at line 73 69. end record; 70. 71. for rr6 use record 72. A at 0 range 0 .. 3; 73. B at 0 range 4 .. 7; 74. end record; 75. 76. type rr7 is record 77. A : Integer; 78. pragma Independent (A); -- ERROR | >>> independence cannot be guaranteed for "A" >>> because of Alignment clause at line 81 79. B : Integer; 80. end record; 81. for rr7'Alignment use 1; 82. 83. 84. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-08 Robert Dewar <dewar@adacore.com> * gnat1drv.adb: Add call to Validate_Independence. * par-prag.adb: Add dummy entries for Independent, Independent_Componentsa. * sem_ch13.adb (Validate_Independence): New procedure (Initialize): Initialize address clause and independence check tables * sem_ch13.ads (Independence_Checks): New table (Validate_Independence): New procedure * sem_prag.adb: Add processing for pragma Independent[_Components] * snames.ads-tmpl: Add entries for pragma Independent[_Components]