Skip to content

R
riscv-gcc-1
Commit 313d6f2c by Arnaud Charlet
Options

[multiple changes] 

2010-10-11  Arnaud Charlet  <charlet@adacore.com>

        * sem_prag.adb (Check_Interrupt_Or_Attach_Handler): Do not emit error
        for AI05-0033 in CodePeer mode.

2010-10-11  Robert Dewar  <dewar@adacore.com>

        * atree.h, atree.ads, atree.adb (Flag3): New flag (replaces Unused_1)
        * csinfo.adb: Aspect_Specifications is a new special field
        * einfo.adb (Flag3): New unused flag
        * exp_util.adb (Insert_Actions): Add processing for
        N_Aspect_Specification.
        * sem.adb: Add entry for N_Aspect_Specification.
        * sinfo.ads, sinfo.adb (N_Aspect_Specification): New node
        (Has_Aspect_Specifications): New flag
        (Permits_Aspect_Specifications): New function
        (Aspect_Specifications): New function
        (Set_Aspect_Specifications): New procedure
        * sprint.adb (Sprint_Node): Put N_At_Clause in proper alpha order
        (Sprint_Node): Add dummy entry for N_Aspect_Specification
        * treepr.adb (Flag3): New flag to be listed

2010-10-11  Vincent Celier  <celier@adacore.com>

        * adaint.c: Minor reformatting.

From-SVN: r165279
parent 7b53cb49
Showing with 247 additions and 71 deletions
gcc/ada/adaint.c
...@@ -2372,17 +2372,17 @@ __gnat_number_of_cpus (void) ...@@ -2372,17 +2372,17 @@ __gnat_number_of_cpus (void)
{ {
int cores = 1; int cores = 1;
#if defined (linux) || defined (sun) || defined (AIX) || \ #if defined (linux) || defined (sun) || defined (AIX) \
(defined (__alpha__) && defined (_osf_)) || defined (__APPLE__) || (defined (__alpha__) && defined (_osf_)) || defined (__APPLE__)
cores = (int)sysconf(_SC_NPROCESSORS_ONLN); cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
#elif (defined (__mips) && defined (__sgi)) #elif (defined (__mips) && defined (__sgi))
cores = (int)sysconf(_SC_NPROC_ONLN); cores = (int) sysconf (_SC_NPROC_ONLN);
#elif defined (__hpux__) #elif defined (__hpux__)
struct pst_dynamic psd; struct pst_dynamic psd;
if (pstat_getdynamic(&psd, sizeof(psd), 1, 0) != -1) if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
cores = (int)psd.psd_proc_cnt; cores = (int) psd.psd_proc_cnt;
#endif #endif
......
gcc/ada/atree.adb
...@@ -2704,6 +2704,12 @@ package body Atree is ...@@ -2704,6 +2704,12 @@ package body Atree is
return From_Union (Nodes.Table (N + 3).Field8); return From_Union (Nodes.Table (N + 3).Field8);
end Ureal21; 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 function Flag4 (N : Node_Id) return Boolean is
begin begin
pragma Assert (N <= Nodes.Last); pragma Assert (N <= Nodes.Last);
...@@ -2803,7 +2809,7 @@ package body Atree is ...@@ -2803,7 +2809,7 @@ package body Atree is
function Flag20 (N : Node_Id) return Boolean is function Flag20 (N : Node_Id) return Boolean is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
return Nodes.Table (N + 1).Unused_1; return Nodes.Table (N + 1).Flag3;
end Flag20; end Flag20;
function Flag21 (N : Node_Id) return Boolean is function Flag21 (N : Node_Id) return Boolean is
...@@ -2929,7 +2935,7 @@ package body Atree is ...@@ -2929,7 +2935,7 @@ package body Atree is
function Flag41 (N : Node_Id) return Boolean is function Flag41 (N : Node_Id) return Boolean is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
return Nodes.Table (N + 2).Unused_1; return Nodes.Table (N + 2).Flag3;
end Flag41; end Flag41;
function Flag42 (N : Node_Id) return Boolean is function Flag42 (N : Node_Id) return Boolean is
...@@ -3463,7 +3469,7 @@ package body Atree is ...@@ -3463,7 +3469,7 @@ package body Atree is
function Flag130 (N : Node_Id) return Boolean is function Flag130 (N : Node_Id) return Boolean is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
return Nodes.Table (N + 3).Unused_1; return Nodes.Table (N + 3).Flag3;
end Flag130; end Flag130;
function Flag131 (N : Node_Id) return Boolean is function Flag131 (N : Node_Id) return Boolean is
...@@ -3985,7 +3991,7 @@ package body Atree is ...@@ -3985,7 +3991,7 @@ package body Atree is
function Flag217 (N : Node_Id) return Boolean is function Flag217 (N : Node_Id) return Boolean is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
return Nodes.Table (N + 4).Unused_1; return Nodes.Table (N + 4).Flag3;
end Flag217; end Flag217;
function Flag218 (N : Node_Id) return Boolean is function Flag218 (N : Node_Id) return Boolean is
...@@ -4806,6 +4812,12 @@ package body Atree is ...@@ -4806,6 +4812,12 @@ package body Atree is
Nodes.Table (N + 3).Field8 := To_Union (Val); Nodes.Table (N + 3).Field8 := To_Union (Val);
end Set_Ureal21; 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 procedure Set_Flag4 (N : Node_Id; Val : Boolean) is
begin begin
pragma Assert (N <= Nodes.Last); pragma Assert (N <= Nodes.Last);
...@@ -4905,7 +4917,7 @@ package body Atree is ...@@ -4905,7 +4917,7 @@ package body Atree is
procedure Set_Flag20 (N : Node_Id; Val : Boolean) is procedure Set_Flag20 (N : Node_Id; Val : Boolean) is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 1).Unused_1 := Val; Nodes.Table (N + 1).Flag3 := Val;
end Set_Flag20; end Set_Flag20;
procedure Set_Flag21 (N : Node_Id; Val : Boolean) is procedure Set_Flag21 (N : Node_Id; Val : Boolean) is
...@@ -5031,7 +5043,7 @@ package body Atree is ...@@ -5031,7 +5043,7 @@ package body Atree is
procedure Set_Flag41 (N : Node_Id; Val : Boolean) is procedure Set_Flag41 (N : Node_Id; Val : Boolean) is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 2).Unused_1 := Val; Nodes.Table (N + 2).Flag3 := Val;
end Set_Flag41; end Set_Flag41;
procedure Set_Flag42 (N : Node_Id; Val : Boolean) is procedure Set_Flag42 (N : Node_Id; Val : Boolean) is
...@@ -5693,7 +5705,7 @@ package body Atree is ...@@ -5693,7 +5705,7 @@ package body Atree is
procedure Set_Flag130 (N : Node_Id; Val : Boolean) is procedure Set_Flag130 (N : Node_Id; Val : Boolean) is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 3).Unused_1 := Val; Nodes.Table (N + 3).Flag3 := Val;
end Set_Flag130; end Set_Flag130;
procedure Set_Flag131 (N : Node_Id; Val : Boolean) is procedure Set_Flag131 (N : Node_Id; Val : Boolean) is
...@@ -6343,7 +6355,7 @@ package body Atree is ...@@ -6343,7 +6355,7 @@ package body Atree is
procedure Set_Flag217 (N : Node_Id; Val : Boolean) is procedure Set_Flag217 (N : Node_Id; Val : Boolean) is
begin begin
pragma Assert (Nkind (N) in N_Entity); pragma Assert (Nkind (N) in N_Entity);
Nodes.Table (N + 4).Unused_1 := Val; Nodes.Table (N + 4).Flag3 := Val;
end Set_Flag217; end Set_Flag217;
procedure Set_Flag218 (N : Node_Id; Val : Boolean) is procedure Set_Flag218 (N : Node_Id; Val : Boolean) is
......
gcc/ada/atree.ads
...@@ -85,10 +85,6 @@ package Atree is ...@@ -85,10 +85,6 @@ package Atree is
-- In_List A flag used to indicate if the node is a member -- In_List A flag used to indicate if the node is a member
-- of a node list. -- 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 -- 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. -- node as a result of a call to Mark_Rewrite_Insertion.
...@@ -155,17 +151,18 @@ package Atree is ...@@ -155,17 +151,18 @@ package Atree is
-- it is useful to be able to do untyped traversals, and an internal -- it is useful to be able to do untyped traversals, and an internal
-- package in Atree allows for direct untyped accesses in such cases. -- 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 -- Flag5 Ekind, as described for FieldN). Again the access
-- Flag6 is usually via subprograms in Sinfo and Einfo which -- Flag6 is usually via subprograms in Sinfo and Einfo which
-- Flag7 provide high-level synonyms for these flags, and -- Flag7 provide high-level synonyms for these flags, and
-- Flag8 contain debugging code that checks that the values -- Flag8 contain debugging code that checks that the values
-- Flag9 in Nkind and Ekind are appropriate for the access. -- Flag9 in Nkind and Ekind are appropriate for the access.
-- Flag10 -- Flag10
-- Flag11 Note that Flag1-3 are missing from this list. The -- Flag11 Note that Flag1-2 are missing from this list. For
-- Flag12 first three flag positions are reserved for the -- Flag12 historical reasons, these flag names are unused.
-- Flag13 standard flags (Comes_From_Source, Error_Posted, -- Flag13
-- Flag14 and Analyzed) -- Flag14
-- Flag15 -- Flag15
-- Flag16 -- Flag16
-- Flag17 -- Flag17
...@@ -184,9 +181,9 @@ package Atree is ...@@ -184,9 +181,9 @@ package Atree is
-- entity, it is of type Entity_Kind which is defined -- entity, it is of type Entity_Kind which is defined
-- in package Einfo. -- in package Einfo.
-- Flag19 229 additional flags -- Flag19 235 additional flags
-- ... -- ...
-- Flag247 -- Flag254
-- Convention Entity convention (Convention_Id value) -- Convention Entity convention (Convention_Id value)
...@@ -296,7 +293,7 @@ package Atree is ...@@ -296,7 +293,7 @@ package Atree is
------------------------------------- -------------------------------------
-- A subpackage Atree.Unchecked_Access provides routines for reading and -- 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. -- These unchecked access routines can be used for untyped traversals.
-- In addition they are used in the implementations of the Sinfo and -- In addition they are used in the implementations of the Sinfo and
-- Einfo packages. These packages both provide logical synonyms for -- Einfo packages. These packages both provide logical synonyms for
...@@ -1199,6 +1196,9 @@ package Atree is ...@@ -1199,6 +1196,9 @@ package Atree is
function Ureal21 (N : Node_Id) return Ureal; function Ureal21 (N : Node_Id) return Ureal;
pragma Inline (Ureal21); pragma Inline (Ureal21);
function Flag3 (N : Node_Id) return Boolean;
pragma Inline (Flag3);
function Flag4 (N : Node_Id) return Boolean; function Flag4 (N : Node_Id) return Boolean;
pragma Inline (Flag4); pragma Inline (Flag4);
...@@ -2254,6 +2254,9 @@ package Atree is ...@@ -2254,6 +2254,9 @@ package Atree is
procedure Set_Ureal21 (N : Node_Id; Val : Ureal); procedure Set_Ureal21 (N : Node_Id; Val : Ureal);
pragma Inline (Set_Ureal21); pragma Inline (Set_Ureal21);
procedure Set_Flag3 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag3);
procedure Set_Flag4 (N : Node_Id; Val : Boolean); procedure Set_Flag4 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag4); pragma Inline (Set_Flag4);
...@@ -3088,8 +3091,7 @@ package Atree is ...@@ -3088,8 +3091,7 @@ package Atree is
-- Flag used to indicate if node is a member of a list. -- Flag used to indicate if node is a member of a list.
-- This field is considered private to the Atree package. -- This field is considered private to the Atree package.
Unused_1 : Boolean; Flag3 : Boolean;
-- Currently unused flag
Rewrite_Ins : Boolean; Rewrite_Ins : Boolean;
-- Flag set by Mark_Rewrite_Insertion procedure. -- Flag set by Mark_Rewrite_Insertion procedure.
...@@ -3128,7 +3130,7 @@ package Atree is ...@@ -3128,7 +3130,7 @@ package Atree is
-- used in component 5 (where we still have lots of room!) -- used in component 5 (where we still have lots of room!)
-- In_List used as Flag19, Flag40, Flag129, Flag216 -- 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 -- Rewrite_Ins used as Flag21, Flag42, Flag131, Flag218
-- Analyzed used as Flag22, Flag43, Flag132, Flag219 -- Analyzed used as Flag22, Flag43, Flag132, Flag219
-- Comes_From_Source used as Flag23, Flag44, Flag133, Flag220 -- Comes_From_Source used as Flag23, Flag44, Flag133, Flag220
...@@ -3243,7 +3245,7 @@ package Atree is ...@@ -3243,7 +3245,7 @@ package Atree is
Pflag1 => False, Pflag1 => False,
Pflag2 => False, Pflag2 => False,
In_List => False, In_List => False,
Unused_1 => False, Flag3 => False,
Rewrite_Ins => False, Rewrite_Ins => False,
Analyzed => False, Analyzed => False,
Comes_From_Source => False, Comes_From_Source => False,
...@@ -3288,7 +3290,7 @@ package Atree is ...@@ -3288,7 +3290,7 @@ package Atree is
Pflag1 => False, Pflag1 => False,
Pflag2 => False, Pflag2 => False,
In_List => False, In_List => False,
Unused_1 => False, Flag3 => False,
Rewrite_Ins => False, Rewrite_Ins => False,
Analyzed => False, Analyzed => False,
Comes_From_Source => False, Comes_From_Source => False,
......
gcc/ada/atree.h
...@@ -36,16 +36,16 @@ ...@@ -36,16 +36,16 @@
struct NFK struct NFK
{ {
Boolean is_extension : 1; Boolean is_extension : 1;
Boolean pflag1 : 1; Boolean pflag1 : 1;
Boolean pflag2 : 1; Boolean pflag2 : 1;
Boolean in_list : 1; Boolean in_list : 1;
Boolean rewrite_sub : 1; Boolean flag3 : 1;
Boolean rewrite_ins : 1; Boolean rewrite_ins : 1;
Boolean analyzed : 1; Boolean analyzed : 1;
Boolean c_f_s : 1; Boolean c_f_s : 1;
Boolean error_posted : 1; Boolean error_posted : 1;
Boolean flag4 : 1; Boolean flag4 : 1;
Boolean flag5 : 1; Boolean flag5 : 1;
Boolean flag6 : 1; Boolean flag6 : 1;
...@@ -71,16 +71,16 @@ struct NFK ...@@ -71,16 +71,16 @@ struct NFK
struct NFNK struct NFNK
{ {
Boolean is_extension : 1; Boolean is_extension : 1;
Boolean pflag1 : 1; Boolean pflag1 : 1;
Boolean pflag2 : 1; Boolean pflag2 : 1;
Boolean in_list : 1; Boolean in_list : 1;
Boolean rewrite_sub : 1; Boolean flag3 : 1;
Boolean rewrite_ins : 1; Boolean rewrite_ins : 1;
Boolean analyzed : 1; Boolean analyzed : 1;
Boolean c_f_s : 1; Boolean c_f_s : 1;
Boolean error_posted : 1; Boolean error_posted : 1;
Boolean flag4 : 1; Boolean flag4 : 1;
Boolean flag5 : 1; Boolean flag5 : 1;
Boolean flag6 : 1; Boolean flag6 : 1;
...@@ -469,6 +469,7 @@ extern Node_Id Current_Error_Node; ...@@ -469,6 +469,7 @@ extern Node_Id Current_Error_Node;
#define Convention(N) \ #define Convention(N) \
(Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.convention) (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 Flag4(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag4)
#define Flag5(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag5) #define Flag5(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag5)
#define Flag6(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag6) #define Flag6(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag6)
...@@ -486,7 +487,7 @@ extern Node_Id Current_Error_Node; ...@@ -486,7 +487,7 @@ extern Node_Id Current_Error_Node;
#define Flag18(N) (Nodes_Ptr[(N) - First_Node_Id].U.K.flag18) #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 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 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 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) #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; ...@@ -508,7 +509,7 @@ extern Node_Id Current_Error_Node;
#define Flag39(N) (Nodes_Ptr[(N) - First_Node_Id + 1].U.K.flag18) #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 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 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 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) #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; ...@@ -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 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 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 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 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) #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; ...@@ -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 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 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 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 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) #define Flag220(N) (Nodes_Ptr[(N) - First_Node_Id + 4].U.K.c_f_s)
......
gcc/ada/csinfo.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -210,6 +210,7 @@ begin ...@@ -210,6 +210,7 @@ begin
Set (Special, "Etype", True); Set (Special, "Etype", True);
Set (Special, "Evaluate_Once", True); Set (Special, "Evaluate_Once", True);
Set (Special, "First_Itype", True); Set (Special, "First_Itype", True);
Set (Special, "Has_Aspect_Specifications", True);
Set (Special, "Has_Dynamic_Itype", True); Set (Special, "Has_Dynamic_Itype", True);
Set (Special, "Has_Dynamic_Range_Check", True); Set (Special, "Has_Dynamic_Range_Check", True);
Set (Special, "Has_Dynamic_Length_Check", True); Set (Special, "Has_Dynamic_Length_Check", True);
......
gcc/ada/einfo.adb
...@@ -241,9 +241,7 @@ package body Einfo is ...@@ -241,9 +241,7 @@ package body Einfo is
-- sense for them to be set true for certain subsets of entity kinds. See -- sense for them to be set true for certain subsets of entity kinds. See
-- the spec of Einfo for further details. -- the spec of Einfo for further details.
-- Note: Flag1-Flag3 are absent from this list, since these flag positions -- Note: Flag1-Flag2 are absent from this list, for historical reasons
-- are used for the flags Analyzed, Comes_From_Source, and Error_Posted,
-- which are common to all nodes, including entity nodes.
-- Is_Frozen Flag4 -- Is_Frozen Flag4
-- Has_Discriminants Flag5 -- Has_Discriminants Flag5
...@@ -512,6 +510,7 @@ package body Einfo is ...@@ -512,6 +510,7 @@ package body Einfo is
-- Is_Underlying_Record_View Flag246 -- Is_Underlying_Record_View Flag246
-- OK_To_Rename Flag247 -- OK_To_Rename Flag247
-- (unused) Flag3
-- (unused) Flag200 -- (unused) Flag200
-- (unused) Flag232 -- (unused) Flag232
......
gcc/ada/exp_util.adb
...@@ -2774,6 +2774,7 @@ package body Exp_Util is ...@@ -2774,6 +2774,7 @@ package body Exp_Util is
N_Access_To_Object_Definition | N_Access_To_Object_Definition |
N_Aggregate | N_Aggregate |
N_Allocator | N_Allocator |
N_Aspect_Specification |
N_Case_Expression | N_Case_Expression |
N_Case_Statement_Alternative | N_Case_Statement_Alternative |
N_Character_Literal | N_Character_Literal |
......
gcc/ada/sem.adb
...@@ -636,6 +636,7 @@ package body Sem is ...@@ -636,6 +636,7 @@ package body Sem is
N_Access_Function_Definition | N_Access_Function_Definition |
N_Access_Procedure_Definition | N_Access_Procedure_Definition |
N_Access_To_Object_Definition | N_Access_To_Object_Definition |
N_Aspect_Specification |
N_Case_Expression_Alternative | N_Case_Expression_Alternative |
N_Case_Statement_Alternative | N_Case_Statement_Alternative |
N_Compilation_Unit_Aux | N_Compilation_Unit_Aux |
......
gcc/ada/sem_prag.adb
...@@ -1338,13 +1338,17 @@ package body Sem_Prag is ...@@ -1338,13 +1338,17 @@ package body Sem_Prag is
("argument for pragma% must be library level entity", Arg1); ("argument for pragma% must be library level entity", Arg1);
end if; 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 -- instance can be in a nested scope. The check that protected type
-- is itself a library-level declaration is done elsewhere. -- 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 Inside_A_Generic then
if Ekind (Scope (Current_Scope)) = E_Generic_Package 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 then
Error_Pragma ("pragma% cannot be used inside a generic"); Error_Pragma ("pragma% cannot be used inside a generic");
end if; end if;
......
gcc/ada/sinfo.adb
...@@ -32,7 +32,10 @@ ...@@ -32,7 +32,10 @@
pragma Style_Checks (All_Checks); pragma Style_Checks (All_Checks);
-- No subprogram ordering check, due to logical grouping -- 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 package body Sinfo is
...@@ -53,6 +56,30 @@ package body Sinfo is ...@@ -53,6 +56,30 @@ package body Sinfo is
NT : Nodes.Table_Ptr renames Nodes.Table; NT : Nodes.Table_Ptr renames Nodes.Table;
-- A short hand abbreviation, useful for the debugging checks -- 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 -- -- Field Access Functions --
---------------------------- ----------------------------
...@@ -392,6 +419,14 @@ package body Sinfo is ...@@ -392,6 +419,14 @@ package body Sinfo is
return List1 (N); return List1 (N);
end Choices; 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 function Coextensions
(N : Node_Id) return Elist_Id is (N : Node_Id) return Elist_Id is
begin begin
...@@ -1171,6 +1206,7 @@ package body Sinfo is ...@@ -1171,6 +1206,7 @@ package body Sinfo is
begin begin
pragma Assert (False pragma Assert (False
or else NT (N).Nkind = N_Allocator 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_Assignment_Statement
or else NT (N).Nkind = N_At_Clause or else NT (N).Nkind = N_At_Clause
or else NT (N).Nkind = N_Attribute_Definition_Clause or else NT (N).Nkind = N_Attribute_Definition_Clause
...@@ -1215,6 +1251,14 @@ package body Sinfo is ...@@ -1215,6 +1251,14 @@ package body Sinfo is
return List1 (N); return List1 (N);
end Expressions; 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 function First_Bit
(N : Node_Id) return Node_Id is (N : Node_Id) return Node_Id is
begin begin
...@@ -1373,6 +1417,13 @@ package body Sinfo is ...@@ -1373,6 +1417,13 @@ package body Sinfo is
return Node2 (N); return Node2 (N);
end Handler_List_Entry; 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 function Has_Created_Identifier
(N : Node_Id) return Boolean is (N : Node_Id) return Boolean is
begin begin
...@@ -1387,7 +1438,6 @@ package body Sinfo is ...@@ -1387,7 +1438,6 @@ package body Sinfo is
begin begin
return Flag10 (N); return Flag10 (N);
end Has_Dynamic_Length_Check; end Has_Dynamic_Length_Check;
function Has_Dynamic_Range_Check function Has_Dynamic_Range_Check
(N : Node_Id) return Boolean is (N : Node_Id) return Boolean is
begin begin
...@@ -1521,6 +1571,7 @@ package body Sinfo is ...@@ -1521,6 +1571,7 @@ package body Sinfo is
(N : Node_Id) return Node_Id is (N : Node_Id) return Node_Id is
begin begin
pragma Assert (False 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_At_Clause
or else NT (N).Nkind = N_Block_Statement or else NT (N).Nkind = N_Block_Statement
or else NT (N).Nkind = N_Designator or else NT (N).Nkind = N_Designator
...@@ -1818,6 +1869,14 @@ package body Sinfo is ...@@ -1818,6 +1869,14 @@ package body Sinfo is
return Node2 (N); return Node2 (N);
end Label_Construct; 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 function Last_Bit
(N : Node_Id) return Node_Id is (N : Node_Id) return Node_Id is
begin begin
...@@ -3307,6 +3366,14 @@ package body Sinfo is ...@@ -3307,6 +3366,14 @@ package body Sinfo is
Set_List1_With_Parent (N, Val); Set_List1_With_Parent (N, Val);
end Set_Choices; 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 procedure Set_Coextensions
(N : Node_Id; Val : Elist_Id) is (N : Node_Id; Val : Elist_Id) is
begin begin
...@@ -4077,6 +4144,7 @@ package body Sinfo is ...@@ -4077,6 +4144,7 @@ package body Sinfo is
begin begin
pragma Assert (False pragma Assert (False
or else NT (N).Nkind = N_Allocator 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_Assignment_Statement
or else NT (N).Nkind = N_At_Clause or else NT (N).Nkind = N_At_Clause
or else NT (N).Nkind = N_Attribute_Definition_Clause or else NT (N).Nkind = N_Attribute_Definition_Clause
...@@ -4121,6 +4189,14 @@ package body Sinfo is ...@@ -4121,6 +4189,14 @@ package body Sinfo is
Set_List1_With_Parent (N, Val); Set_List1_With_Parent (N, Val);
end Set_Expressions; 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 procedure Set_First_Bit
(N : Node_Id; Val : Node_Id) is (N : Node_Id; Val : Node_Id) is
begin begin
...@@ -4279,6 +4355,13 @@ package body Sinfo is ...@@ -4279,6 +4355,13 @@ package body Sinfo is
Set_Node2 (N, Val); Set_Node2 (N, Val);
end Set_Handler_List_Entry; 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 procedure Set_Has_Created_Identifier
(N : Node_Id; Val : Boolean := True) is (N : Node_Id; Val : Boolean := True) is
begin begin
...@@ -4427,6 +4510,7 @@ package body Sinfo is ...@@ -4427,6 +4510,7 @@ package body Sinfo is
(N : Node_Id; Val : Node_Id) is (N : Node_Id; Val : Node_Id) is
begin begin
pragma Assert (False 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_At_Clause
or else NT (N).Nkind = N_Block_Statement or else NT (N).Nkind = N_Block_Statement
or else NT (N).Nkind = N_Designator or else NT (N).Nkind = N_Designator
...@@ -4732,6 +4816,14 @@ package body Sinfo is ...@@ -4732,6 +4816,14 @@ package body Sinfo is
Set_Node4_With_Parent (N, Val); Set_Node4_With_Parent (N, Val);
end Set_Last_Bit; 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 procedure Set_Last_Name
(N : Node_Id; Val : Boolean := True) is (N : Node_Id; Val : Boolean := True) is
begin begin
...@@ -6071,4 +6163,65 @@ package body Sinfo is ...@@ -6071,4 +6163,65 @@ package body Sinfo is
return Chars (Pragma_Identifier (N)); return Chars (Pragma_Identifier (N));
end Pragma_Name; 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; end Sinfo;
gcc/ada/sprint.adb
...@@ -999,12 +999,8 @@ package body Sprint is ...@@ -999,12 +999,8 @@ package body Sprint is
Write_Str_Sloc (" and then "); Write_Str_Sloc (" and then ");
Sprint_Right_Opnd (Node); Sprint_Right_Opnd (Node);
when N_At_Clause => when N_Aspect_Specification =>
Write_Indent_Str_Sloc ("for "); raise Program_Error;
Write_Id (Identifier (Node));
Write_Str_With_Col_Check (" use at ");
Sprint_Node (Expression (Node));
Write_Char (';');
when N_Assignment_Statement => when N_Assignment_Statement =>
Write_Indent; Write_Indent;
...@@ -1026,6 +1022,13 @@ package body Sprint is ...@@ -1026,6 +1022,13 @@ package body Sprint is
Sprint_Node (Abortable_Part (Node)); Sprint_Node (Abortable_Part (Node));
Write_Indent_Str ("end select;"); 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 => when N_Attribute_Definition_Clause =>
Write_Indent_Str_Sloc ("for "); Write_Indent_Str_Sloc ("for ");
Sprint_Node (Name (Node)); Sprint_Node (Name (Node));
......
gcc/ada/treepr.adb
...@@ -1099,6 +1099,7 @@ package body Treepr is ...@@ -1099,6 +1099,7 @@ package body Treepr is
when F_Field5 => when F_Field5 =>
Field_To_Be_Printed := Field5 (N) /= Union_Id (Empty); 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_Flag4 => Field_To_Be_Printed := Flag4 (N);
when F_Flag5 => Field_To_Be_Printed := Flag5 (N); when F_Flag5 => Field_To_Be_Printed := Flag5 (N);
when F_Flag6 => Field_To_Be_Printed := Flag6 (N); when F_Flag6 => Field_To_Be_Printed := Flag6 (N);
...@@ -1115,12 +1116,10 @@ package body Treepr is ...@@ -1115,12 +1116,10 @@ package body Treepr is
when F_Flag17 => Field_To_Be_Printed := Flag17 (N); when F_Flag17 => Field_To_Be_Printed := Flag17 (N);
when F_Flag18 => Field_To_Be_Printed := Flag18 (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_Flag1 => raise Program_Error;
when F_Flag2 => raise Program_Error; when F_Flag2 => raise Program_Error;
when F_Flag3 => raise Program_Error;
end case; end case;
-- Print field if it is to be printed -- Print field if it is to be printed
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment