Skip to content

R
riscv-gcc-1
Commit 6ce0c3f5 by Thomas Quinot Committed by Arnaud Charlet
Options

exp_dist.adb (Append_Array_Traversal): Modify constrained case to generate a set… 

exp_dist.adb (Append_Array_Traversal): Modify constrained case to generate a set of nested array aggregates instead of...

2005-11-14  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (Append_Array_Traversal): Modify constrained case to
	generate a set of nested array aggregates instead of a single flat
	aggregate for multi-dimensional arrays.

From-SVN: r106973
parent ed789fe9
Showing with 89 additions and 62 deletions
gcc/ada/exp_dist.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -97,7 +97,7 @@ package body Exp_Dist is ...@@ -97,7 +97,7 @@ package body Exp_Dist is
-- DSA expansion associates stubs to distributed object types using -- DSA expansion associates stubs to distributed object types using
-- a hash table on entity ids. -- a hash table on entity ids.
function Hash (F : Name_Id) return Hash_Index; function Hash (F : Name_Id) return Hash_Index;
-- The generation of subprogram identifiers requires an overload counter -- The generation of subprogram identifiers requires an overload counter
-- to be associated with each remote subprogram names. These counters -- to be associated with each remote subprogram names. These counters
-- are maintained in a hash table on name ids. -- are maintained in a hash table on name ids.
...@@ -270,7 +270,8 @@ package body Exp_Dist is ...@@ -270,7 +270,8 @@ package body Exp_Dist is
-- its constrained status. -- its constrained status.
function Is_RACW_Controlling_Formal function Is_RACW_Controlling_Formal
(Parameter : Node_Id; Stub_Type : Entity_Id) return Boolean; (Parameter : Node_Id;
Stub_Type : Entity_Id) return Boolean;
-- Return True if the current parameter is a controlling formal argument -- Return True if the current parameter is a controlling formal argument
-- of type Stub_Type or access to Stub_Type. -- of type Stub_Type or access to Stub_Type.
...@@ -10177,8 +10178,8 @@ package body Exp_Dist is ...@@ -10177,8 +10178,8 @@ package body Exp_Dist is
-- Find_Numeric_Representation -- -- Find_Numeric_Representation --
--------------------------------- ---------------------------------
function Find_Numeric_Representation (Typ : Entity_Id) function Find_Numeric_Representation
return Entity_Id (Typ : Entity_Id) return Entity_Id
is is
FST : constant Entity_Id := First_Subtype (Typ); FST : constant Entity_Id := First_Subtype (Typ);
P_Size : constant Uint := Esize (FST); P_Size : constant Uint := Esize (FST);
...@@ -10286,26 +10287,38 @@ package body Exp_Dist is ...@@ -10286,26 +10287,38 @@ package body Exp_Dist is
Append_To (Indices, Append_To (Indices,
Make_Identifier (Loc, New_External_Name ('L', Depth))); Make_Identifier (Loc, New_External_Name ('L', Depth)));
if Constrained then if not Constrained or else Depth > 1 then
Inner_Any := Any;
Inner_Counter := Counter;
else
Inner_Any := Make_Defining_Identifier (Loc, Inner_Any := Make_Defining_Identifier (Loc,
New_External_Name ('A', Depth)); New_External_Name ('A', Depth));
Set_Etype (Inner_Any, RTE (RE_Any)); Set_Etype (Inner_Any, RTE (RE_Any));
else
Inner_Any := Empty;
end if;
if Present (Counter) then if Present (Counter) then
Inner_Counter := Make_Defining_Identifier (Loc, Inner_Counter := Make_Defining_Identifier (Loc,
New_External_Name ('J', Depth)); New_External_Name ('J', Depth));
else else
Inner_Counter := Empty; Inner_Counter := Empty;
end if;
end if; end if;
Append_Array_Traversal (Inner_Stmts, declare
Any => Inner_Any, Loop_Any : Node_Id := Inner_Any;
Counter => Inner_Counter, begin
Depth => Depth + 1);
-- For the first dimension of a constrained array, we add
-- elements directly in the corresponding Any; there is no
-- intervening inner Any.
if No (Loop_Any) then
Loop_Any := Any;
end if;
Append_Array_Traversal (Inner_Stmts,
Any => Loop_Any,
Counter => Inner_Counter,
Depth => Depth + 1);
end;
Loop_Stm := Loop_Stm :=
Make_Implicit_Loop_Statement (Subprogram, Make_Implicit_Loop_Statement (Subprogram,
...@@ -10326,11 +10339,6 @@ package body Exp_Dist is ...@@ -10326,11 +10339,6 @@ package body Exp_Dist is
Make_Integer_Literal (Loc, Depth))))), Make_Integer_Literal (Loc, Depth))))),
Statements => Inner_Stmts); Statements => Inner_Stmts);
if Constrained then
Append_To (Stmts, Loop_Stm);
return;
end if;
declare declare
Decls : constant List_Id := New_List; Decls : constant List_Id := New_List;
Dimen_Stmts : constant List_Id := New_List; Dimen_Stmts : constant List_Id := New_List;
...@@ -10344,13 +10352,22 @@ package body Exp_Dist is ...@@ -10344,13 +10352,22 @@ package body Exp_Dist is
begin begin
if Depth = 1 then if Depth = 1 then
Inner_Any_TypeCode_Expr := if Constrained then
Make_Function_Call (Loc, Inner_Any_TypeCode_Expr :=
Name => Make_Function_Call (Loc,
New_Occurrence_Of (RTE (RE_Any_Member_Type), Loc), Name =>
Parameter_Associations => New_List ( New_Occurrence_Of (RTE (RE_Get_TC), Loc),
New_Occurrence_Of (Any, Loc), Parameter_Associations => New_List (
Make_Integer_Literal (Loc, Ndim))); New_Occurrence_Of (Any, Loc)));
else
Inner_Any_TypeCode_Expr :=
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Any_Member_Type), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc),
Make_Integer_Literal (Loc, Ndim)));
end if;
else else
Inner_Any_TypeCode_Expr := Inner_Any_TypeCode_Expr :=
Make_Function_Call (Loc, Make_Function_Call (Loc,
...@@ -10368,18 +10385,21 @@ package body Exp_Dist is ...@@ -10368,18 +10385,21 @@ package body Exp_Dist is
Object_Definition => New_Occurrence_Of ( Object_Definition => New_Occurrence_Of (
RTE (RE_TypeCode), Loc), RTE (RE_TypeCode), Loc),
Expression => Inner_Any_TypeCode_Expr)); Expression => Inner_Any_TypeCode_Expr));
Append_To (Decls,
Make_Object_Declaration (Loc, if Present (Inner_Any) then
Defining_Identifier => Inner_Any, Append_To (Decls,
Object_Definition => Make_Object_Declaration (Loc,
New_Occurrence_Of (RTE (RE_Any), Loc), Defining_Identifier => Inner_Any,
Expression => Object_Definition =>
Make_Function_Call (Loc, New_Occurrence_Of (RTE (RE_Any), Loc),
Name => Expression =>
New_Occurrence_Of ( Make_Function_Call (Loc,
RTE (RE_Create_Any), Loc), Name =>
Parameter_Associations => New_List ( New_Occurrence_Of (
New_Occurrence_Of (Inner_Any_TypeCode, Loc))))); RTE (RE_Create_Any), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Inner_Any_TypeCode, Loc)))));
end if;
if Present (Inner_Counter) then if Present (Inner_Counter) then
Append_To (Decls, Append_To (Decls,
...@@ -10391,17 +10411,19 @@ package body Exp_Dist is ...@@ -10391,17 +10411,19 @@ package body Exp_Dist is
Make_Integer_Literal (Loc, 0))); Make_Integer_Literal (Loc, 0)));
end if; end if;
Length_Node := Make_Attribute_Reference (Loc, if not Constrained then
Prefix => New_Occurrence_Of (Arry, Loc), Length_Node := Make_Attribute_Reference (Loc,
Attribute_Name => Name_Length, Prefix => New_Occurrence_Of (Arry, Loc),
Expressions => Attribute_Name => Name_Length,
New_List (Make_Integer_Literal (Loc, Depth))); Expressions =>
Set_Etype (Length_Node, RTE (RE_Long_Unsigned)); New_List (Make_Integer_Literal (Loc, Depth)));
Set_Etype (Length_Node, RTE (RE_Long_Unsigned));
Add_Process_Element (Dimen_Stmts,
Datum => Length_Node, Add_Process_Element (Dimen_Stmts,
Any => Inner_Any, Datum => Length_Node,
Counter => Inner_Counter); Any => Inner_Any,
Counter => Inner_Counter);
end if;
-- Loop_Stm does approrpriate processing for each element -- Loop_Stm does approrpriate processing for each element
-- of Inner_Any. -- of Inner_Any.
...@@ -10410,10 +10432,12 @@ package body Exp_Dist is ...@@ -10410,10 +10432,12 @@ package body Exp_Dist is
-- Link outer and inner any -- Link outer and inner any
Add_Process_Element (Dimen_Stmts, if Present (Inner_Any) then
Any => Any, Add_Process_Element (Dimen_Stmts,
Counter => Counter, Any => Any,
Datum => New_Occurrence_Of (Inner_Any, Loc)); Counter => Counter,
Datum => New_Occurrence_Of (Inner_Any, Loc));
end if;
Append_To (Stmts, Append_To (Stmts,
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
...@@ -10532,9 +10556,10 @@ package body Exp_Dist is ...@@ -10532,9 +10556,10 @@ package body Exp_Dist is
------------------- -------------------
function Scope_Of_Spec (Spec : Node_Id) return Entity_Id is function Scope_Of_Spec (Spec : Node_Id) return Entity_Id is
Unit_Name : Node_Id := Defining_Unit_Name (Spec); Unit_Name : Node_Id;
begin begin
Unit_Name := Defining_Unit_Name (Spec);
while Nkind (Unit_Name) /= N_Defining_Identifier loop while Nkind (Unit_Name) /= N_Defining_Identifier loop
Unit_Name := Defining_Identifier (Unit_Name); Unit_Name := Defining_Identifier (Unit_Name);
end loop; end loop;
...@@ -10757,7 +10782,8 @@ package body Exp_Dist is ...@@ -10757,7 +10782,8 @@ package body Exp_Dist is
(Loc : Source_Ptr; (Loc : Source_Ptr;
Decls : List_Id; Decls : List_Id;
RCI_Locator : Entity_Id; RCI_Locator : Entity_Id;
Controlling_Parameter : Entity_Id) return RPC_Target is Controlling_Parameter : Entity_Id) return RPC_Target
is
begin begin
case Get_PCS_Name is case Get_PCS_Name is
when Name_PolyORB_DSA => when Name_PolyORB_DSA =>
...@@ -10798,7 +10824,8 @@ package body Exp_Dist is ...@@ -10798,7 +10824,8 @@ package body Exp_Dist is
Dynamically_Asynchronous : Boolean := False; Dynamically_Asynchronous : Boolean := False;
Stub_Type : Entity_Id := Empty; Stub_Type : Entity_Id := Empty;
RACW_Type : Entity_Id := Empty; RACW_Type : Entity_Id := Empty;
Parent_Primitive : Entity_Id := Empty) return Node_Id is Parent_Primitive : Entity_Id := Empty) return Node_Id
is
begin begin
case Get_PCS_Name is case Get_PCS_Name is
when Name_PolyORB_DSA => when Name_PolyORB_DSA =>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment