[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

8 files changed, 259 insertions, 57 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 93bfb45..1502371 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 0d81606..8504579 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 e458475..56cf190 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 2839bf3..6297dc9 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 35e7d9e7..13d2833 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 73b00c2..78ff71b 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 82ef729..7baaca7 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 fd90b72..b4348c5 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