+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.
-- 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 --
------------------
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)
-- 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
-- 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
-- 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
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 --
---------------------
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;
projects / thirdparty / gcc.git / commitdiff
