From: Arnaud Charlet Date: Tue, 21 Jan 2014 07:47:43 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4bcf68150f3205da124e9ea303444ebbcb22c151;p=gcc.git [multiple changes] 2014-01-21 Robert Dewar * gcc-interface/gigi.h: Get Flags array address. * gcc-interface/trans.c: Acquire Flags array address. * atree.adb: Add support for Flags array and Flag0,1,2,3. * atree.ads: Add support for Flags array and Flag0,1,2,3. * atree.h: Add support for Flags array and Flag0,1,2,3. * back_end.adb: Pass Flags array address to gigi. 2014-01-21 Ed Schonberg * sem_ch8.adb (Attribute_Renaming): Transfer original attribute reference to generated body so that legality checks on stream attributes are properly applied. If type is tagged and already frozen, insert generated body at the point of the renaming declaration. 2014-01-21 Ed Schonberg * sem_ch12.adb: Code clean up. * sem_ch8.adb: Minor reformatting From-SVN: r206870 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0ae1c7adeaa..1a872b2094e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2014-01-21 Robert Dewar + + * gcc-interface/gigi.h: Get Flags array address. + * gcc-interface/trans.c: Acquire Flags array address. + * atree.adb: Add support for Flags array and Flag0,1,2,3. + * atree.ads: Add support for Flags array and Flag0,1,2,3. + * atree.h: Add support for Flags array and Flag0,1,2,3. + * back_end.adb: Pass Flags array address to gigi. + +2014-01-21 Ed Schonberg + + * sem_ch8.adb (Attribute_Renaming): Transfer original attribute + reference to generated body so that legality checks on stream + attributes are properly applied. If type is tagged and already + frozen, insert generated body at the point of the renaming + declaration. + +2014-01-21 Ed Schonberg + + * sem_ch12.adb: Code clean up. + * sem_ch8.adb: Minor reformatting + 2014-01-20 Robert Dewar * checks.adb: Check SPARK_Mode instead of GNATProve_Mode for diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index e7d4b20741f..ee53b977afa 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -568,14 +568,17 @@ package body Atree is and then Src = Nodes.Last then New_Id := Src; + else -- We are allocating a new node, or extending a node -- other than Nodes.Last. if Present (Src) then Nodes.Append (Nodes.Table (Src)); + Flags.Append (Flags.Table (Src)); else Nodes.Append (Default_Node); + Flags.Append (Default_Flags); end if; New_Id := Nodes.Last; @@ -596,10 +599,12 @@ package body Atree is if Present (Src) and then Has_Extension (Src) then for J in 1 .. Num_Extension_Nodes loop Nodes.Append (Nodes.Table (Src + Node_Id (J))); + Flags.Append (Flags.Table (Src + Node_Id (J))); end loop; else for J in 1 .. Num_Extension_Nodes loop Nodes.Append (Default_Node_Extension); + Flags.Append (Default_Flags); end loop; end if; end if; @@ -680,6 +685,8 @@ package body Atree is Nodes.Table (N).Nkind := New_Node_Kind; Nodes.Table (N).Error_Posted := Save_Posted; + Flags.Table (N) := Default_Flags; + if New_Node_Kind in N_Subexpr then Set_Paren_Count (N, Par_Count); end if; @@ -718,6 +725,8 @@ package body Atree is Nodes.Table (Destination).In_List := Save_In_List; Nodes.Table (Destination).Link := Save_Link; + Flags.Table (Destination) := Flags.Table (Source); + -- Specifically set Paren_Count to make sure auxiliary table entry -- gets correctly made if the parentheses count is at the max value. @@ -725,7 +734,8 @@ package body Atree is Set_Paren_Count (Destination, Paren_Count (Source)); end if; - -- Deal with copying extension nodes if present + -- Deal with copying extension nodes if present. No need to copy flags + -- table entries, since they are always zero for extending components. if Has_Extension (Source) then pragma Assert (Has_Extension (Destination)); @@ -1094,6 +1104,7 @@ package body Atree is procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id) is Temp_Ent : Node_Record; + Temp_Flg : Flags_Byte; begin pragma Assert (Has_Extension (E1) @@ -1127,6 +1138,13 @@ package body Atree is Nodes.Table (E1 + 5) := Nodes.Table (E2 + 5); Nodes.Table (E2 + 5) := Temp_Ent; + -- Exchange flag bytes for first component. No need to do the exchange + -- for the other components, since the flag bytes are always zero. + + Temp_Flg := Flags.Table (E1); + Flags.Table (E1) := Flags.Table (E2); + Flags.Table (E2) := Temp_Flg; + -- That exchange exchanged the parent pointers as well, which is what -- we want, but we need to patch up the defining identifier pointers -- in the parent nodes (the child pointers) to match this switch @@ -1231,6 +1249,15 @@ package body Atree is Fix_Parent (Field5 (Fix_Node)); end Fix_Parents; + ------------------- + -- Flags_Address -- + ------------------- + + function Flags_Address return System.Address is + begin + return Flags.Table (First_Node_Id)'Address; + end Flags_Address; + ----------------------------------- -- Get_Comes_From_Source_Default -- ----------------------------------- @@ -1270,6 +1297,7 @@ package body Atree is begin Node_Count := 0; Atree_Private_Part.Nodes.Init; + Atree_Private_Part.Flags.Init; Orig_Nodes.Init; Paren_Counts.Init; @@ -1320,8 +1348,10 @@ package body Atree is procedure Lock is begin Nodes.Locked := True; + Flags.Locked := True; Orig_Nodes.Locked := True; Nodes.Release; + Flags.Release; Orig_Nodes.Release; end Lock; @@ -2157,6 +2187,7 @@ package body Atree is begin Tree_Read_Int (Node_Count); Nodes.Tree_Read; + Flags.Tree_Read; Orig_Nodes.Tree_Read; Paren_Counts.Tree_Read; end Tree_Read; @@ -2169,6 +2200,7 @@ package body Atree is begin Tree_Write_Int (Node_Count); Nodes.Tree_Write; + Flags.Tree_Write; Orig_Nodes.Tree_Write; Paren_Counts.Tree_Write; end Tree_Write; @@ -3006,6 +3038,30 @@ package body Atree is return From_Union (Nodes.Table (N + 3).Field8); end Ureal21; + function Flag0 (N : Node_Id) return Boolean is + begin + pragma Assert (N <= Nodes.Last); + return Flags.Table (N).Flag0; + end Flag0; + + function Flag1 (N : Node_Id) return Boolean is + begin + pragma Assert (N <= Nodes.Last); + return Flags.Table (N).Flag1; + end Flag1; + + function Flag2 (N : Node_Id) return Boolean is + begin + pragma Assert (N <= Nodes.Last); + return Flags.Table (N).Flag2; + end Flag2; + + function Flag3 (N : Node_Id) return Boolean is + begin + pragma Assert (N <= Nodes.Last); + return Flags.Table (N).Flag3; + end Flag3; + function Flag4 (N : Node_Id) return Boolean is begin pragma Assert (N <= Nodes.Last); @@ -5563,6 +5619,30 @@ package body Atree is Nodes.Table (N + 3).Field8 := To_Union (Val); end Set_Ureal21; + procedure Set_Flag0 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (N <= Nodes.Last); + Flags.Table (N).Flag0 := Val; + end Set_Flag0; + + procedure Set_Flag1 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (N <= Nodes.Last); + Flags.Table (N).Flag1 := Val; + end Set_Flag1; + + procedure Set_Flag2 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (N <= Nodes.Last); + Flags.Table (N).Flag2 := Val; + end Set_Flag2; + + procedure Set_Flag3 (N : Node_Id; Val : Boolean) is + begin + pragma Assert (N <= Nodes.Last); + Flags.Table (N).Flag3 := Val; + end Set_Flag3; + procedure Set_Flag4 (N : Node_Id; Val : Boolean) is begin pragma Assert (N <= Nodes.Last); @@ -7924,6 +8004,7 @@ package body Atree is procedure Unlock is begin Nodes.Locked := False; + Flags.Locked := False; Orig_Nodes.Locked := False; end Unlock; diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 0f47e862f45..0896e423a29 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -168,16 +168,20 @@ 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 - -- 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. + -- Flag0 Nineteen Boolean flags (use depends on Nkind and + -- Flag1 Ekind, as described for FieldN). Again the access + -- Flag2 is usually via subprograms in Sinfo and Einfo which + -- Flag3 provide high-level synonyms for these flags, and + -- Flag4 contain debugging code that checks that the values + -- Flag5 in Nkind and Ekind are appropriate for the access. + -- Flag6 + -- Flag7 + -- Flag8 + -- Flag9 -- Flag10 - -- Flag11 Note that Flag1-3 are missing from this list. For - -- Flag12 historical reasons, these flag names are unused. - -- Flag13 + -- Flag11 Note that Flag0-3 are stored separately in the Flags + -- Flag12 table, but that's a detail of the implementation which + -- Flag13 is entirely hidden by the funcitonal interface. -- Flag14 -- Flag15 -- Flag16 @@ -220,6 +224,9 @@ package Atree is function Nodes_Address return System.Address; -- Return address of Nodes table (used in Back_End for Gigi call) + function Flags_Address return System.Address; + -- Return address of Flags table (used in Back_End for Gigi call) + function Num_Nodes return Nat; -- Total number of nodes allocated, where an entity counts as a single -- node. This count is incremented every time a node or entity is @@ -350,7 +357,7 @@ package Atree is ------------------------------------- -- A subpackage Atree.Unchecked_Access provides routines for reading and - -- writing the fields defined above (Field1-35, Node1-35, Flag4-317 etc). + -- writing the fields defined above (Field1-35, Node1-35, Flag0-317 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 @@ -1341,6 +1348,18 @@ package Atree is function Ureal21 (N : Node_Id) return Ureal; pragma Inline (Ureal21); + function Flag0 (N : Node_Id) return Boolean; + pragma Inline (Flag0); + + function Flag1 (N : Node_Id) return Boolean; + pragma Inline (Flag1); + + function Flag2 (N : Node_Id) return Boolean; + pragma Inline (Flag2); + + function Flag3 (N : Node_Id) return Boolean; + pragma Inline (Flag3); + function Flag4 (N : Node_Id) return Boolean; pragma Inline (Flag4); @@ -2624,6 +2643,18 @@ package Atree is procedure Set_Ureal21 (N : Node_Id; Val : Ureal); pragma Inline (Set_Ureal21); + procedure Set_Flag0 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag0); + + procedure Set_Flag1 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag1); + + procedure Set_Flag2 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag2); + + procedure Set_Flag3 (N : Node_Id; Val : Boolean); + pragma Inline (Set_Flag3); + procedure Set_Flag4 (N : Node_Id; Val : Boolean); pragma Inline (Set_Flag4); @@ -3621,12 +3652,12 @@ package Atree is ------------------------- -- The nodes of the tree are stored in a table (i.e. an array). In the - -- case of extended nodes five consecutive components in the array are + -- case of extended nodes six consecutive components in the array are -- used. There are thus two formats for array components. One is used -- for non-extended nodes, and for the first component of extended -- nodes. The other is used for the extension parts (second, third, - -- fourth and fifth components) of an extended node. A variant record - -- structure is used to distinguish the two formats. + -- fourth, fifth, and sixth components) of an extended node. A variant + -- record structure is used to distinguish the two formats. type Node_Record (Is_Extension : Boolean := False) is record @@ -3680,7 +3711,8 @@ package Atree is Flag16 : Boolean; Flag17 : Boolean; Flag18 : Boolean; - -- The eighteen flags for a normal node + -- Flags 4-18 for a normal node. Note that Flags 0-3 are stored + -- separately in the Flags array. -- The above fields are used as follows in components 2-6 of -- an extended node entry. @@ -3888,7 +3920,7 @@ package Atree is Field12 => Empty_List_Or_Node); -- The following defines the extendable array used for the nodes table - -- Nodes with extensions use five consecutive entries in the array + -- Nodes with extensions use six consecutive entries in the array package Nodes is new Table.Table ( Table_Component_Type => Node_Record, @@ -3898,6 +3930,37 @@ package Atree is Table_Increment => Alloc.Nodes_Increment, Table_Name => "Nodes"); + -- The following is a parallel table to Nodes, which provides 8 more + -- bits of space that logically belong to the corresponding node. This + -- is currently used to implement Flags 0,1,2,3 for normal nodes, or + -- the first component of an extended node (four bits unused). Entries + -- for extending components are completely unused. + + type Flags_Byte is record + Flag0 : Boolean; + Flag1 : Boolean; + Flag2 : Boolean; + Flag3 : Boolean; + Spare0 : Boolean; + Spare1 : Boolean; + Spare2 : Boolean; + Spare3 : Boolean; + end record; + + for Flags_Byte'Size use 8; + pragma Pack (Flags_Byte); + + Default_Flags : constant Flags_Byte := (others => False); + -- Default value used to initialize new entries + + package Flags is new Table.Table ( + Table_Component_Type => Flags_Byte, + Table_Index_Type => Node_Id'Base, + Table_Low_Bound => First_Node_Id, + Table_Initial => Alloc.Nodes_Initial, + Table_Increment => Alloc.Nodes_Increment, + Table_Name => "Flags"); + end Atree_Private_Part; end Atree; diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index c9fd5e0481b..f3913852e12 100644 --- a/gcc/ada/atree.h +++ b/gcc/ada/atree.h @@ -359,6 +359,21 @@ extern struct Node *Nodes_Ptr; #define Parent atree__parent extern Node_Id Parent (Node_Id); +/* The auxiliary flags array which is allocated in parallel to Nodes */ + +struct Flags +{ + Boolean Flag0 : 1; + Boolean Flag1 : 1; + Boolean Flag2 : 1; + Boolean Flag3 : 1; + Boolean Spare0 : 1; + Boolean Spare1 : 1; + Boolean Spare2 : 1; + Boolean Spare3 : 1; +}; +extern struct Flags *Flags_Ptr; + /* Overloaded Functions: These functions are overloaded in the original Ada source, but there is @@ -531,6 +546,11 @@ extern Node_Id Current_Error_Node; #define Convention(N) \ (Nodes_Ptr[(N) - First_Node_Id + 2].V.EX.U.fw.convention) +#define Flag0(N) (Flags_Ptr[(N) - First_Node_Id].Flag0) +#define Flag1(N) (Flags_Ptr[(N) - First_Node_Id].Flag1) +#define Flag2(N) (Flags_Ptr[(N) - First_Node_Id].Flag2) +#define Flag3(N) (Flags_Ptr[(N) - First_Node_Id].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) diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index 577d004c719..6488da1e468 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -87,6 +87,7 @@ package body Back_End is max_gnat_node : Int; number_name : Nat; nodes_ptr : Address; + flags_ptr : Address; next_node_ptr : Address; prev_node_ptr : Address; @@ -141,6 +142,7 @@ package body Back_End is max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1), number_name => Name_Entries_Count, nodes_ptr => Nodes_Address, + flags_ptr => Flags_Address, next_node_ptr => Next_Node_Address, prev_node_ptr => Prev_Node_Address, diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 832803ccfc3..cf75bd62040 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -238,10 +238,14 @@ extern "C" { /* This is the main program of the back-end. It sets up all the table structures and then generates code. */ -extern void gigi (Node_Id gnat_root, int max_gnat_node, +extern void gigi (Node_Id gnat_root, + int max_gnat_node, int number_name ATTRIBUTE_UNUSED, - struct Node *nodes_ptr, Node_Id *next_node_ptr, - Node_Id *prev_node_ptr, struct Elist_Header *elists_ptr, + struct Node *nodes_ptr, + struct Flags *Flags_Ptr, + Node_Id *next_node_ptr, + Node_Id *prev_node_ptr, + struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr, struct String_Entry *strings_ptr, Char_Code *strings_chars_ptr, diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index d99eda8a2aa..b0cbedb78f0 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -90,6 +90,7 @@ static location_t block_end_locus_sink; /* Pointers to front-end tables accessed through macros. */ struct Node *Nodes_Ptr; +struct Flags *Flags_Ptr; Node_Id *Next_Node_Ptr; Node_Id *Prev_Node_Ptr; struct Elist_Header *Elists_Ptr; @@ -273,15 +274,26 @@ static const char *decode_name (const char *) ATTRIBUTE_UNUSED; structures and then generates code. */ void -gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, - struct Node *nodes_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr, - struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr, - struct String_Entry *strings_ptr, Char_Code *string_chars_ptr, - struct List_Header *list_headers_ptr, Nat number_file, +gigi (Node_Id gnat_root, + int max_gnat_node, + int number_name ATTRIBUTE_UNUSED, + struct Node *nodes_ptr, + struct Flags *flags_ptr, + Node_Id *next_node_ptr, + Node_Id *prev_node_ptr, + struct Elist_Header *elists_ptr, + struct Elmt_Item *elmts_ptr, + struct String_Entry *strings_ptr, + Char_Code *string_chars_ptr, + struct List_Header *list_headers_ptr, + Nat number_file, struct File_Info_Type *file_info_ptr, - Entity_Id standard_boolean, Entity_Id standard_integer, - Entity_Id standard_character, Entity_Id standard_long_long_float, - Entity_Id standard_exception_type, Int gigi_operating_mode) + Entity_Id standard_boolean, + Entity_Id standard_integer, + Entity_Id standard_character, + Entity_Id standard_long_long_float, + Entity_Id standard_exception_type, + Int gigi_operating_mode) { Node_Id gnat_iter; Entity_Id gnat_literal; @@ -293,6 +305,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED, max_gnat_nodes = max_gnat_node; Nodes_Ptr = nodes_ptr; + Flags_Ptr = flags_ptr; Next_Node_Ptr = next_node_ptr; Prev_Node_Ptr = prev_node_ptr; Elists_Ptr = elists_ptr; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 12f53d3eddf..d90d58c7b30 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -13060,10 +13060,12 @@ package body Sem_Ch12 is -- package, which is necessary semantically but complicates -- ASIS tree traversal, so we recover the original entity to -- expose the renaming. Take into account that the context may - -- be a nested generic and that the original node may itself - -- have an associated node that had better be an entity. + -- be a nested generic, that the original node may itself have + -- an associated node that had better be an entity, and that + -- the current node is still a selected component. if Ekind (E) = E_Package + and then Nkind (N) = N_Selected_Component and then Nkind (Parent (N)) = N_Expanded_Name and then Present (Original_Node (N2)) and then Is_Entity_Name (Original_Node (N2)) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 33c3dbf7aac..792b85ffab2 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3437,13 +3437,12 @@ package body Sem_Ch8 is -- a list of expressions corresponding to the subprogram formals. -- A renaming declaration is not a freeze point, and the analysis of -- the attribute reference should not freeze the type of the prefix. + -- We use the original node in the renaming so that its source location + -- is preserved, and checks on stream attributes are properly applied. else - Attr_Node := - Make_Attribute_Reference (Loc, - Prefix => Prefix (Nam), - Attribute_Name => Aname, - Expressions => Expr_List); + Attr_Node := Relocate_Node (Nam); + Set_Expressions (Attr_Node, Expr_List); Set_Must_Not_Freeze (Attr_Node); Set_Must_Not_Freeze (Prefix (Nam)); @@ -3459,8 +3458,8 @@ package body Sem_Ch8 is Find_Type (Result_Definition (Spec)); Rewrite (Result_Definition (Spec), - New_Reference_To ( - Base_Type (Entity (Result_Definition (Spec))), Loc)); + New_Reference_To + (Base_Type (Entity (Result_Definition (Spec))), Loc)); Body_Node := Make_Subprogram_Body (Loc, @@ -3522,7 +3521,12 @@ package body Sem_Ch8 is Find_Type (P); end if; - if Is_Tagged_Type (Etype (P)) then + -- If the target type is not yet frozen, add the body to the + -- actions to be elaborated at freeze time. + + if Is_Tagged_Type (Etype (P)) + and then In_Open_Scopes (Scope (Etype (P))) + then Ensure_Freeze_Node (Etype (P)); Append_Freeze_Action (Etype (P), Body_Node); else