+2011-11-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_alfa.adb: Add with and use clauses for Exp_Ch8 and
+ Sem_Util.
+ (Expand_Alfa): Alphabetize cases on first choice. Add
+ processing for object renaming declarations, identifiers and
+ expanded names.
+ (Expand_Alfa_N_In): Remove useless return.
+ (Expand_Alfa_N_Object_Renaming_Declaration): New routine.
+ (Expand_Potential_Renaming): New routine.
+ * exp_ch8.adb (Evaluate_Name): Moved to the top level.
+ (Expand_N_Object_Declaration): Alphabetize local variables. Move
+ Evaluate_Name out to the top level.
+ * exp_ch8.ads (Evaluate_Name): Moved from body to package spec.
+ * exp_util.adb (Remove_Side_Effects): Add processing for
+ functions with side effects in Alfa mode.
+
+2011-11-04 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * gnat_rm.texi: Add entries for
+ restrictions No_Relative_Delay, No_Requeue_Statements and
+ No_Stream_Optimizations.
+
+2011-11-04 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch4.adb: Set type of entity in prefixed call, for
+ completeness in a generic context.
+
2011-11-04 Yannick Moy <moy@adacore.com>
* sem_prag.adb: Minor refactoring (renaming of a parameter).
with Exp_Attr; use Exp_Attr;
with Exp_Ch4; use Exp_Ch4;
with Exp_Ch6; use Exp_Ch6;
+with Exp_Ch8; use Exp_Ch8;
with Exp_Dbug; use Exp_Dbug;
with Nlists; use Nlists;
with Rtsfind; use Rtsfind;
with Sem_Aux; use Sem_Aux;
with Sem_Res; use Sem_Res;
+with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
procedure Expand_Alfa_N_In (N : Node_Id);
-- Expand set membership into individual ones
+ procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id);
+ -- Perform name evaluation for a renamed object
+
procedure Expand_Alfa_N_Simple_Return_Statement (N : Node_Id);
-- Insert conversion on function return if necessary
procedure Expand_Alfa_Simple_Function_Return (N : Node_Id);
-- Expand simple return from function
+ procedure Expand_Potential_Renaming (N : Node_Id);
+ -- N denotes a N_Identifier or N_Expanded_Name. If N references a renaming,
+ -- replace N with the renamed object.
+
-----------------
-- Expand_Alfa --
-----------------
procedure Expand_Alfa (N : Node_Id) is
begin
case Nkind (N) is
+ when N_Attribute_Reference =>
+ Expand_Alfa_N_Attribute_Reference (N);
- when N_Package_Body |
+ when N_Block_Statement |
+ N_Package_Body |
N_Package_Declaration |
- N_Subprogram_Body |
- N_Block_Statement =>
+ N_Subprogram_Body =>
Qualify_Entity_Names (N);
- when N_Simple_Return_Statement =>
- Expand_Alfa_N_Simple_Return_Statement (N);
-
when N_Function_Call |
N_Procedure_Call_Statement =>
Expand_Alfa_Call (N);
- when N_Attribute_Reference =>
- Expand_Alfa_N_Attribute_Reference (N);
+ when N_Expanded_Name |
+ N_Identifier =>
+ Expand_Potential_Renaming (N);
when N_In =>
Expand_Alfa_N_In (N);
when N_Not_In =>
Expand_N_Not_In (N);
+ when N_Object_Renaming_Declaration =>
+ Expand_Alfa_N_Object_Renaming_Declaration (N);
+
+ when N_Simple_Return_Statement =>
+ Expand_Alfa_N_Simple_Return_Statement (N);
+
when others =>
null;
end case;
Set_Entity (Name (Call_Node), Parent_Subp);
end if;
-
end Expand_Alfa_Call;
---------------------------------------
begin
if Present (Alternatives (N)) then
Expand_Set_Membership (N);
- return;
end if;
end Expand_Alfa_N_In;
+ -----------------------------------------------
+ -- Expand_Alfa_N_Object_Renaming_Declaration --
+ -----------------------------------------------
+
+ procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id) is
+ begin
+ -- Unconditionally remove all side effects from the name
+
+ Evaluate_Name (Name (N));
+ end Expand_Alfa_N_Object_Renaming_Declaration;
+
-------------------------------------------
-- Expand_Alfa_N_Simple_Return_Statement --
-------------------------------------------
E_Entry |
E_Entry_Family |
E_Return_Statement =>
- -- Expand_Non_Function_Return (N);
null;
when others =>
end if;
end Expand_Alfa_Simple_Function_Return;
+ -------------------------------
+ -- Expand_Potential_Renaming --
+ -------------------------------
+
+ procedure Expand_Potential_Renaming (N : Node_Id) is
+ E : constant Entity_Id := Entity (N);
+ T : constant Entity_Id := Etype (N);
+
+ begin
+ -- Substitute a reference to a renaming with the actual renamed object
+
+ if Present (Renamed_Object (E)) then
+ Rewrite (N, New_Copy_Tree (Renamed_Object (E)));
+
+ Reset_Analyzed_Flags (N);
+ Analyze_And_Resolve (N, T);
+ end if;
+ end Expand_Potential_Renaming;
+
end Exp_Alfa;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
package body Exp_Ch8 is
+ -------------------
+ -- Evaluate_Name --
+ -------------------
+
+ procedure Evaluate_Name (Nam : Node_Id) is
+ K : constant Node_Kind := Nkind (Nam);
+
+ begin
+ -- For an explicit dereference, we simply force the evaluation of the
+ -- name expression. The dereference provides a value that is the address
+ -- for the renamed object, and it is precisely this value that we want
+ -- to preserve.
+
+ if K = N_Explicit_Dereference then
+ Force_Evaluation (Prefix (Nam));
+
+ -- For a selected component, we simply evaluate the prefix
+
+ elsif K = N_Selected_Component then
+ Evaluate_Name (Prefix (Nam));
+
+ -- For an indexed component, or an attribute reference, we evaluate the
+ -- prefix, which is itself a name, recursively, and then force the
+ -- evaluation of all the subscripts (or attribute expressions).
+
+ elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then
+ Evaluate_Name (Prefix (Nam));
+
+ declare
+ E : Node_Id;
+
+ begin
+ E := First (Expressions (Nam));
+ while Present (E) loop
+ Force_Evaluation (E);
+
+ if Original_Node (E) /= E then
+ Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E)));
+ end if;
+
+ Next (E);
+ end loop;
+ end;
+
+ -- For a slice, we evaluate the prefix, as for the indexed component
+ -- case and then, if there is a range present, either directly or as the
+ -- constraint of a discrete subtype indication, we evaluate the two
+ -- bounds of this range.
+
+ elsif K = N_Slice then
+ Evaluate_Name (Prefix (Nam));
+
+ declare
+ DR : constant Node_Id := Discrete_Range (Nam);
+ Constr : Node_Id;
+ Rexpr : Node_Id;
+
+ begin
+ if Nkind (DR) = N_Range then
+ Force_Evaluation (Low_Bound (DR));
+ Force_Evaluation (High_Bound (DR));
+
+ elsif Nkind (DR) = N_Subtype_Indication then
+ Constr := Constraint (DR);
+
+ if Nkind (Constr) = N_Range_Constraint then
+ Rexpr := Range_Expression (Constr);
+
+ Force_Evaluation (Low_Bound (Rexpr));
+ Force_Evaluation (High_Bound (Rexpr));
+ end if;
+ end if;
+ end;
+
+ -- For a type conversion, the expression of the conversion must be the
+ -- name of an object, and we simply need to evaluate this name.
+
+ elsif K = N_Type_Conversion then
+ Evaluate_Name (Expression (Nam));
+
+ -- For a function call, we evaluate the call
+
+ elsif K = N_Function_Call then
+ Force_Evaluation (Nam);
+
+ -- The remaining cases are direct name, operator symbol and character
+ -- literal. In all these cases, we do nothing, since we want to
+ -- reevaluate each time the renamed object is used.
+
+ else
+ return;
+ end if;
+ end Evaluate_Name;
+
---------------------------------------------
-- Expand_N_Exception_Renaming_Declaration --
---------------------------------------------
procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is
Nam : constant Node_Id := Name (N);
- T : Entity_Id;
Decl : Node_Id;
-
- procedure Evaluate_Name (Fname : Node_Id);
- -- A recursive procedure used to freeze a name in the sense described
- -- above, i.e. any variable references or function calls are removed.
- -- Of course the outer level variable reference must not be removed.
- -- For example in A(J,F(K)), A is left as is, but J and F(K) are
- -- evaluated and removed.
+ T : Entity_Id;
function Evaluation_Required (Nam : Node_Id) return Boolean;
- -- Determines whether it is necessary to do static name evaluation
- -- for renaming of Nam. It is considered necessary if evaluating the
- -- name involves indexing a packed array, or extracting a component
- -- of a record to which a component clause applies. Note that we are
- -- only interested in these operations if they occur as part of the
- -- name itself, subscripts are just values that are computed as part
- -- of the evaluation, so their form is unimportant.
-
- -------------------
- -- Evaluate_Name --
- -------------------
-
- procedure Evaluate_Name (Fname : Node_Id) is
- K : constant Node_Kind := Nkind (Fname);
- E : Node_Id;
-
- begin
- -- For an explicit dereference, we simply force the evaluation
- -- of the name expression. The dereference provides a value that
- -- is the address for the renamed object, and it is precisely
- -- this value that we want to preserve.
-
- if K = N_Explicit_Dereference then
- Force_Evaluation (Prefix (Fname));
-
- -- For a selected component, we simply evaluate the prefix
-
- elsif K = N_Selected_Component then
- Evaluate_Name (Prefix (Fname));
-
- -- For an indexed component, or an attribute reference, we evaluate
- -- the prefix, which is itself a name, recursively, and then force
- -- the evaluation of all the subscripts (or attribute expressions).
-
- elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then
- Evaluate_Name (Prefix (Fname));
-
- E := First (Expressions (Fname));
- while Present (E) loop
- Force_Evaluation (E);
-
- if Original_Node (E) /= E then
- Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E)));
- end if;
-
- Next (E);
- end loop;
-
- -- For a slice, we evaluate the prefix, as for the indexed component
- -- case and then, if there is a range present, either directly or
- -- as the constraint of a discrete subtype indication, we evaluate
- -- the two bounds of this range.
-
- elsif K = N_Slice then
- Evaluate_Name (Prefix (Fname));
-
- declare
- DR : constant Node_Id := Discrete_Range (Fname);
- Constr : Node_Id;
- Rexpr : Node_Id;
-
- begin
- if Nkind (DR) = N_Range then
- Force_Evaluation (Low_Bound (DR));
- Force_Evaluation (High_Bound (DR));
-
- elsif Nkind (DR) = N_Subtype_Indication then
- Constr := Constraint (DR);
-
- if Nkind (Constr) = N_Range_Constraint then
- Rexpr := Range_Expression (Constr);
-
- Force_Evaluation (Low_Bound (Rexpr));
- Force_Evaluation (High_Bound (Rexpr));
- end if;
- end if;
- end;
-
- -- For a type conversion, the expression of the conversion must be
- -- the name of an object, and we simply need to evaluate this name.
-
- elsif K = N_Type_Conversion then
- Evaluate_Name (Expression (Fname));
-
- -- For a function call, we evaluate the call
-
- elsif K = N_Function_Call then
- Force_Evaluation (Fname);
-
- -- The remaining cases are direct name, operator symbol and
- -- character literal. In all these cases, we do nothing, since
- -- we want to reevaluate each time the renamed object is used.
-
- else
- return;
- end if;
- end Evaluate_Name;
+ -- Determines whether it is necessary to do static name evaluation for
+ -- renaming of Nam. It is considered necessary if evaluating the name
+ -- involves indexing a packed array, or extracting a component of a
+ -- record to which a component clause applies. Note that we are only
+ -- interested in these operations if they occur as part of the name
+ -- itself, subscripts are just values that are computed as part of the
+ -- evaluation, so their form is unimportant.
-------------------------
-- Evaluation_Required --
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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- --
procedure Expand_N_Object_Renaming_Declaration (N : Node_Id);
procedure Expand_N_Package_Renaming_Declaration (N : Node_Id);
procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id);
+
+ procedure Evaluate_Name (Nam : Node_Id);
+ -- Remove the all side effects from a name except for the outermost
+ -- construct.
+
end Exp_Ch8;
end;
end if;
- Ref_Type := Make_Temporary (Loc, 'A');
+ Def_Id := Make_Temporary (Loc, 'R', Exp);
+ Set_Etype (Def_Id, Exp_Type);
- Ptr_Typ_Decl :=
- Make_Full_Type_Declaration (Loc,
- Defining_Identifier => Ref_Type,
- Type_Definition =>
- Make_Access_To_Object_Definition (Loc,
- All_Present => True,
- Subtype_Indication =>
- New_Reference_To (Exp_Type, Loc)));
+ -- The regular expansion of functions with side effects involves the
+ -- generation of an access type to capture the return value found on
+ -- the secondary stack. Since Alfa (and why) cannot process access
+ -- types, use a different approach which ignores the secondary stack
+ -- and "copies" the returned object.
- E := Exp;
- Insert_Action (Exp, Ptr_Typ_Decl);
+ if Alfa_Mode then
+ Res := New_Reference_To (Def_Id, Loc);
+ Ref_Type := Exp_Type;
- Def_Id := Make_Temporary (Loc, 'R', Exp);
- Set_Etype (Def_Id, Exp_Type);
+ -- Regular expansion utilizing an access type and 'reference
- Res :=
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Def_Id, Loc));
+ else
+ Res :=
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Def_Id, Loc));
+
+ -- Generate:
+ -- type Ann is access all <Exp_Type>;
+ Ref_Type := Make_Temporary (Loc, 'A');
+
+ Ptr_Typ_Decl :=
+ Make_Full_Type_Declaration (Loc,
+ Defining_Identifier => Ref_Type,
+ Type_Definition =>
+ Make_Access_To_Object_Definition (Loc,
+ All_Present => True,
+ Subtype_Indication =>
+ New_Reference_To (Exp_Type, Loc)));
+
+ Insert_Action (Exp, Ptr_Typ_Decl);
+ end if;
+
+ E := Exp;
if Nkind (E) = N_Explicit_Dereference then
New_Exp := Relocate_Node (Prefix (E));
else
E := Relocate_Node (E);
- New_Exp := Make_Reference (Loc, E);
+
+ -- Do not generate a 'reference in Alfa since the access type is
+ -- not generated.
+
+ if Alfa_Mode then
+ New_Exp := E;
+ else
+ New_Exp := Make_Reference (Loc, E);
+ end if;
end if;
if Is_Delayed_Aggregate (E) then
This restriction ensures at compile time that there are no allocator
expressions that attempt to allocate protected objects.
+@item No_Relative_Delay
+@findex No_Relative_Delay
+This restriction ensures at compile time that there are no delay relative
+statements and prevents expressions such as @code{delay 1.23;} from appearing
+in source code.
+
+@item No_Requeue_Statements
+@findex No_Requeue_Statements
+This restriction ensures at compile time that no requeue statements are
+permitted and prevents keyword @code{requeue} from being used in source code.
+
@item No_Secondary_Stack
@findex No_Secondary_Stack
This restriction ensures at compile time that the generated code does not
have an explicit Storage_Pool attribute defined specifying a
user-defined storage pool.
+@item No_Stream_Optimizations
+@findex No_Stream_Optimizations
+This restriction affects the performance of stream operations on types
+@code{String}, @code{Wide_String} and @code{Wide_Wide_String}. By default, the
+compiler uses block reads and writes when manipulating @code{String} objects
+due to their supperior performance. When this restriction is in effect, the
+compiler performs all IO operations on a per-character basis.
+
@item No_Streams
@findex No_Streams
This restriction ensures at compile/bind time that there are no
First_Actual := First (Parameter_Associations (Call_Node));
-- For cross-reference purposes, treat the new node as being in
- -- the source if the original one is.
+ -- the source if the original one is. Set entity and type, even
+ -- though they may be overwritten during resolution if overloaded.
Set_Comes_From_Source (Subprog, Comes_From_Source (N));
Set_Comes_From_Source (Call_Node, Comes_From_Source (N));
and then not Inside_A_Generic
then
Set_Entity (Selector_Name (N), Entity (Subprog));
+ Set_Etype (Selector_Name (N), Etype (Entity (Subprog)));
end if;
-- If need be, rewrite first actual as an explicit dereference
projects / platform / upstream / linaro-gcc.git / commitdiff