From d1f453b76449578cac4b2c09fb574d85550e94ab Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 24 Apr 2009 13:14:22 +0000 Subject: [PATCH] einfo.adb (OK_To_Rename): New flag 2009-04-24 Robert Dewar * einfo.adb (OK_To_Rename): New flag * einfo.ads (OK_To_Rename): New flag * exp_ch3.adb (Expand_N_Object_Declaration): Rewrite as renames if OK_To_Rename set. * exp_ch4.adb (Expand_Concatenate): Mark temp variable OK_To_Rename * sem_ch7.adb (Uninstall_Declarations): Allow for renames from OK_To_Rename. From-SVN: r146714 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/einfo.adb | 16 ++++++++++++++-- gcc/ada/einfo.ads | 28 ++++++++++++++++++++++------ gcc/ada/exp_ch3.adb | 36 +++++++++++++++++++++++++++++++++++- gcc/ada/exp_ch4.adb | 8 +++++++- gcc/ada/sem_ch7.adb | 32 ++++++++++++++++++++++++++++++-- 6 files changed, 122 insertions(+), 12 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4385443..7290aa3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2009-04-24 Robert Dewar + + * einfo.adb (OK_To_Rename): New flag + + * einfo.ads (OK_To_Rename): New flag + + * exp_ch3.adb (Expand_N_Object_Declaration): Rewrite as renames if + OK_To_Rename set. + + * exp_ch4.adb (Expand_Concatenate): Mark temp variable OK_To_Rename + + * sem_ch7.adb (Uninstall_Declarations): Allow for renames from + OK_To_Rename. + 2009-04-24 Emmanuel Briot * prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, makeutl.adb, diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 0146c64..3791792 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -507,8 +507,7 @@ package body Einfo is -- Is_RACW_Stub_Type Flag244 -- Is_Private_Primitive Flag245 -- Is_Underlying_Record_View Flag246 - - -- (unused) Flag247 + -- OK_To_Rename Flag247 ----------------------- -- Local subprograms -- @@ -2292,6 +2291,12 @@ package body Einfo is return Uint10 (Id); end Normalized_Position_Max; + function OK_To_Rename (Id : E) return B is + begin + pragma Assert (Ekind (Id) = E_Variable); + return Flag247 (Id); + end OK_To_Rename; + function OK_To_Reorder_Components (Id : E) return B is begin pragma Assert (Is_Record_Type (Id)); @@ -4777,6 +4782,12 @@ package body Einfo is Set_Uint10 (Id, V); end Set_Normalized_Position_Max; + procedure Set_OK_To_Rename (Id : E; V : B := True) is + begin + pragma Assert (Ekind (Id) = E_Variable); + Set_Flag247 (Id, V); + end Set_OK_To_Rename; + procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is begin pragma Assert @@ -7008,6 +7019,7 @@ package body Einfo is W ("No_Strict_Aliasing", Flag136 (Id)); W ("Non_Binary_Modulus", Flag58 (Id)); W ("Nonzero_Is_True", Flag162 (Id)); + W ("OK_To_Rename", Flag247 (Id)); W ("OK_To_Reorder_Components", Flag239 (Id)); W ("Optimize_Alignment_Space", Flag241 (Id)); W ("Optimize_Alignment_Time", Flag242 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 35c8351..546763f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3009,6 +3009,23 @@ package Einfo is -- Applies to subprograms and subprogram types. Yields the number of -- formals as a value of type Pos. +-- OK_To_Rename (Flag247) +-- Present only in entities for variables. If this flag is set, it +-- means that if the entity is used as the initial value of an object +-- declaration, the object declaration can be safely converted into a +-- renaming to avoid an extra copy. This is set for variables which are +-- generated by the expander to hold the result of evaluating some +-- expression. Most notably, the local variables used to store the result +-- of concatenations are so marked (see Exp_Ch4.Expand_Concatenate). It +-- is only worth setting this flag for composites, since for primitive +-- types, it is cheaper to do the copy. + +-- OK_To_Reorder_Components (Flag239) [base type only] +-- Present in record types. Set if the back end is permitted to reorder +-- the components. If not set, the record must be layed out in the order +-- in which the components are declared textually. Currently this flag +-- can only be set by debug switches. + -- Optimize_Alignment_Space (Flag241) -- A flag present in type, subtype, variable, and constant entities. This -- flag records that the type or object is to be layed out in a manner @@ -3032,12 +3049,6 @@ package Einfo is -- points to the original array type for which this is the packed -- array implementation type. --- OK_To_Reorder_Components (Flag239) [base type only] --- Present in record types. Set if the back end is permitted to reorder --- the components. If not set, the record must be layed out in the order --- in which the components are declared textually. Currently this flag --- can only be set by debug switches. - -- Original_Record_Component (Node22) -- Present in components, including discriminants. The usage depends -- on whether the record is a base type and whether it is tagged. @@ -5397,6 +5408,7 @@ package Einfo is -- Is_True_Constant (Flag163) -- Is_Volatile (Flag16) -- Is_Return_Object (Flag209) + -- OK_To_Rename (Flag247) -- Optimize_Alignment_Space (Flag241) -- Optimize_Alignment_Time (Flag242) -- Treat_As_Volatile (Flag41) @@ -5927,6 +5939,7 @@ package Einfo is function Normalized_First_Bit (Id : E) return U; function Normalized_Position (Id : E) return U; function Normalized_Position_Max (Id : E) return U; + function OK_To_Rename (Id : E) return B; function OK_To_Reorder_Components (Id : E) return B; function Optimize_Alignment_Space (Id : E) return B; function Optimize_Alignment_Time (Id : E) return B; @@ -6480,6 +6493,7 @@ package Einfo is procedure Set_Normalized_First_Bit (Id : E; V : U); procedure Set_Normalized_Position (Id : E; V : U); procedure Set_Normalized_Position_Max (Id : E; V : U); + procedure Set_OK_To_Rename (Id : E; V : B := True); procedure Set_OK_To_Reorder_Components (Id : E; V : B := True); procedure Set_Optimize_Alignment_Space (Id : E; V : B := True); procedure Set_Optimize_Alignment_Time (Id : E; V : B := True); @@ -7173,6 +7187,7 @@ package Einfo is pragma Inline (Normalized_First_Bit); pragma Inline (Normalized_Position); pragma Inline (Normalized_Position_Max); + pragma Inline (OK_To_Rename); pragma Inline (OK_To_Reorder_Components); pragma Inline (Optimize_Alignment_Space); pragma Inline (Optimize_Alignment_Time); @@ -7562,6 +7577,7 @@ package Einfo is pragma Inline (Set_Normalized_Position); pragma Inline (Set_Normalized_Position_Max); pragma Inline (Set_OK_To_Reorder_Components); + pragma Inline (Set_OK_To_Rename); pragma Inline (Set_Optimize_Alignment_Space); pragma Inline (Set_Optimize_Alignment_Time); pragma Inline (Set_Original_Array_Type); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index ae7d7a9..8ffb6e0 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -4688,6 +4688,40 @@ package body Exp_Ch3 is Insert_After_And_Analyze (Init_After, Stat); end; end if; + + -- Final transformation, if the initializing expression is an entity + -- for a variable with OK_To_Rename set, then we transform: + + -- X : typ := expr; + + -- into + + -- X : typ renames expr + + -- provided that X is not aliased. The aliased case has to be + -- excluded in general because expr will not be aliased in general. + + if not Aliased_Present (N) + and then Is_Entity_Name (Expr_Q) + and then Ekind (Entity (Expr_Q)) = E_Variable + and then OK_To_Rename (Entity (Expr_Q)) + and then Is_Entity_Name (Object_Definition (N)) + then + Rewrite (N, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Defining_Identifier (N), + Subtype_Mark => Object_Definition (N), + Name => Expr_Q)); + + -- We do not analyze this renaming declaration, because all its + -- components have already been analyzed, and if we were to go + -- ahead and analyze it, we would in effect be trying to generate + -- another declaration of X, which won't do! + + Set_Renamed_Object (Defining_Identifier (N), Expr_Q); + Set_Analyzed (N); + end if; + end if; exception diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 19dbf7a..5a7d713 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -2805,6 +2805,12 @@ package body Exp_Ch4 is High_Bound => High_Bound))))), Suppress => All_Checks); + -- If the result of the concatenation appears as the initializing + -- expression of an object declaration, we can just rename the + -- result, rather than copying it. + + Set_OK_To_Rename (Ent); + -- Catch the static out of range case now if Raises_Constraint_Error (High_Bound) then diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 5cff944..c3a1fb3 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2137,13 +2137,38 @@ package body Sem_Ch7 is ("missing full declaration for private extension", Id); end if; + -- Case of constant, check for deferred constant declaration with + -- no full view. Likely just a matter of a missing expression, or + -- accidental use of the keyword constant. + elsif Ekind (Id) = E_Constant + + -- OK if constant value present + and then No (Constant_Value (Id)) + + -- OK if full view present + and then No (Full_View (Id)) + + -- OK if imported, since that provides the completion + and then not Is_Imported (Id) - and then (Nkind (Parent (Id)) /= N_Object_Declaration - or else not No_Initialization (Parent (Id))) + + -- OK if object declaration replaced by renaming declaration as + -- a result of OK_To_Rename processing (e.g. for concatenation) + + and then Nkind (Parent (Id)) /= N_Object_Renaming_Declaration + + -- OK if object declaration with the No_Initialization flag set + + and then not (Nkind (Parent (Id)) = N_Object_Declaration + and then No_Initialization (Parent (Id))) then + -- If no private declaration is present, we assume the user did + -- not intend a deferred constant declaration and the problem + -- is simply that the initializing expression is missing. + if not Has_Private_Declaration (Etype (Id)) then -- We assume that the user did not intend a deferred constant @@ -2159,6 +2184,9 @@ package body Sem_Ch7 is Parent (Id)); end if; + -- Otherwise if a private declaration is present, then we are + -- missing the full declaration for the deferred constant. + else Error_Msg_N ("missing full declaration for deferred constant (RM 7.4)", -- 2.7.4