diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index b6c19de0c79..51e2bb7f3ca 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -2372,17 +2372,17 @@ __gnat_number_of_cpus (void) { int cores = 1; -#if defined (linux) || defined (sun) || defined (AIX) || \ - (defined (__alpha__) && defined (_osf_)) || defined (__APPLE__) - cores = (int)sysconf(_SC_NPROCESSORS_ONLN); +#if defined (linux) || defined (sun) || defined (AIX) \ + || (defined (__alpha__) && defined (_osf_)) || defined (__APPLE__) + cores = (int) sysconf (_SC_NPROCESSORS_ONLN); #elif (defined (__mips) && defined (__sgi)) - cores = (int)sysconf(_SC_NPROC_ONLN); + cores = (int) sysconf (_SC_NPROC_ONLN); #elif defined (__hpux__) - struct pst_dynamic psd; - if (pstat_getdynamic(&psd, sizeof(psd), 1, 0) != -1) - cores = (int)psd.psd_proc_cnt; + struct pst_dynamic psd; + if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1) + cores = (int) psd.psd_proc_cnt; #endif diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 5073874940e..47ca88ef980 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -2704,6 +2704,12 @@ package body Atree is return From_Union (Nodes.Table (N + 3).Field8); end Ureal21; + function Flag3 (N : Node_Id) return Boolean is + begin + pragma Assert (N <= Nodes.Last); + return Nodes.Table (N).Flag3; + end Flag3; + function Flag4 (N : Node_Id) return Boolean is begin pragma Assert (N <= Nodes.Last); @@ -2803,7 +2809,7 @@ package body Atree is function Flag20 (N : Node_Id) return Boolean is begin pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 1).Unused_1; + return Nodes.Table (N + 1).Flag3; end Flag20; function Flag21 (N : Node_Id) return Boolean is @@ -2929,7 +2935,7 @@ package body Atree is function Flag41 (N : Node_Id) return Boolean is begin pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 2).Unused_1; + return Nodes.Table (N + 2).Flag3; end Flag41; function Flag42 (N : Node_Id) return Boolean is @@ -3463,7 +3469,7 @@ package body Atree is function Flag130 (N : Node_Id) return Boolean is begin pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 3).Unused_1; + return Nodes.Table (N + 3).Flag3; end Flag130; function Flag131 (N : Node_Id) return Boolean is @@ -3985,7 +3991,7 @@ package body Atree is function Flag217 (N : Node_Id) return Boolean is begin pragma Assert (Nkind (N) in N_Entity); - return Nodes.Table (N + 4).Unused_1; + return Nodes.Table (N + 4).Flag3; end Flag217; function Flag218 (N : Node_Id) return Boolean is @@ -4806,6 +4812,12 @@ package body Atree is Nodes.Table (N + 3).Field8 := To_Union (Val); end Set_Ureal21; + procedure Set_Flag3 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (N <= Nodes.Last); + Nodes.Table (N).Flag3 := Val; + end Set_Flag3; + procedure Set_Flag4 (N : Node_Id; Val : Boolean) is begin pragma Assert (N <= Nodes.Last); @@ -4905,7 +4917,7 @@ package body Atree is procedure Set_Flag20 (N : Node_Id; Val : Boolean) is begin pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 1).Unused_1 := Val; + Nodes.Table (N + 1).Flag3 := Val; end Set_Flag20; procedure Set_Flag21 (N : Node_Id; Val : Boolean) is @@ -5031,7 +5043,7 @@ package body Atree is procedure Set_Flag41 (N : Node_Id; Val : Boolean) is begin pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 2).Unused_1 := Val; + Nodes.Table (N + 2).Flag3 := Val; end Set_Flag41; procedure Set_Flag42 (N : Node_Id; Val : Boolean) is @@ -5693,7 +5705,7 @@ package body Atree is procedure Set_Flag130 (N : Node_Id; Val : Boolean) is begin pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 3).Unused_1 := Val; + Nodes.Table (N + 3).Flag3 := Val; end Set_Flag130; procedure Set_Flag131 (N : Node_Id; Val : Boolean) is @@ -6343,7 +6355,7 @@ package body Atree is procedure Set_Flag217 (N : Node_Id; Val : Boolean) is begin pragma Assert (Nkind (N) in N_Entity); - Nodes.Table (N + 4).Unused_1 := Val; + Nodes.Table (N + 4).Flag3 := Val; end Set_Flag217; procedure Set_Flag218 (N : Node_Id; Val : Boolean) is diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 8a1ae478e3e..9e29a57a59e 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -85,10 +85,6 @@ package Atree is -- In_List A flag used to indicate if the node is a member -- of a node list. - -- Rewrite_Sub A flag set if the node has been rewritten using - -- the Rewrite procedure. The original value of the - -- node is retrievable with Original_Node. - -- Rewrite_Ins A flag set if a node is marked as a rewrite inserted -- node as a result of a call to Mark_Rewrite_Insertion. @@ -155,17 +151,18 @@ package Atree is -- it is useful to be able to do untyped traversals, and an internal -- package in Atree allows for direct untyped accesses in such cases. - -- Flag4 Fifteen Boolean flags (use depends on Nkind and + -- Flag3 + -- Flag4 Sixteen Boolean flags (use depends on Nkind and -- Flag5 Ekind, as described for FieldN). Again the access -- Flag6 is usually via subprograms in Sinfo and Einfo which -- Flag7 provide high-level synonyms for these flags, and -- Flag8 contain debugging code that checks that the values -- Flag9 in Nkind and Ekind are appropriate for the access. -- Flag10 - -- Flag11 Note that Flag1-3 are missing from this list. The - -- Flag12 first three flag positions are reserved for the - -- Flag13 standard flags (Comes_From_Source, Error_Posted, - -- Flag14 and Analyzed) + -- Flag11 Note that Flag1-2 are missing from this list. For + -- Flag12 historical reasons, these flag names are unused. + -- Flag13 + -- Flag14 -- Flag15 -- Flag16 -- Flag17 @@ -184,9 +181,9 @@ package Atree is -- entity, it is of type Entity_Kind which is defined -- in package Einfo. - -- Flag19 229 additional flags + -- Flag19 235 additional flags -- ... - -- Flag247 + -- Flag254 -- Convention Entity convention (Convention_Id value) @@ -296,7 +293,7 @@ package Atree is ------------------------------------- -- A subpackage Atree.Unchecked_Access provides routines for reading and - -- writing the fields defined above (Field1-27, Node1-27, Flag1-247 etc). + -- writing the fields defined above (Field1-27, Node1-27, Flag3-254 etc). -- These unchecked access routines can be used for untyped traversals. -- In addition they are used in the implementations of the Sinfo and -- Einfo packages. These packages both provide logical synonyms for @@ -1199,6 +1196,9 @@ package Atree is function Ureal21 (N : Node_Id) return Ureal; pragma Inline (Ureal21); + function Flag3 (N : Node_Id) return Boolean; + pragma Inline (Flag3); + function Flag4 (N : Node_Id) return Boolean; pragma Inline (Flag4); @@ -2254,6 +2254,9 @@ package Atree is procedure Set_Ureal21 (N : Node_Id; Val : Ureal); pragma Inline (Set_Ureal21); + procedure Set_Flag3 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag3); + procedure Set_Flag4 (N : Node_Id; Val : Boolean); pragma Inline (Set_Flag4); @@ -3088,8 +3091,7 @@ package Atree is -- Flag used to indicate if node is a member of a list. -- This field is considered private to the Atree package. - Unused_1 : Boolean; - -- Currently unused flag + Flag3 : Boolean; Rewrite_Ins : Boolean; -- Flag set by Mark_Rewrite_Insertion procedure. @@ -3128,7 +3130,7 @@ package Atree is -- used in component 5 (where we still have lots of room!) -- In_List used as Flag19, Flag40, Flag129, Flag216 - -- Unused_1 used as Flag20, Flag41, Flag130, Flag217 + -- Flag3 used as Flag20, Flag41, Flag130, Flag217 -- Rewrite_Ins used as Flag21, Flag42, Flag131, Flag218 -- Analyzed used as Flag22, Flag43, Flag132, Flag219 -- Comes_From_Source used as Flag23, Flag44, Flag133, Flag220 @@ -3243,7 +3245,7 @@ package Atree is Pflag1 => False, Pflag2 => False, In_List => False, - Unused_1 => False, + Flag3 => False, Rewrite_Ins => False, Analyzed => False, Comes_From_Source => False, @@ -3288,7 +3290,7 @@ package Atree is Pflag1 => False, Pflag2 => False, In_List => False, - Unused_1 => False, + Flag3 => False, Rewrite_Ins => False, Analyzed => False, Comes_From_Source => False, diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index 6b59451617d..d7375e00146 100644 --- a/gcc/ada/atree.h +++ b/gcc/ada/atree.h @@ -36,16 +36,16 @@ struct NFK { - Boolean is_extension : 1; - Boolean pflag1 : 1; - Boolean pflag2 : 1; - Boolean in_list : 1; - Boolean rewrite_sub : 1; - Boolean rewrite_ins : 1; - Boolean analyzed : 1; - Boolean c_f_s : 1; - + Boolean is_extension : 1; + Boolean pflag1 : 1; + Boolean pflag2 : 1; + Boolean in_list : 1; + Boolean flag3 : 1; + Boolean rewrite_ins : 1; + Boolean analyzed : 1; + Boolean c_f_s : 1; Boolean error_posted : 1; + Boolean flag4 : 1; Boolean flag5 : 1; Boolean flag6 : 1; @@ -71,16 +71,16 @@ struct NFK struct NFNK { - Boolean is_extension : 1; - Boolean pflag1 : 1; - Boolean pflag2 : 1; - Boolean in_list : 1; - Boolean rewrite_sub : 1; - Boolean rewrite_ins : 1; - Boolean analyzed : 1; - Boolean c_f_s : 1; - + Boolean is_extension : 1; + Boolean pflag1 : 1; + Boolean pflag2 : 1; + Boolean in_list : 1; + Boolean flag3 : 1; + Boolean rewrite_ins : 1; + Boolean analyzed : 1; + Boolean c_f_s : 1; Boolean error_posted : 1; + Boolean flag4 : 1; Boolean flag5 : 1; Boolean flag6 : 1; @@ -469,6 +469,7 @@ extern Node_Id Current_Error_Node; #define Convention(N) \ (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.convention) +#define Flag3(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag3) #define Flag4(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag4) #define Flag5(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag5) #define Flag6(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag6) @@ -486,7 +487,7 @@ extern Node_Id Current_Error_Node; #define Flag18(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag18) #define Flag19(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.in_list) -#define Flag20(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.rewrite_sub) +#define Flag20(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag3) #define Flag21(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.rewrite_ins) #define Flag22(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.analyzed) #define Flag23(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.c_f_s) @@ -508,7 +509,7 @@ extern Node_Id Current_Error_Node; #define Flag39(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag18) #define Flag40(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.in_list) -#define Flag41(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.rewrite_sub) +#define Flag41(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.flag3) #define Flag42(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.rewrite_ins) #define Flag43(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.analyzed) #define Flag44(N) (Nodes_Ptr[(N) - First_Node_Id + 2].U.K.c_f_s) @@ -600,7 +601,7 @@ extern Node_Id Current_Error_Node; #define Flag128(N) (Nodes_Ptr[(N) - First_Node_Id + 3].V.EX.U.fw2.flag128) #define Flag129(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.in_list) -#define Flag130(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.rewrite_sub) +#define Flag130(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.flag3) #define Flag131(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.rewrite_ins) #define Flag132(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.analyzed) #define Flag133(N) (Nodes_Ptr[(N) - First_Node_Id + 3].U.K.c_f_s) @@ -690,7 +691,7 @@ extern Node_Id Current_Error_Node; #define Flag215(N) (Nodes_Ptr[(N) - First_Node_Id + 4].V.EX.U.fw4.flag215) #define Flag216(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.in_list) -#define Flag217(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.rewrite_sub) +#define Flag217(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.flag3) #define Flag218(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.rewrite_ins) #define Flag219(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.analyzed) #define Flag220(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.c_f_s) diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb index be4e79f2567..6808dbef27e 100644 --- a/gcc/ada/csinfo.adb +++ b/gcc/ada/csinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- 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- -- @@ -210,6 +210,7 @@ begin Set (Special, "Etype", True); Set (Special, "Evaluate_Once", True); Set (Special, "First_Itype", True); + Set (Special, "Has_Aspect_Specifications", True); Set (Special, "Has_Dynamic_Itype", True); Set (Special, "Has_Dynamic_Range_Check", True); Set (Special, "Has_Dynamic_Length_Check", True); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 1928c94bb4b..9612408d71b 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -241,9 +241,7 @@ package body Einfo is -- sense for them to be set true for certain subsets of entity kinds. See -- the spec of Einfo for further details. - -- Note: Flag1-Flag3 are absent from this list, since these flag positions - -- are used for the flags Analyzed, Comes_From_Source, and Error_Posted, - -- which are common to all nodes, including entity nodes. + -- Note: Flag1-Flag2 are absent from this list, for historical reasons -- Is_Frozen Flag4 -- Has_Discriminants Flag5 @@ -512,6 +510,7 @@ package body Einfo is -- Is_Underlying_Record_View Flag246 -- OK_To_Rename Flag247 + -- (unused) Flag3 -- (unused) Flag200 -- (unused) Flag232 diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 8a487162b07..e0d703ba822 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2774,6 +2774,7 @@ package body Exp_Util is N_Access_To_Object_Definition | N_Aggregate | N_Allocator | + N_Aspect_Specification | N_Case_Expression | N_Case_Statement_Alternative | N_Character_Literal | diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 5fb847ddc60..2078c68b66a 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -636,6 +636,7 @@ package body Sem is N_Access_Function_Definition | N_Access_Procedure_Definition | N_Access_To_Object_Definition | + N_Aspect_Specification | N_Case_Expression_Alternative | N_Case_Statement_Alternative | N_Compilation_Unit_Aux | diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d10237125be..efd8d8e73b0 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1338,13 +1338,17 @@ package body Sem_Prag is ("argument for pragma% must be library level entity", Arg1); end if; - -- AI05-0033 : pragma cannot appear within a generic body, because + -- AI05-0033: A pragma cannot appear within a generic body, because -- instance can be in a nested scope. The check that protected type -- is itself a library-level declaration is done elsewhere. + -- Note: we omit this check in Codepeer mode to properly handle code + -- prior to AI-0033 (pragmas don't matter to codepeer in any case). + if Inside_A_Generic then if Ekind (Scope (Current_Scope)) = E_Generic_Package - and then In_Package_Body (Scope (Current_Scope)) + and then In_Package_Body (Scope (Current_Scope)) + and then not CodePeer_Mode then Error_Pragma ("pragma% cannot be used inside a generic"); end if; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index cac6e7341b5..1cb7d190927 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -32,7 +32,10 @@ pragma Style_Checks (All_Checks); -- No subprogram ordering check, due to logical grouping -with Atree; use Atree; +with Atree; use Atree; +with Nlists; use Nlists; + +with System.HTable; package body Sinfo is @@ -53,6 +56,30 @@ package body Sinfo is NT : Nodes.Table_Ptr renames Nodes.Table; -- A short hand abbreviation, useful for the debugging checks + ------------------------------------------ + -- Hash Table for Aspect Specifications -- + ------------------------------------------ + + type Hash_Range is range 0 .. 510; + -- Size of hash table headers + + function AS_Hash (F : Node_Id) return Hash_Range; + -- Hash function for hash table + + function AS_Hash (F : Node_Id) return Hash_Range is + begin + return Hash_Range (F mod 511); + end AS_Hash; + + package Aspect_Specifications_Hash_Table is new + System.HTable.Simple_HTable + (Header_Num => Hash_Range, + Element => List_Id, + No_Element => No_List, + Key => Node_Id, + Hash => AS_Hash, + Equal => "="); + ---------------------------- -- Field Access Functions -- ---------------------------- @@ -392,6 +419,14 @@ package body Sinfo is return List1 (N); end Choices; + function Class_Present + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + return Flag6 (N); + end Class_Present; + function Coextensions (N : Node_Id) return Elist_Id is begin @@ -1171,6 +1206,7 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Allocator + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_Assignment_Statement or else NT (N).Nkind = N_At_Clause or else NT (N).Nkind = N_Attribute_Definition_Clause @@ -1215,6 +1251,14 @@ package body Sinfo is return List1 (N); end Expressions; + function First_Aspect + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + return Flag4 (N); + end First_Aspect; + function First_Bit (N : Node_Id) return Node_Id is begin @@ -1373,6 +1417,13 @@ package body Sinfo is return Node2 (N); end Handler_List_Entry; + function Has_Aspect_Specifications + (N : Node_Id) return Boolean is + begin + pragma Assert (Permits_Aspect_Specifications (N)); + return Flag3 (N); + end Has_Aspect_Specifications; + function Has_Created_Identifier (N : Node_Id) return Boolean is begin @@ -1387,7 +1438,6 @@ package body Sinfo is begin return Flag10 (N); end Has_Dynamic_Length_Check; - function Has_Dynamic_Range_Check (N : Node_Id) return Boolean is begin @@ -1521,6 +1571,7 @@ package body Sinfo is (N : Node_Id) return Node_Id is begin pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_At_Clause or else NT (N).Nkind = N_Block_Statement or else NT (N).Nkind = N_Designator @@ -1818,6 +1869,14 @@ package body Sinfo is return Node2 (N); end Label_Construct; + function Last_Aspect + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + return Flag5 (N); + end Last_Aspect; + function Last_Bit (N : Node_Id) return Node_Id is begin @@ -3307,6 +3366,14 @@ package body Sinfo is Set_List1_With_Parent (N, Val); end Set_Choices; + procedure Set_Class_Present + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + Set_Flag6 (N, Val); + end Set_Class_Present; + procedure Set_Coextensions (N : Node_Id; Val : Elist_Id) is begin @@ -4077,6 +4144,7 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Allocator + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_Assignment_Statement or else NT (N).Nkind = N_At_Clause or else NT (N).Nkind = N_Attribute_Definition_Clause @@ -4121,6 +4189,14 @@ package body Sinfo is Set_List1_With_Parent (N, Val); end Set_Expressions; + procedure Set_First_Aspect + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + Set_Flag4 (N, Val); + end Set_First_Aspect; + procedure Set_First_Bit (N : Node_Id; Val : Node_Id) is begin @@ -4279,6 +4355,13 @@ package body Sinfo is Set_Node2 (N, Val); end Set_Handler_List_Entry; + procedure Set_Has_Aspect_Specifications + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (Permits_Aspect_Specifications (N)); + Set_Flag3 (N, Val); + end Set_Has_Aspect_Specifications; + procedure Set_Has_Created_Identifier (N : Node_Id; Val : Boolean := True) is begin @@ -4427,6 +4510,7 @@ package body Sinfo is (N : Node_Id; Val : Node_Id) is begin pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification or else NT (N).Nkind = N_At_Clause or else NT (N).Nkind = N_Block_Statement or else NT (N).Nkind = N_Designator @@ -4732,6 +4816,14 @@ package body Sinfo is Set_Node4_With_Parent (N, Val); end Set_Last_Bit; + procedure Set_Last_Aspect + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + Set_Flag5 (N, Val); + end Set_Last_Aspect; + procedure Set_Last_Name (N : Node_Id; Val : Boolean := True) is begin @@ -6071,4 +6163,65 @@ package body Sinfo is return Chars (Pragma_Identifier (N)); end Pragma_Name; + ----------------------------------- + -- Permits_Aspect_Specifications -- + ----------------------------------- + + Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean := + (N_Abstract_Subprogram_Declaration => True, + N_Component_Declaration => True, + N_Entry_Declaration => True, + N_Exception_Declaration => True, + N_Formal_Abstract_Subprogram_Declaration => True, + N_Formal_Concrete_Subprogram_Declaration => True, + N_Formal_Object_Declaration => True, + N_Formal_Package_Declaration => True, + N_Formal_Type_Declaration => True, + N_Full_Type_Declaration => True, + N_Function_Instantiation => True, + N_Generic_Package_Declaration => True, + N_Generic_Subprogram_Declaration => True, + N_Object_Declaration => True, + N_Package_Declaration => True, + N_Package_Instantiation => True, + N_Private_Extension_Declaration => True, + N_Private_Type_Declaration => True, + N_Procedure_Instantiation => True, + N_Protected_Type_Declaration => True, + N_Single_Protected_Declaration => True, + N_Single_Task_Declaration => True, + N_Subprogram_Declaration => True, + N_Subtype_Declaration => True, + N_Task_Type_Declaration => True, + others => False); + + function Permits_Aspect_Specifications (N : Node_Id) return Boolean is + begin + return Has_Aspect_Specifications_Flag (Nkind (N)); + end Permits_Aspect_Specifications; + + --------------------------- + -- Aspect_Specifications -- + --------------------------- + + function Aspect_Specifications (N : Node_Id) return List_Id is + begin + return Aspect_Specifications_Hash_Table.Get (N); + end Aspect_Specifications; + + ------------------------------- + -- Set_Aspect_Specifications -- + ------------------------------- + + procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is + begin + pragma Assert (Permits_Aspect_Specifications (N)); + pragma Assert (not Has_Aspect_Specifications (N)); + pragma Assert (L /= No_List); + + Set_Has_Aspect_Specifications (N); + Set_Parent (L, N); + Aspect_Specifications_Hash_Table.Set (N, L); + end Set_Aspect_Specifications; + end Sinfo; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index df4abd268e9..7cf12ead93c 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -2102,6 +2102,9 @@ package Sinfo is -- Discriminant_Specifications (List4) (set to No_List if none) -- Type_Definition (Node3) -- Discr_Check_Funcs_Built (Flag11-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ---------------------------- -- 3.2.1 Type Definition -- @@ -2130,6 +2133,9 @@ package Sinfo is -- Subtype_Indication (Node5) -- Generic_Parent_Type (Node4-Sem) (set for an actual derived type). -- Exception_Junk (Flag8-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------------- -- 3.2.2 Subtype Indication -- @@ -2260,6 +2266,9 @@ package Sinfo is -- Exception_Junk (Flag8-Sem) -- Is_Subprogram_Descriptor (Flag16-Sem) -- Has_Init_Expression (Flag14) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------------------- -- 3.3.1 Defining Identifier List -- @@ -2832,6 +2841,9 @@ package Sinfo is -- Expression (Node3) (set to Empty if no default expression) -- More_Ids (Flag5) (set to False if no more identifiers in list) -- Prev_Ids (Flag6) (set to False if no previous identifiers in list) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------- -- 3.8.1 Variant Part -- @@ -4185,6 +4197,9 @@ package Sinfo is -- Body_To_Inline (Node3-Sem) -- Corresponding_Body (Node5-Sem) -- Parent_Spec (Node4-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------------------------ -- 6.1 Abstract Subprogram Declaration -- @@ -4196,6 +4211,9 @@ package Sinfo is -- N_Abstract_Subprogram_Declaration -- Sloc points to ABSTRACT -- Specification (Node1) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ----------------------------------- -- 6.1 Subprogram Specification -- @@ -4586,9 +4604,12 @@ package Sinfo is -- By_Ref (Flag5-Sem) -- Note: Return_Statement_Entity points to an E_Return_Statement. + -- Note that Return_Object_Declarations is a list containing the -- N_Object_Declaration -- see comment on this field above. + -- The declared object will have Is_Return_Object = True. + -- There is no such syntactic category as return_object_declaration -- in the RM. Return_Object_Declarations represents this portion of -- the syntax for EXTENDED_RETURN_STATEMENT: @@ -4616,6 +4637,9 @@ package Sinfo is -- Corresponding_Body (Node5-Sem) -- Parent_Spec (Node4-Sem) -- Activation_Chain_Entity (Node3-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature -------------------------------- -- 7.1 Package Specification -- @@ -4682,6 +4706,9 @@ package Sinfo is -- Abstract_Present (Flag4) -- Tagged_Present (Flag15) -- Limited_Present (Flag17) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ---------------------------------------- -- 7.4 Private Extension Declaration -- @@ -4707,6 +4734,9 @@ package Sinfo is -- Synchronized_Present (Flag7) -- Subtype_Indication (Node5) -- Interface_List (List2) (set to No_List if none) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature --------------------- -- 8.4 Use Clause -- @@ -4864,6 +4894,9 @@ package Sinfo is -- Interface_List (List2) (set to No_List if none) -- Task_Definition (Node3) (set to Empty if not present) -- Corresponding_Body (Node5-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ---------------------------------- -- 9.1 Single Task Declaration -- @@ -4878,6 +4911,9 @@ package Sinfo is -- Defining_Identifier (Node1) -- Interface_List (List2) (set to No_List if none) -- Task_Definition (Node3) (set to Empty if not present) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature -------------------------- -- 9.1 Task Definition -- @@ -4950,6 +4986,9 @@ package Sinfo is -- Interface_List (List2) (set to No_List if none) -- Protected_Definition (Node3) -- Corresponding_Body (Node5-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature --------------------------------------- -- 9.4 Single Protected Declaration -- @@ -4966,6 +5005,9 @@ package Sinfo is -- Defining_Identifier (Node1) -- Interface_List (List2) (set to No_List if none) -- Protected_Definition (Node3) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------------- -- 9.4 Protected Definition -- @@ -5048,8 +5090,10 @@ package Sinfo is -- Corresponding_Body (Node5-Sem) -- Must_Override (Flag14) set if overriding indicator present -- Must_Not_Override (Flag15) set if not_overriding indicator present + -- Has_Aspect_Specifications (Flag3) -- Note: overriding indicator is an Ada 2005 feature + -- Note: Aspect_Specification is an Ada 2012 feature ----------------------------- -- 9.5.2 Accept statement -- @@ -5713,6 +5757,9 @@ package Sinfo is -- Renaming_Exception (Node2-Sem) -- More_Ids (Flag5) (set to False if no more identifiers in list) -- Prev_Ids (Flag6) (set to False if no previous identifiers in list) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------------------------ -- 11.2 Handled Sequence Of Statements -- @@ -5861,6 +5908,9 @@ package Sinfo is -- Corresponding_Body (Node5-Sem) -- Generic_Formal_Declarations (List2) from generic formal part -- Parent_Spec (Node4-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature --------------------------------------- -- 12.1 Generic Package Declaration -- @@ -5882,6 +5932,9 @@ package Sinfo is -- Generic_Formal_Declarations (List2) from generic formal part -- Parent_Spec (Node4-Sem) -- Activation_Chain_Entity (Node3-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------------- -- 12.1 Generic Formal Part -- @@ -5923,6 +5976,7 @@ package Sinfo is -- Parent_Spec (Node4-Sem) -- Instance_Spec (Node5-Sem) -- ABE_Is_Certain (Flag18-Sem) + -- Has_Aspect_Specifications (Flag3) -- N_Procedure_Instantiation -- Sloc points to PROCEDURE @@ -5935,6 +5989,7 @@ package Sinfo is -- Must_Override (Flag14) set if overriding indicator present -- Must_Not_Override (Flag15) set if not_overriding indicator present -- ABE_Is_Certain (Flag18-Sem) + -- Has_Aspect_Specifications (Flag3) -- N_Function_Instantiation -- Sloc points to FUNCTION @@ -5947,8 +6002,10 @@ package Sinfo is -- Must_Override (Flag14) set if overriding indicator present -- Must_Not_Override (Flag15) set if not_overriding indicator present -- ABE_Is_Certain (Flag18-Sem) + -- Has_Aspect_Specifications (Flag3) -- Note: overriding indicator is an Ada 2005 feature + -- Note: Aspect_Specification is an Ada 2012 feature ------------------------------- -- 12.3 Generic Actual Part -- @@ -6019,6 +6076,9 @@ package Sinfo is -- Default_Expression (Node5) (set to Empty if no default expression) -- More_Ids (Flag5) (set to False if no more identifiers in list) -- Prev_Ids (Flag6) (set to False if no previous identifiers in list) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ----------------------------------- -- 12.5 Formal Type Declaration -- @@ -6035,6 +6095,9 @@ package Sinfo is -- Discriminant_Specifications (List4) (set to No_List if no -- discriminant part) -- Unknown_Discriminants_Present (Flag13) set if (<>) discriminant + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature ---------------------------------- -- 12.5 Formal type definition -- @@ -6180,10 +6243,13 @@ package Sinfo is -- Specification (Node1) -- Default_Name (Node2) (set to Empty if no subprogram default) -- Box_Present (Flag15) + -- Has_Aspect_Specifications (Flag3) -- Note: if no subprogram default is present, then Name is set -- to Empty, and Box_Present is False. + -- Note: Aspect_Specification is an Ada 2012 feature + -------------------------------------------------- -- 12.6 Formal Abstract Subprogram Declaration -- -------------------------------------------------- @@ -6196,10 +6262,13 @@ package Sinfo is -- Specification (Node1) -- Default_Name (Node2) (set to Empty if no subprogram default) -- Box_Present (Flag15) + -- Has_Aspect_Specifications (Flag3) -- Note: if no subprogram default is present, then Name is set -- to Empty, and Box_Present is False. + -- Note: Aspect_Specification is an Ada 2012 feature + ------------------------------ -- 12.6 Subprogram Default -- ------------------------------ @@ -6236,6 +6305,9 @@ package Sinfo is -- Box_Present (Flag15) -- Instance_Spec (Node5-Sem) -- ABE_Is_Certain (Flag18-Sem) + -- Has_Aspect_Specifications (Flag3) + + -- Note: Aspect_Specification is an Ada 2012 feature -------------------------------------- -- 12.7 Formal Package Actual Part -- @@ -6325,6 +6397,32 @@ package Sinfo is -- Check_Address_Alignment (Flag11-Sem) -- Address_Warning_Posted (Flag18-Sem) + ---------------------------------- + -- 13.3.1 Aspect Specification -- + ---------------------------------- + + -- ASPECT_SPECIFICATION ::= + -- with ASPECT_MARK [=> ASPECT_DEFINITION] {. + -- ASPECT_MARK [=> ASPECT_DEFINITION] } + + -- ASPECT_MARK ::= aspect_IDENTIFIER['Class] + + -- ASPECT_DEFINITION ::= NAME | EXPRESSION + + -- See separate section "Handling of Aspect Specifications" for details + -- on the incorporation of these nodes into the tree, and association + -- with the related declaration node. + + -- N_Aspect_Specification + -- Sloc points to aspect identifier + -- Identifier (Node1) aspect identifier + -- Expression (Node3) Aspect_Definition (set to Empty if none) + -- First_Aspect (Flag4) Set for first aspect for a declaration + -- Last_Aspect (Flag5) Set for last aspect for a declaration + -- Class_Present (Flag6) Set if 'Class present + + -- Note: Aspect_Specification is an Ada 2012 feature + --------------------------------------------- -- 13.4 Enumeration representation clause -- --------------------------------------------- @@ -7180,6 +7278,7 @@ package Sinfo is N_Enumeration_Representation_Clause, N_Mod_Clause, N_Record_Representation_Clause, + N_Aspect_Specification, -- N_Representation_Clause, N_Has_Chars @@ -7849,6 +7948,9 @@ package Sinfo is function Choices (N : Node_Id) return List_Id; -- List1 + function Class_Present + (N : Node_Id) return Boolean; -- Flag6 + function Coextensions (N : Node_Id) return Elist_Id; -- Elist4 @@ -8095,6 +8197,9 @@ package Sinfo is function Expressions (N : Node_Id) return List_Id; -- List1 + function First_Aspect + (N : Node_Id) return Boolean; -- Flag4 + function First_Bit (N : Node_Id) return Node_Id; -- Node3 @@ -8149,6 +8254,9 @@ package Sinfo is function Handler_List_Entry (N : Node_Id) return Node_Id; -- Node2 + function Has_Aspect_Specifications + (N : Node_Id) return Boolean; -- Flag3 + function Has_Created_Identifier (N : Node_Id) return Boolean; -- Flag15 @@ -8308,6 +8416,9 @@ package Sinfo is function Left_Opnd (N : Node_Id) return Node_Id; -- Node2 + function Last_Aspect + (N : Node_Id) return Boolean; -- Flag5 + function Last_Bit (N : Node_Id) return Node_Id; -- Node4 @@ -8731,6 +8842,9 @@ package Sinfo is procedure Set_Array_Aggregate (N : Node_Id; Val : Node_Id); -- Node3 + procedure Set_Has_Aspect_Specifications + (N : Node_Id; Val : Boolean := True); -- Flag3 + procedure Set_Assignment_OK (N : Node_Id; Val : Boolean := True); -- Flag15 @@ -8776,12 +8890,15 @@ package Sinfo is procedure Set_Choice_Parameter (N : Node_Id; Val : Node_Id); -- Node2 - procedure Set_Coextensions - (N : Node_Id; Val : Elist_Id); -- Elist4 - procedure Set_Choices (N : Node_Id; Val : List_Id); -- List1 + procedure Set_Class_Present + (N : Node_Id; Val : Boolean := True); -- Flag6 + + procedure Set_Coextensions + (N : Node_Id; Val : Elist_Id); -- Elist4 + procedure Set_Comes_From_Extended_Return_Statement (N : Node_Id; Val : Boolean := True); -- Flag18 @@ -9022,6 +9139,9 @@ package Sinfo is procedure Set_Expressions (N : Node_Id; Val : List_Id); -- List1 + procedure Set_First_Aspect + (N : Node_Id; Val : Boolean := True); -- Flag4 + procedure Set_First_Bit (N : Node_Id; Val : Node_Id); -- Node3 @@ -9229,6 +9349,9 @@ package Sinfo is procedure Set_Kill_Range_Check (N : Node_Id; Val : Boolean := True); -- Flag11 + procedure Set_Last_Aspect + (N : Node_Id; Val : Boolean := True); -- Flag5 + procedure Set_Last_Bit (N : Node_Id; Val : Node_Id); -- Node4 @@ -11001,6 +11124,13 @@ package Sinfo is 4 => False, -- unused 5 => False), -- Next_Rep_Item (Node5-Sem) + N_Aspect_Specification => + (1 => True, -- Identifier (Node1) + 2 => False, -- unused + 3 => True, -- Expression (Node3) + 4 => False, -- unused + 5 => False), -- unused + N_Enumeration_Representation_Clause => (1 => True, -- Identifier (Node1) 2 => False, -- unused @@ -11232,8 +11362,6 @@ package Sinfo is 4 => False, -- unused 5 => False), -- unused - -- End of inserted output from makeisf program - -- Entries for SCIL nodes N_SCIL_Dispatch_Table_Tag_Init => @@ -11289,6 +11417,45 @@ package Sinfo is 4 => False, -- unused 5 => False)); -- unused + --------------------------------------- + -- Handling of Aspect Specifications -- + --------------------------------------- + + -- Several kinds of declaration node permit aspect specifications in Ada + -- 2012 mode. If there was room in all these declaration nodes, we could + -- just have a field Aspect_Specifications pointing to a list of nodes + -- for the aspects (N_Aspect_Specification nodes). But there isn't room, + -- so we adopt a different approach. + + -- The following subprograms provide access to a specialized interface + -- implemented internally with a hash table in the body, that provides + -- access to aspect specifications. + + function Permits_Aspect_Specifications (N : Node_Id) return Boolean; + -- Returns True if the node N is a declaration node that permits aspect + -- specifications. All such nodes have the Has_Aspect_Specifications + -- flag defined. Returns False for all other nodes. + + function Aspect_Specifications (N : Node_Id) return List_Id; + -- Given a node N, returns the list of N_Aspect_Specification nodes that + -- are attached to this declaration node. If the node is in the class of + -- declaration nodes that permit aspect specifications, as defined by the + -- predicate above, and if their Has_Aspect_Specifications flag is set to + -- True, then this will always be a non-empty list. If this flag is set to + -- False, or the node is not in the declaration class permitting aspect + -- specifications, then No_List is returned. + + procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id); + -- The node N must be in the class of declaration nodes that permit aspect + -- specifications and the Has_Aspect_Specifications flag must be False on + -- entry. L must be a non-empty list of N_Aspect_Specification nodes. This + -- procedure sets the Has_Aspect_Specifications flag to True, and makes an + -- entry that can be retrieved by a subsequent Aspect_Specifications call. + -- The parent of list L is set to reference the declaration node N. It is + -- an error to call this procedure with a node that does not permit aspect + -- specifications, or a node that has its Has_Aspect_Specifications flag + -- set True on entry, or with L being an empty list or No_List. + -------------------- -- Inline Pragmas -- -------------------- @@ -11330,6 +11497,7 @@ package Sinfo is pragma Inline (Check_Address_Alignment); pragma Inline (Choice_Parameter); pragma Inline (Choices); + pragma Inline (Class_Present); pragma Inline (Coextensions); pragma Inline (Comes_From_Extended_Return_Statement); pragma Inline (Compile_Time_Known_Aggregate); @@ -11412,6 +11580,7 @@ package Sinfo is pragma Inline (Explicit_Generic_Actual_Parameter); pragma Inline (Expression); pragma Inline (Expressions); + pragma Inline (First_Aspect); pragma Inline (First_Bit); pragma Inline (First_Inlined_Subprogram); pragma Inline (First_Name); @@ -11430,6 +11599,7 @@ package Sinfo is pragma Inline (Generic_Parent_Type); pragma Inline (Handled_Statement_Sequence); pragma Inline (Handler_List_Entry); + pragma Inline (Has_Aspect_Specifications); pragma Inline (Has_Created_Identifier); pragma Inline (Has_Dynamic_Length_Check); pragma Inline (Has_Dynamic_Range_Check); @@ -11481,6 +11651,7 @@ package Sinfo is pragma Inline (Iteration_Scheme); pragma Inline (Itype); pragma Inline (Kill_Range_Check); + pragma Inline (Last_Aspect); pragma Inline (Last_Bit); pragma Inline (Last_Name); pragma Inline (Library_Unit); @@ -11637,6 +11808,7 @@ package Sinfo is pragma Inline (Set_Check_Address_Alignment); pragma Inline (Set_Choice_Parameter); pragma Inline (Set_Choices); + pragma Inline (Set_Class_Present); pragma Inline (Set_Coextensions); pragma Inline (Set_Comes_From_Extended_Return_Statement); pragma Inline (Set_Compile_Time_Known_Aggregate); @@ -11718,6 +11890,7 @@ package Sinfo is pragma Inline (Set_Explicit_Generic_Actual_Parameter); pragma Inline (Set_Expression); pragma Inline (Set_Expressions); + pragma Inline (Set_First_Aspect); pragma Inline (Set_First_Bit); pragma Inline (Set_First_Inlined_Subprogram); pragma Inline (Set_First_Name); @@ -11736,6 +11909,7 @@ package Sinfo is pragma Inline (Set_Generic_Parent_Type); pragma Inline (Set_Handled_Statement_Sequence); pragma Inline (Set_Handler_List_Entry); + pragma Inline (Set_Has_Aspect_Specifications); pragma Inline (Set_Has_Created_Identifier); pragma Inline (Set_Has_Dynamic_Length_Check); pragma Inline (Set_Has_Init_Expression); @@ -11787,6 +11961,7 @@ package Sinfo is pragma Inline (Set_Iteration_Scheme); pragma Inline (Set_Itype); pragma Inline (Set_Kill_Range_Check); + pragma Inline (Set_Last_Aspect); pragma Inline (Set_Last_Bit); pragma Inline (Set_Last_Name); pragma Inline (Set_Library_Unit); diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index b2fe94150f5..816750c6c19 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -999,12 +999,8 @@ package body Sprint is Write_Str_Sloc (" and then "); Sprint_Right_Opnd (Node); - when N_At_Clause => - Write_Indent_Str_Sloc ("for "); - Write_Id (Identifier (Node)); - Write_Str_With_Col_Check (" use at "); - Sprint_Node (Expression (Node)); - Write_Char (';'); + when N_Aspect_Specification => + raise Program_Error; when N_Assignment_Statement => Write_Indent; @@ -1026,6 +1022,13 @@ package body Sprint is Sprint_Node (Abortable_Part (Node)); Write_Indent_Str ("end select;"); + when N_At_Clause => + Write_Indent_Str_Sloc ("for "); + Write_Id (Identifier (Node)); + Write_Str_With_Col_Check (" use at "); + Sprint_Node (Expression (Node)); + Write_Char (';'); + when N_Attribute_Definition_Clause => Write_Indent_Str_Sloc ("for "); Sprint_Node (Name (Node)); diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 087170f69fe..2b49cb38748 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -1099,6 +1099,7 @@ package body Treepr is when F_Field5 => Field_To_Be_Printed := Field5 (N) /= Union_Id (Empty); + when F_Flag3 => Field_To_Be_Printed := Flag3 (N); when F_Flag4 => Field_To_Be_Printed := Flag4 (N); when F_Flag5 => Field_To_Be_Printed := Flag5 (N); when F_Flag6 => Field_To_Be_Printed := Flag6 (N); @@ -1115,12 +1116,10 @@ package body Treepr is when F_Flag17 => Field_To_Be_Printed := Flag17 (N); when F_Flag18 => Field_To_Be_Printed := Flag18 (N); - -- Flag1,2,3 are no longer used + -- Flag1,2 are no longer used when F_Flag1 => raise Program_Error; when F_Flag2 => raise Program_Error; - when F_Flag3 => raise Program_Error; - end case; -- Print field if it is to be printed