Skip to content

R
riscv-gcc-1
Commit d1f453b7 by Robert Dewar Committed by Arnaud Charlet
Options

einfo.adb (OK_To_Rename): New flag 

2009-04-24  Robert Dewar  <dewar@adacore.com>

	* 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
parent ce72fe6c
Showing with 122 additions and 12 deletions
gcc/ada/ChangeLog
2009-04-24 Robert Dewar <dewar@adacore.com>
* 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 <briot@adacore.com>
* prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, makeutl.adb,
......
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));
......
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);
......
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
......
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
......
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)",
......
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