procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2014-01-21  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Build_Init_Procedure): For
	derivations of interfaces, do not move the the initialization
	of the _parent field since such assignment is not generated.

2014-01-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Rewrite_Renamed_Operator): Do not replace entity
	with the operator it renames if we are within an expression of
	a pre/postcondition, because the expression will be reanalyzed
	at a later point, and the analysis of the renaming may affect
	the visibility of the operator when in an instance.

2014-01-21  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads, sinfo.adb: Change Do_Discriminant_Check to use new Flag1.
	Add this flag to type conversion nodes and assignment nodes.
	* treepr.adb: Deal properly with Flag 1,2,3.
	* treeprs.adt: Minor comment update.

2014-01-21  Robert Dewar  <dewar@adacore.com>

	* sem_eval.adb (Compile_Time_Known_Value): Add Ignore_CRT
	parameter.
	* sem_eval.ads (Compile_Time_Known_Value): Add Ignore_CRT
	parameter, completely rewrite spec.

2014-01-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Install_Withed_Unit): If the unit is a subprogram
	instance that is inlined, it may have been rewritten as a wrapper
	package. In that case the unit that must be made visible is the
	related instance of the package.

2014-01-21  Arnaud Charlet  <charlet@adacore.com>

	* exp_ch9.adb (Expand_N_Selective_Accept.Add_Accept): Refine
	previous change in codepeer mode.

From-SVN: r206874
This commit is contained in:
Arnaud Charlet 2014-01-21 09:01:05 +01:00
parent 6b6041ec65
commit 8d81fb4ea2
11 changed files with 180 additions and 72 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
gcc/ada/ChangeLog
View file

@ -1,3 +1,43 @@
2014-01-21 Javier Miranda <miranda@adacore.com>
* exp_ch3.adb (Build_Init_Procedure): For
derivations of interfaces, do not move the the initialization
of the _parent field since such assignment is not generated.
2014-01-21 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Rewrite_Renamed_Operator): Do not replace entity
with the operator it renames if we are within an expression of
a pre/postcondition, because the expression will be reanalyzed
at a later point, and the analysis of the renaming may affect
the visibility of the operator when in an instance.
2014-01-21 Robert Dewar <dewar@adacore.com>
* sinfo.ads, sinfo.adb: Change Do_Discriminant_Check to use new Flag1.
Add this flag to type conversion nodes and assignment nodes.
* treepr.adb: Deal properly with Flag 1,2,3.
* treeprs.adt: Minor comment update.
2014-01-21 Robert Dewar <dewar@adacore.com>
* sem_eval.adb (Compile_Time_Known_Value): Add Ignore_CRT
parameter.
* sem_eval.ads (Compile_Time_Known_Value): Add Ignore_CRT
parameter, completely rewrite spec.
2014-01-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Install_Withed_Unit): If the unit is a subprogram
instance that is inlined, it may have been rewritten as a wrapper
package. In that case the unit that must be made visible is the
related instance of the package.
2014-01-21 Arnaud Charlet <charlet@adacore.com>
* exp_ch9.adb (Expand_N_Selective_Accept.Add_Accept): Refine
previous change in codepeer mode.
2014-01-21 Arnaud Charlet <charlet@adacore.com>
* exp_ch9.adb (Expand_N_Selective_Accept.Add_Accept): Always add

12
gcc/ada/exp_ch3.adb
View file

@ -2386,10 +2386,16 @@ package body Exp_Ch3 is
Component_List (Record_Extension_Node));
begin
-- The parent field must be initialized first because
-- the offset of the new discriminants may depend on it
-- The parent field must be initialized first because the
-- offset of the new discriminants may depend on it. This is
-- not needed if the parent is an interface type because in
-- such case the initialization of the _parent field was not
-- generated.
if not Is_Interface (Etype (Rec_Ent)) then
Prepend_To (Body_Stmts, Remove_Head (Stmts));
end if;
Prepend_To (Body_Stmts, Remove_Head (Stmts));
Append_List_To (Body_Stmts, Stmts);
end;
end if;

24
gcc/ada/exp_ch9.adb
View file

@ -10339,17 +10339,21 @@ package body Exp_Ch9 is
if Present (Handled_Statement_Sequence (Accept_Statement (Alt))) then
Null_Body := New_Reference_To (Standard_False, Eloc);
-- Always add call to Abort_Undefer, since this is what the
-- runtime expects (abort deferred in Selective_Wait).
-- Always add call to Abort_Undefer when generating code, since
-- this is what the runtime expects (abort deferred in
-- Selective_Wait). In CodePeer mode this only confuses the
-- analysis with unknown calls, so don't do it.
Call :=
Make_Procedure_Call_Statement (Eloc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Eloc));
Insert_Before
(First (Statements (Handled_Statement_Sequence
(Accept_Statement (Alt)))),
Call);
Analyze (Call);
if not CodePeer_Mode then
Call :=
Make_Procedure_Call_Statement (Eloc,
Name => New_Reference_To (RTE (RE_Abort_Undefer), Eloc));
Insert_Before
(First (Statements (Handled_Statement_Sequence
(Accept_Statement (Alt)))),
Call);
Analyze (Call);
end if;
PB_Ent :=
Make_Defining_Identifier (Eloc,

9
gcc/ada/sem_ch10.adb
View file

@ -5156,6 +5156,14 @@ package body Sem_Ch10 is
Set_Is_Visible_Lib_Unit (Uname);
-- If the unit is a wrapper package for a compilation unit that is
-- a subprogrm instance, indicate that the instance itself is a
-- visible unit. This is necessary if the instance is inlined.
if Is_Wrapper_Package (Uname) then
Set_Is_Visible_Lib_Unit (Related_Instance (Uname));
end if;
-- If the child unit appears in the context of its parent, it is
-- immediately visible.
@ -6447,6 +6455,7 @@ package body Sem_Ch10 is
-- If the unit is a wrapper package, the subprogram instance is
-- what must be removed from visibility.
-- Should we use Related_Instance instead???
if Is_Wrapper_Package (Unit_Name) then
Set_Is_Immediately_Visible (Current_Entity (Unit_Name), False);

10
gcc/ada/sem_eval.adb
View file

@ -1287,7 +1287,10 @@ package body Sem_Eval is
-- Compile_Time_Known_Value --
------------------------------
function Compile_Time_Known_Value (Op : Node_Id) return Boolean is
function Compile_Time_Known_Value
(Op : Node_Id;
Ignore_CRT : Boolean := False) return Boolean
is
K : constant Node_Kind := Nkind (Op);
CV_Ent : CV_Entry renames CV_Cache (Nat (Op) mod CV_Cache_Size);
@ -1311,9 +1314,9 @@ package body Sem_Eval is
-- time. This avoids anomalies where whether something is allowed with a
-- given configurable run-time library depends on how good the compiler
-- is at optimizing and knowing that things are constant when they are
-- nonstatic.
-- nonstatic. This check is suppressed if Ignore_CRT is True
if Configurable_Run_Time_Mode
if (Configurable_Run_Time_Mode and not Ignore_CRT)
and then K /= N_Null
and then not Is_Static_Expression (Op)
then
@ -1326,7 +1329,6 @@ package body Sem_Eval is
and then Etype (Entity (Op)) = Standard_Boolean
then
null;
else
return False;
end if;

73
gcc/ada/sem_eval.ads
View file

@ -85,14 +85,14 @@ package Sem_Eval is
-- does not raise constraint error. In fact for certain legality checks not
-- only do we need to ascertain that the expression is static, but we must
-- also ensure that it does not raise constraint error.
--
-- Neither of Is_Static_Expression and Is_OK_Static_Expression should be
-- used for compile time evaluation purposes. In fact certain expression
-- whose value is known at compile time are not static in the RM 4.9 sense.
-- A typical example is:
--
-- whose value may be known at compile time are not static in the RM 4.9
-- sense. A typical example is:
-- C : constant Integer := Record_Type'Size;
--
-- The expression 'C' is not static in the technical RM sense, but for many
-- simple record types, the size is in fact known at compile time. When we
-- are trying to perform compile time constant folding (for instance for
@ -100,8 +100,8 @@ package Sem_Eval is
-- are not the right functions to test if folding is possible. Instead, we
-- use Compile_Time_Known_Value. All static expressions that do not raise
-- constraint error (i.e. those for which Is_OK_Static_Expression is true)
-- are known at compile time, but as shown by the above example, there are
-- cases of non-static expressions which are known at compile time.
-- are known at compile time, but as shown by the above example, there may
-- be cases of non-static expressions which are known at compile time.
-----------------
-- Subprograms --
@ -224,15 +224,60 @@ package Sem_Eval is
-- Determine whether two types T1, T2, which have the same base type,
-- are statically matching subtypes (RM 4.9.1(1-2)).
function Compile_Time_Known_Value (Op : Node_Id) return Boolean;
function Compile_Time_Known_Value
(Op : Node_Id;
Ignore_CRT : Boolean := False) return Boolean;
-- Returns true if Op is an expression not raising Constraint_Error whose
-- value is known at compile time. This is true if Op is a static
-- value is known at compile time and for which a call to Expr_Value can
-- be used to determine this value. This is always true if Op is a static
-- expression, but can also be true for expressions which are technically
-- non-static but which are in fact known at compile time, such as the
-- static lower bound of a non-static range or the value of a constant
-- object whose initial value is static. Note that this routine is defended
-- against unanalyzed expressions. Such expressions will not cause a
-- blowup, they may cause pessimistic (i.e. False) results to be returned.
-- non-static but which are in fact known at compile time. Some possible
-- examples of such expressions might be the static lower bound of a
-- non-static range or the value of a constant object whose initial
-- value is itself compile time known in the sense of this routine. Note
-- that this routine is defended against unanalyzed expressions. Such
-- expressions will not cause a blowup, they may cause pessimistic (i.e.
-- False) results to be returned. In general we take a pessimistic view.
-- False does not mean the value could not be known at compile time, but
-- True means that absolutely definition it is known at compile time and
-- it is safe to call Expr_Value on the expression Op.
--
-- Note that we don't define precisely the set of expressions that return
-- True. Callers should not make any assumptions regarding the value that
-- is returned for non-static expressions. Functional behavior should never
-- be affected by whether a given non-static expression returns True or
-- False when this function is called. In other words this is purely for
-- efficiency optimization purposes. The code generated can often be more
-- efficient with compile time known values, e.g. range analysis for the
-- purpose of removing checks is more effective if we know precise bounds.
--
-- The Ignore_CRT parameter has to do with the special case of configurable
-- runtime mode. Consider the following example:
--
-- X := B ** C;
--
-- Now if C is compile time known, and has the value 4, then inline code
-- can be generated at compile time, instead of calling a run-time routine.
-- That's fine in the normal case, but when we have a configurable run-time
-- the run-time routine may not be available. This means that the program
-- will be rejected if C is not known at compile time. We don't want the
-- legality of a program to depend on how clever the implementation of this
-- function is. If the run-time in use lacks the exponentiation routine,
-- then what we say is that exponentiation is permitted if the exponent is
-- officially static and has a value in the range 0 .. 4.
--
-- However, in the normal case, we want efficient code in the case where
-- a non-static exponent is known at compile time. To take care of this,
-- the normal default behavior is that in configurable run-time mode most
-- expressions are considered known at compile time ONLY in the case where
-- they are officially static. An exception is boolean objects which may
-- be considered known at compile time even in configurable run-time mode.
--
-- That loses optimization opportunities, and it would be better to look
-- case by case at each use of Compile_Time_Known_Value to see if this
-- configurable run-time mode special processing is needed. The Ignore_CRT
-- parameter can be set to True to ignore this special handling in cases
-- where it is known to be safe to do so.
function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean;
-- Similar to Compile_Time_Known_Value, but also returns True if the value

8
gcc/ada/sem_res.adb
View file

@ -10301,6 +10301,14 @@ package body Sem_Res is
Op_Node : Node_Id;
begin
-- Do not perform this transformation within a pre/postcondition,
-- because the expression will be re-analyzed, and the transformation
-- might affect the visibility of the operator, e.g. in an instance.
if In_Assertion_Expr > 0 then
return;
end if;
-- Rewrite the operator node using the real operator, not its renaming.
-- Exclude user-defined intrinsic operations of the same name, which are
-- treated separately and rewritten as calls.

12
gcc/ada/sinfo.adb
View file

@ -930,8 +930,10 @@ package body Sinfo is
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Selected_Component);
return Flag13 (N);
or else NT (N).Nkind = N_Assignment_Statement
or else NT (N).Nkind = N_Selected_Component
or else NT (N).Nkind = N_Type_Conversion);
return Flag1 (N);
end Do_Discriminant_Check;
function Do_Division_Check
@ -4078,8 +4080,10 @@ package body Sinfo is
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Selected_Component);
Set_Flag13 (N, Val);
or else NT (N).Nkind = N_Assignment_Statement
or else NT (N).Nkind = N_Selected_Component
or else NT (N).Nkind = N_Type_Conversion);
Set_Flag1 (N, Val);
end Set_Do_Discriminant_Check;
procedure Set_Do_Division_Check

31
gcc/ada/sinfo.ads
View file

@ -638,9 +638,7 @@ package Sinfo is
-- A flag set in the N_Subprogram_Body node for a subprogram body which
-- is acting as its own spec, except in the case of a library level
-- subprogram, in which case the flag is set on the parent compilation
-- unit node instead (see further description in spec of Lib package).
-- ??? Above note about Lib is dubious since lib.ads does not mention
-- Acts_As_Spec at all.
-- unit node instead.
-- Actual_Designated_Subtype (Node4-Sem)
-- Present in N_Free_Statement and N_Explicit_Dereference nodes. If gigi
@ -902,14 +900,16 @@ package Sinfo is
-- that an accessibility check is required for the parameter. It is
-- not yet decided who takes care of this check (TBD ???).
-- Do_Discriminant_Check (Flag13-Sem)
-- Do_Discriminant_Check (Flag1-Sem)
-- This flag is set on N_Selected_Component nodes to indicate that a
-- discriminant check is required using the discriminant check routine
-- associated with the selector. The actual check is generated by the
-- expander when processing selected components. In the case of
-- Unchecked_Union, the flag is also set, but no discriminant check
-- routine is associated with the selector, and the expander does not
-- generate a check.
-- generate a check. This flag is also present in assignment statements
-- (and set if the assignment requires a discriminant check), and in type
-- conversion nodes (and set if the conversion requires a check).
-- Do_Division_Check (Flag13-Sem)
-- This flag is set on a division operator (/ mod rem) to indicate
@ -1682,11 +1682,10 @@ package Sinfo is
-- is undefined and should not be read).
-- No_Ctrl_Actions (Flag7-Sem)
-- Present in N_Assignment_Statement to indicate that no finalize nor
-- adjust should take place on this assignment even though the rhs is
-- Present in N_Assignment_Statement to indicate that no Finalize nor
-- Adjust should take place on this assignment even though the RHS is
-- controlled. This is used in init procs and aggregate expansions where
-- the generated assignments are more initialisations than real
-- assignments.
-- the generated assignments are initializations, not real assignments.
-- No_Elaboration_Check (Flag14-Sem)
-- Present in N_Function_Call and N_Procedure_Call_Statement. Indicates
@ -3439,7 +3438,7 @@ package Sinfo is
-- Prefix (Node3)
-- Selector_Name (Node2)
-- Associated_Node (Node4-Sem)
-- Do_Discriminant_Check (Flag13-Sem)
-- Do_Discriminant_Check (Flag1-Sem)
-- Is_In_Discriminant_Check (Flag11-Sem)
-- Is_Prefixed_Call (Flag17-Sem)
-- Atomic_Sync_Required (Flag14-Sem)
@ -4197,12 +4196,13 @@ package Sinfo is
-- Sloc points to first token of subtype mark
-- Subtype_Mark (Node4)
-- Expression (Node3)
-- Do_Tag_Check (Flag13-Sem)
-- Do_Discriminant_Check (Flag1-Sem)
-- Do_Length_Check (Flag4-Sem)
-- Do_Overflow_Check (Flag17-Sem)
-- Float_Truncate (Flag11-Sem)
-- Rounded_Result (Flag18-Sem)
-- Do_Tag_Check (Flag13-Sem)
-- Conversion_OK (Flag14-Sem)
-- Do_Overflow_Check (Flag17-Sem)
-- Rounded_Result (Flag18-Sem)
-- plus fields for expression
-- Note: if a range check is required, then the Do_Range_Check flag
@ -4360,6 +4360,7 @@ package Sinfo is
-- Sloc points to :=
-- Name (Node2)
-- Expression (Node3)
-- Do_Discriminant_Check (Flag1-Sem)
-- Do_Tag_Check (Flag13-Sem)
-- Do_Length_Check (Flag4-Sem)
-- Forwards_OK (Flag5-Sem)
@ -8680,7 +8681,7 @@ package Sinfo is
(N : Node_Id) return Boolean; -- Flag13
function Do_Discriminant_Check
(N : Node_Id) return Boolean; -- Flag13
(N : Node_Id) return Boolean; -- Flag1
function Do_Division_Check
(N : Node_Id) return Boolean; -- Flag13
@ -9682,7 +9683,7 @@ package Sinfo is
(N : Node_Id; Val : Boolean := True); -- Flag13
procedure Set_Do_Discriminant_Check
(N : Node_Id; Val : Boolean := True); -- Flag13
(N : Node_Id; Val : Boolean := True); -- Flag1
procedure Set_Do_Division_Check
(N : Node_Id; Val : Boolean := True); -- Flag13

28
gcc/ada/treepr.adb
View file

@ -1184,10 +1184,9 @@ package body Treepr is
when F_Field5 =>
Field_To_Be_Printed := Field5 (N) /= Union_Id (Empty);
-- Flag3 is obsolete, so this probably gets removed ???
when F_Flag3 => Field_To_Be_Printed := Has_Aspects (N);
when F_Flag1 => Field_To_Be_Printed := Flag1 (N);
when F_Flag2 => Field_To_Be_Printed := Flag2 (N);
when F_Flag3 => Field_To_Be_Printed := Flag3 (N);
when F_Flag4 => Field_To_Be_Printed := Flag4 (N);
when F_Flag5 => Field_To_Be_Printed := Flag5 (N);
when F_Flag6 => Field_To_Be_Printed := Flag6 (N);
@ -1203,11 +1202,6 @@ package body Treepr is
when F_Flag16 => Field_To_Be_Printed := Flag16 (N);
when F_Flag17 => Field_To_Be_Printed := Flag17 (N);
when F_Flag18 => Field_To_Be_Printed := Flag18 (N);
-- Flag1,2 are no longer used
when F_Flag1 => raise Program_Error;
when F_Flag2 => raise Program_Error;
end case;
-- Print field if it is to be printed
@ -1233,14 +1227,15 @@ package body Treepr is
-- Special case End_Span = Uint5
when F_Field5 =>
if Nkind (N) = N_Case_Statement
or else Nkind (N) = N_If_Statement
then
if Nkind_In (N, N_Case_Statement, N_If_Statement) then
Print_End_Span (N);
else
Print_Field (Field5 (N), Fmt);
end if;
when F_Flag1 => Print_Flag (Flag1 (N));
when F_Flag2 => Print_Flag (Flag2 (N));
when F_Flag3 => Print_Flag (Flag3 (N));
when F_Flag4 => Print_Flag (Flag4 (N));
when F_Flag5 => Print_Flag (Flag5 (N));
when F_Flag6 => Print_Flag (Flag6 (N));
@ -1256,15 +1251,6 @@ package body Treepr is
when F_Flag16 => Print_Flag (Flag16 (N));
when F_Flag17 => Print_Flag (Flag17 (N));
when F_Flag18 => Print_Flag (Flag18 (N));
-- Flag1,2 are no longer used
when F_Flag1 => raise Program_Error;
when F_Flag2 => raise Program_Error;
-- Not clear why we need the following ???
when F_Flag3 => Print_Flag (Has_Aspects (N));
end case;
Print_Eol;

5
gcc/ada/treeprs.adt
View file

@ -6,7 +6,7 @@
-- --
-- T e m p l a t e --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -50,6 +50,9 @@ package Treeprs is
-- could never occur in a field name, so they also mark the end of the
-- previous name.
-- Note the following definitions do not include Flag0. This will have to
-- be addressed if we ever need to use Flag0 (it's not currently used).
subtype Fchar is Character range '#' .. '9';
F_Field1 : constant Fchar := '#'; -- Character'Val (16#23#)