From 5eeeed5e1a9ee8ea9fbff247c9cc6fd093fa5dcd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 6 Aug 2012 09:58:49 +0200 Subject: [PATCH] [multiple changes] 2012-08-06 Hristian Kirtchev * 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 * 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 * par_sco.adb: Add note about dubious SCO for TERMINATE alternative. * sem_ch8.adb, exp_ch11.adb: Minor reformatting. 2012-08-06 Ed Schonberg * 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 * 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 --- gcc/ada/ChangeLog | 33 +++++++ gcc/ada/exp_aggr.adb | 212 +++++++++++++++++++++++++++++++++++++++++-- gcc/ada/exp_ch11.adb | 2 +- gcc/ada/exp_ch7.adb | 44 +-------- gcc/ada/frontend.adb | 3 +- gcc/ada/par_sco.adb | 6 ++ gcc/ada/sem_ch13.adb | 14 +-- gcc/ada/sem_ch8.adb | 2 +- 8 files changed, 259 insertions(+), 57 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 93bfb45aa4d7..1502371eef3a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,36 @@ +2012-08-06 Hristian Kirtchev + + * 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 + + * 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 + + * par_sco.adb: Add note about dubious SCO for TERMINATE + alternative. + * sem_ch8.adb, exp_ch11.adb: Minor reformatting. + +2012-08-06 Ed Schonberg + + * 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 + + * 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 * s-atopri.adb: Minor reformatting. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 0d816066237b..850457956e06 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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 -- --------------------- diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index e4584753feca..56cf190e2a85 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1916,7 +1916,7 @@ package body Exp_Ch11 is begin if LCN = Statements (P) or else - LCN = SSE.Actions_To_Be_Wrapped_Before + LCN = SSE.Actions_To_Be_Wrapped_Before or else LCN = SSE.Actions_To_Be_Wrapped_After then diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 2839bf39e569..6297dc99ccd4 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4585,48 +4585,12 @@ package body Exp_Ch7 is end if; Prev_Fin := Fin_Block; + end if; - -- 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; diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 35e7d9e769b0..13d283373d18 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -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 diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 73b00c24ee9b..78ff71bfd3bf 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 82ef7298ffa7..7baaca7cb167 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index fd90b72d6362..b4348c5bdbed 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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 -- 2.39.5