git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2012-08-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Process_Transient_Objects): Remove obsolete loop
	processing related to array initialization. The expansion of
	loops already contains a mechanism to detect controlled objects
	generated by expansion and introduce a block around the loop
	statements for finalization purposes.

2012-08-06  Vincent Pucci  <pucci@adacore.com>

	* sem_ch13.adb: Current scope must be within
	or same as the scope of the entity while analysing aspect
	specifications at freeze point.

2012-08-06  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb: Add note about dubious SCO for TERMINATE
	alternative.
	* sem_ch8.adb, exp_ch11.adb: Minor reformatting.

2012-08-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Two_Dim_Packed_Array_Handled): New procedure to
	transform an aggregate for a packed two-dimensional array into
	a one-dimensional array of constant values, in order to avoid
	the generation of component-by-component assignments.

2012-08-06  Thomas Quinot  <quinot@adacore.com>

	* frontend.adb: Do not attempt to process deferred configuration
	pragmas if the main unit failed to load, to avoid cascaded
	inconsistencies that can lead to a compiler crash.

From-SVN: r190161
This commit is contained in:
Arnaud Charlet 2012-08-06 09:58:49 +02:00
parent b5ee491c7b
commit 5eeeed5e1a
8 changed files with 259 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
gcc/ada/ChangeLog
View File

@ -1,3 +1,36 @@
2012-08-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Process_Transient_Objects): Remove obsolete loop
processing related to array initialization. The expansion of
loops already contains a mechanism to detect controlled objects
generated by expansion and introduce a block around the loop
statements for finalization purposes.
2012-08-06 Vincent Pucci <pucci@adacore.com>
* sem_ch13.adb: Current scope must be within
or same as the scope of the entity while analysing aspect
specifications at freeze point.
2012-08-06 Thomas Quinot <quinot@adacore.com>
* par_sco.adb: Add note about dubious SCO for TERMINATE
alternative.
* sem_ch8.adb, exp_ch11.adb: Minor reformatting.
2012-08-06 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Two_Dim_Packed_Array_Handled): New procedure to
transform an aggregate for a packed two-dimensional array into
a one-dimensional array of constant values, in order to avoid
the generation of component-by-component assignments.
2012-08-06 Thomas Quinot <quinot@adacore.com>
* frontend.adb: Do not attempt to process deferred configuration
pragmas if the main unit failed to load, to avoid cascaded
inconsistencies that can lead to a compiler crash.
2012-08-06 Vincent Pucci <pucci@adacore.com>
* s-atopri.adb: Minor reformatting.

212
gcc/ada/exp_aggr.adb
View File

@ -275,6 +275,13 @@ package body Exp_Aggr is
-- the assignment can be done in place even if bounds are not static,
-- by converting it into a loop over the discrete range of the slice.
function Two_Dim_Packed_Array_Handled (N : Node_Id) return Boolean;
-- If the type of the aggregate is a two-dimensional bit_packed array
-- it may be transformed into an array of bytes with constant values,
-- and presented to the back-end as a static value. The function returns
-- false if this transformation cannot be performed. THis is similar to,
-- and reuses part of the machinery in Packed_Array_Aggregate_Handled.
------------------
-- Aggr_Size_OK --
------------------
@ -4781,8 +4788,9 @@ package body Exp_Aggr is
if Nkind (N) /= N_Aggregate then
return;
-- We are also done if the result is an analyzed aggregate
-- This case could use more comments ???
-- We are also done if the result is an analyzed aggregate, indicating
-- that Convert_To_Positional succeeded and reanalyzed the rewritten
-- aggregate.
elsif Analyzed (N)
and then N /= Original_Node (N)
@ -5968,7 +5976,7 @@ package body Exp_Aggr is
-- The current version of this procedure will handle at compile time
-- any array aggregate that meets these conditions:
-- One dimensional, bit packed
-- One and two dimensional, bit packed
-- Underlying packed type is modular type
-- Bounds are within 32-bit Int range
-- All bounds and values are static
@ -5982,15 +5990,26 @@ package body Exp_Aggr is
-- Exception raised if this aggregate cannot be handled
begin
-- For now, handle only one dimensional bit packed arrays
-- Handle one- or two dimensional bit packed array
if not Is_Bit_Packed_Array (Typ)
or else Number_Dimensions (Typ) > 1
or else not Is_Modular_Integer_Type (Packed_Array_Type (Typ))
or else Number_Dimensions (Typ) > 2
then
return False;
end if;
-- If two-dimensional, check whether it can be folded, and transformed
-- into a one-dimensional aggregate for the Packed_Array_Type of the
-- original type.
if Number_Dimensions (Typ) = 2 then
return Two_Dim_Packed_Array_Handled (N);
end if;
if not Is_Modular_Integer_Type (Packed_Array_Type (Typ)) then
return False;
end if;
if not Is_Scalar_Type (Component_Type (Typ))
and then Has_Non_Standard_Rep (Component_Type (Typ))
then
@ -6084,8 +6103,9 @@ package body Exp_Aggr is
-- If the aggregate is not fully positional at this stage, then
-- convert it to positional form. Either this will fail, in which
-- case we can do nothing, or it will succeed, in which case we have
-- succeeded in handling the aggregate, or it will stay an aggregate,
-- in which case we have failed to handle this case.
-- succeeded in handling the aggregate and transforming it into a
-- modular value, or it will stay an aggregate, in which case we
-- have failed to create a packed value for it.
if Present (Component_Associations (N)) then
Convert_To_Positional
@ -6351,6 +6371,182 @@ package body Exp_Aggr is
end if;
end Safe_Slice_Assignment;
----------------------------------
-- Two_Dim_Packed_Array_Handled --
----------------------------------
function Two_Dim_Packed_Array_Handled (N : Node_Id) return Boolean is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
Ctyp : constant Entity_Id := Component_Type (Typ);
Comp_Size : constant Int := UI_To_Int (Component_Size (Typ));
Packed_Array : constant Entity_Id := Packed_Array_Type (Base_Type (Typ));
One_Comp : Node_Id;
-- Expression in original aggregate
One_Dim : Node_Id;
-- one-dimensional subaggregate
begin
-- For now, only deal with tight packing. The boolean case is the
-- most common.
if Comp_Size = 1
or else Comp_Size = 2
or else Comp_Size = 4
then
null;
else
return False;
end if;
Convert_To_Positional
(N, Max_Others_Replicate => 64, Handle_Bit_Packed => True);
-- Verify that all components are static.
if Nkind (N) = N_Aggregate
and then Compile_Time_Known_Aggregate (N)
then
null;
-- The aggregate may have been re-analyzed and converted already.
elsif Nkind (N) /= N_Aggregate then
return True;
-- If component associations remain, the aggregate is not static.
elsif Present (Component_Associations (N)) then
return False;
else
One_Dim := First (Expressions (N));
while Present (One_Dim) loop
if Present (Component_Associations (One_Dim)) then
return False;
end if;
One_Comp := First (Expressions (One_Dim));
while Present (One_Comp) loop
if not Is_OK_Static_Expression (One_Comp) then
return False;
end if;
Next (One_Comp);
end loop;
Next (One_Dim);
end loop;
end if;
-- Two-dimensional aggregate is now fully positional so pack one
-- dimension to create a static one-dimensional array, and rewrite
-- as an unchecked conversion to the original type.
declare
Byte_Size : constant Int := UI_To_Int (Component_Size (Packed_Array));
-- The packed array type is a byte array
Packed_Num : Int;
-- Number of components accumulated in current byte
Comps : List_Id;
-- Assembled list of packed values for equivalent aggregate
Comp_Val : Uint;
-- integer value of component
Incr : Int;
-- Step size for packing
Init_Shift : Int;
-- endian-dependent start position for packing
Shift : Int;
-- current insertion position
Val : Int;
-- component of packed array being assembled.
begin
Comps := New_List;
Val := 0;
Packed_Num := 0;
-- Account for endianness. See corresponding comment in
-- Packed_Array_Aggregate_Handled concerning the following.
if Bytes_Big_Endian
xor Debug_Flag_8
xor Reverse_Storage_Order (Base_Type (Typ))
then
Init_Shift := Byte_Size - Comp_Size;
Incr := -Comp_Size;
else
Init_Shift := 0;
Incr := +Comp_Size;
end if;
Shift := Init_Shift;
One_Dim := First (Expressions (N));
-- Iterate over each subaggregate
while Present (One_Dim) loop
One_Comp := First (Expressions (One_Dim));
while Present (One_Comp) loop
if Packed_Num = Byte_Size / Comp_Size then
-- Byte is complete, add to list of expressions
Append (Make_Integer_Literal (Sloc (One_Dim), Val), Comps);
Val := 0;
Shift := Init_Shift;
Packed_Num := 0;
else
Comp_Val := Expr_Rep_Value (One_Comp);
-- Adjust for bias, and strip proper number of bits
if Has_Biased_Representation (Ctyp) then
Comp_Val := Comp_Val - Expr_Value (Type_Low_Bound (Ctyp));
end if;
Comp_Val := Comp_Val mod Uint_2 ** Comp_Size;
Val := UI_To_Int (Val + Comp_Val * Uint_2 ** Shift);
Shift := Shift + Incr;
One_Comp := Next (One_Comp);
Packed_Num := Packed_Num + 1;
end if;
end loop;
One_Dim := Next (One_Dim);
end loop;
if Packed_Num > 0 then
-- Add final incomplete byte if present.
Append (Make_Integer_Literal (Sloc (One_Dim), Val), Comps);
end if;
Rewrite (N,
Unchecked_Convert_To (Typ,
Make_Qualified_Expression (Loc,
Subtype_Mark => New_Occurrence_Of (Packed_Array, Loc),
Expression =>
Make_Aggregate (Loc, Expressions => Comps))));
Analyze_And_Resolve (N);
return True;
end;
end Two_Dim_Packed_Array_Handled;
---------------------
-- Sort_Case_Table --
---------------------

42
gcc/ada/exp_ch7.adb
View File

@ -4585,48 +4585,12 @@ package body Exp_Ch7 is
end if;
Prev_Fin := Fin_Block;
-- When the associated node is an array object, the expander may
-- sometimes generate a loop and create transient objects inside
-- the loop.
elsif Nkind (Related_Node) = N_Object_Declaration
and then Is_Array_Type
(Base_Type
(Etype (Defining_Identifier (Related_Node))))
and then Nkind (Stmt) = N_Loop_Statement
then
declare
Block_HSS : Node_Id := First (Statements (Stmt));
begin
-- The loop statements may have been wrapped in a block by
-- Process_Statements_For_Controlled_Objects, inspect the
-- handled sequence of statements.
if Nkind (Block_HSS) = N_Block_Statement
and then No (Next (Block_HSS))
then
Block_HSS := Handled_Statement_Sequence (Block_HSS);
Process_Transient_Objects
(First_Object => First (Statements (Block_HSS)),
Last_Object => Last (Statements (Block_HSS)),
Related_Node => Related_Node);
-- Inspect the statements of the loop
else
Process_Transient_Objects
(First_Object => First (Statements (Stmt)),
Last_Object => Last (Statements (Stmt)),
Related_Node => Related_Node);
end if;
end;
-- Terminate the scan after the last object has been processed
-- Terminate the scan after the last object has been processed to
-- avoid touching unrelated code.
elsif Stmt = Last_Object then
if Stmt = Last_Object then
exit;
end if;

3
gcc/ada/frontend.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -282,6 +282,7 @@ begin
-- a context for their semantic processing.
if Config_Pragmas /= Error_List
and then not Fatal_Error (Main_Unit)
and then Operating_Mode /= Check_Syntax
then
-- Pragmas that require some semantic activity, such as

6
gcc/ada/par_sco.adb
View File

@ -1556,6 +1556,12 @@ package body Par_SCO is
P => Triggering_Statement (N));
when N_Terminate_Alternative =>
-- It is dubious to emit a statement SCO for a TERMINATE
-- alternative, since no code is actually executed if the
-- alternative is selected -- the tasking runtime call just
-- never returns???
Extend_Statement_Sequence (N, ' ');
Set_Statement_Entry;

14
gcc/ada/sem_ch13.adb
View File

@ -856,10 +856,11 @@ package body Sem_Ch13 is
-- Start of processing for Analyze_Aspects_At_Freeze_Point
begin
-- Must be declared in current scope. This is need for a generic
-- context.
-- Must be visible in current scope. Note that this is needed for
-- entities that creates their own scope such as protected objects,
-- tasks, etc.
if Scope (E) /= Current_Scope then
if not Scope_Within_Or_Same (Current_Scope, Scope (E)) then
return;
end if;
@ -2434,11 +2435,12 @@ package body Sem_Ch13 is
return;
-- Must be declared in current scope or in case of an aspect
-- specification, must be the current scope.
-- specification, must be visible in current scope.
elsif Scope (Ent) /= Current_Scope
and then (not From_Aspect_Specification (N)
or else Ent /= Current_Scope)
and then
not (From_Aspect_Specification (N)
and then Scope_Within_Or_Same (Current_Scope, Scope (Ent)))
then
Error_Msg_N ("entity must be declared in this scope", Nam);
return;

2
gcc/ada/sem_ch8.adb
View File

@ -7223,7 +7223,7 @@ package body Sem_Ch8 is
-- If the actions to be wrapped are still there they will get lost
-- causing incomplete code to be generated. It is better to abort in
-- this case (and we do the abort even with assertions off since the
-- penalty is incorrect code generation)
-- penalty is incorrect code generation).
if SST.Actions_To_Be_Wrapped_Before /= No_List
or else