-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- DSA expansion associates stubs to distributed object types using
-- 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
-- to be associated with each remote subprogram names. These counters
-- are maintained in a hash table on name ids.
-- its constrained status.
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
-- of type Stub_Type or access to Stub_Type.
-- Find_Numeric_Representation --
---------------------------------
- function Find_Numeric_Representation (Typ : Entity_Id)
- return Entity_Id
+ function Find_Numeric_Representation
+ (Typ : Entity_Id) return Entity_Id
is
FST : constant Entity_Id := First_Subtype (Typ);
P_Size : constant Uint := Esize (FST);
Append_To (Indices,
Make_Identifier (Loc, New_External_Name ('L', Depth)));
- if Constrained then
- Inner_Any := Any;
- Inner_Counter := Counter;
- else
+ if not Constrained or else Depth > 1 then
Inner_Any := Make_Defining_Identifier (Loc,
- New_External_Name ('A', Depth));
+ New_External_Name ('A', Depth));
Set_Etype (Inner_Any, RTE (RE_Any));
+ else
+ Inner_Any := Empty;
+ end if;
- if Present (Counter) then
- Inner_Counter := Make_Defining_Identifier (Loc,
- New_External_Name ('J', Depth));
- else
- Inner_Counter := Empty;
- end if;
+ if Present (Counter) then
+ Inner_Counter := Make_Defining_Identifier (Loc,
+ New_External_Name ('J', Depth));
+ else
+ Inner_Counter := Empty;
end if;
- Append_Array_Traversal (Inner_Stmts,
- Any => Inner_Any,
- Counter => Inner_Counter,
- Depth => Depth + 1);
+ declare
+ Loop_Any : Node_Id := Inner_Any;
+ begin
+
+ -- 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 :=
Make_Implicit_Loop_Statement (Subprogram,
Make_Integer_Literal (Loc, Depth))))),
Statements => Inner_Stmts);
- if Constrained then
- Append_To (Stmts, Loop_Stm);
- return;
- end if;
-
declare
Decls : constant List_Id := New_List;
Dimen_Stmts : constant List_Id := New_List;
begin
if Depth = 1 then
- 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)));
+ if Constrained then
+ Inner_Any_TypeCode_Expr :=
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Get_TC), Loc),
+ Parameter_Associations => New_List (
+ 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
Inner_Any_TypeCode_Expr :=
Make_Function_Call (Loc,
Object_Definition => New_Occurrence_Of (
RTE (RE_TypeCode), Loc),
Expression => Inner_Any_TypeCode_Expr));
- Append_To (Decls,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Inner_Any,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Any), Loc),
- Expression =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (
- RTE (RE_Create_Any), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Inner_Any_TypeCode, Loc)))));
+
+ if Present (Inner_Any) then
+ Append_To (Decls,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Inner_Any,
+ Object_Definition =>
+ New_Occurrence_Of (RTE (RE_Any), Loc),
+ Expression =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (
+ RTE (RE_Create_Any), Loc),
+ Parameter_Associations => New_List (
+ New_Occurrence_Of (Inner_Any_TypeCode, Loc)))));
+ end if;
if Present (Inner_Counter) then
Append_To (Decls,
Make_Integer_Literal (Loc, 0)));
end if;
- Length_Node := Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Arry, Loc),
- Attribute_Name => Name_Length,
- Expressions =>
- New_List (Make_Integer_Literal (Loc, Depth)));
- Set_Etype (Length_Node, RTE (RE_Long_Unsigned));
-
- Add_Process_Element (Dimen_Stmts,
- Datum => Length_Node,
- Any => Inner_Any,
- Counter => Inner_Counter);
+ if not Constrained then
+ Length_Node := Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Arry, Loc),
+ Attribute_Name => Name_Length,
+ Expressions =>
+ New_List (Make_Integer_Literal (Loc, Depth)));
+ Set_Etype (Length_Node, RTE (RE_Long_Unsigned));
+
+ Add_Process_Element (Dimen_Stmts,
+ Datum => Length_Node,
+ Any => Inner_Any,
+ Counter => Inner_Counter);
+ end if;
-- Loop_Stm does approrpriate processing for each element
-- of Inner_Any.
-- Link outer and inner any
- Add_Process_Element (Dimen_Stmts,
- Any => Any,
- Counter => Counter,
- Datum => New_Occurrence_Of (Inner_Any, Loc));
+ if Present (Inner_Any) then
+ Add_Process_Element (Dimen_Stmts,
+ Any => Any,
+ Counter => Counter,
+ Datum => New_Occurrence_Of (Inner_Any, Loc));
+ end if;
Append_To (Stmts,
Make_Block_Statement (Loc,
-------------------
function Scope_Of_Spec (Spec : Node_Id) return Entity_Id is
- Unit_Name : Node_Id := Defining_Unit_Name (Spec);
+ Unit_Name : Node_Id;
begin
+ Unit_Name := Defining_Unit_Name (Spec);
while Nkind (Unit_Name) /= N_Defining_Identifier loop
Unit_Name := Defining_Identifier (Unit_Name);
end loop;
(Loc : Source_Ptr;
Decls : List_Id;
RCI_Locator : Entity_Id;
- Controlling_Parameter : Entity_Id) return RPC_Target is
+ Controlling_Parameter : Entity_Id) return RPC_Target
+ is
begin
case Get_PCS_Name is
when Name_PolyORB_DSA =>
Dynamically_Asynchronous : Boolean := False;
Stub_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
case Get_PCS_Name is
when Name_PolyORB_DSA =>
projects / thirdparty / gcc.git / commitdiff
