[multiple changes]
2009-06-20 Ed Schonberg <schonberg@adacore.com> * sem.adb (Walk_Library_Units): Check instantiations first. * sem_ch6.adb (Analyze_Subprogram_Declaration): Mark a subprogram as a private primitive if it is a function with a controlling result that is a type extension with progenitors. * exp_ch9.adb (Build_Wrapper_Spec, Build_Wrapper_Body): Handle properly a primitive operation of a synchronized tagged type that has a controlling result. 2009-06-20 Thomas Quinot <quinot@adacore.com> * einfo.ads: Fix typo. 2009-06-20 Ed Falis <falis@adacore.com> * s-vxwext.ads, s-vxwext-kernel.adb: Complete previous change. From-SVN: r148743
This commit is contained in:
Arnaud Charlet
parent
b14e938878
commit
6ca063eb44
|
|
@ -1,3 +1,23 @@
|
|||
2009-06-20 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem.adb (Walk_Library_Units): Check instantiations first.
|
||||
|
||||
* sem_ch6.adb (Analyze_Subprogram_Declaration): Mark a subprogram as a
|
||||
private primitive if it is a function with a controlling result that is
|
||||
a type extension with progenitors.
|
||||
|
||||
* exp_ch9.adb (Build_Wrapper_Spec, Build_Wrapper_Body): Handle properly
|
||||
a primitive operation of a synchronized tagged type that has a
|
||||
controlling result.
|
||||
|
||||
2009-06-20 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* einfo.ads: Fix typo.
|
||||
|
||||
2009-06-20 Ed Falis <falis@adacore.com>
|
||||
|
||||
* s-vxwext.ads, s-vxwext-kernel.adb: Complete previous change.
|
||||
|
||||
2009-06-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/trans.c (emit_check): Do not wrap up the result
|
||||
|
|
|
|||
|
|
@ -3647,7 +3647,7 @@ package Einfo is
|
|||
|
||||
-- Wrapped_Entity (Node27)
|
||||
-- Present in functions and procedures which have been classified as
|
||||
-- Is_Primitive_Wrapper. Set to the entity being wrapper.
|
||||
-- Is_Primitive_Wrapper. Set to the entity being wrapped.
|
||||
|
||||
------------------
|
||||
-- Access Kinds --
|
||||
|
|
|
|||
|
|
@ -1611,7 +1611,7 @@ package body Exp_Ch9 is
|
|||
declare
|
||||
Actuals : List_Id := No_List;
|
||||
Conv_Id : Node_Id;
|
||||
First_Formal : Node_Id;
|
||||
First_Form : Node_Id;
|
||||
Formal : Node_Id;
|
||||
Nam : Node_Id;
|
||||
|
||||
|
|
@ -1619,9 +1619,9 @@ package body Exp_Ch9 is
|
|||
-- Map formals to actuals. Use the list built for the wrapper
|
||||
-- spec, skipping the object notation parameter.
|
||||
|
||||
First_Formal := First (Parameter_Specifications (Body_Spec));
|
||||
First_Form := First (Parameter_Specifications (Body_Spec));
|
||||
|
||||
Formal := First_Formal;
|
||||
Formal := First_Form;
|
||||
Next (Formal);
|
||||
|
||||
if Present (Formal) then
|
||||
|
|
@ -1637,20 +1637,29 @@ package body Exp_Ch9 is
|
|||
end if;
|
||||
|
||||
-- Special processing for primitives declared between a private
|
||||
-- type and its completion.
|
||||
-- type and its completion: the wrapper needs a properly typed
|
||||
-- parameter if the wrapped operation has a controlling first
|
||||
-- parameter. Note that this might not be the case for a function
|
||||
-- with a controlling result.
|
||||
|
||||
if Is_Private_Primitive_Subprogram (Subp_Id) then
|
||||
if No (Actuals) then
|
||||
Actuals := New_List;
|
||||
end if;
|
||||
|
||||
Prepend_To (Actuals,
|
||||
Unchecked_Convert_To (
|
||||
Corresponding_Concurrent_Type (Obj_Typ),
|
||||
Make_Identifier (Loc, Name_uO)));
|
||||
if Is_Controlling_Formal (First_Formal (Subp_Id)) then
|
||||
Prepend_To (Actuals,
|
||||
Unchecked_Convert_To (
|
||||
Corresponding_Concurrent_Type (Obj_Typ),
|
||||
Make_Identifier (Loc, Name_uO)));
|
||||
|
||||
else
|
||||
Prepend_To (Actuals,
|
||||
Make_Identifier (Loc, Chars =>
|
||||
Chars (Defining_Identifier (First_Form))));
|
||||
end if;
|
||||
|
||||
Nam := New_Reference_To (Subp_Id, Loc);
|
||||
|
||||
else
|
||||
-- An access-to-variable object parameter requires an explicit
|
||||
-- dereference in the unchecked conversion. This case occurs
|
||||
|
|
@ -1659,7 +1668,7 @@ package body Exp_Ch9 is
|
|||
|
||||
-- O.all.Subp_Id (Formal_1, ..., Formal_N)
|
||||
|
||||
if Nkind (Parameter_Type (First_Formal)) =
|
||||
if Nkind (Parameter_Type (First_Form)) =
|
||||
N_Access_Definition
|
||||
then
|
||||
Conv_Id :=
|
||||
|
|
@ -1679,20 +1688,35 @@ package body Exp_Ch9 is
|
|||
New_Reference_To (Subp_Id, Loc));
|
||||
end if;
|
||||
|
||||
-- Create the subprogram body
|
||||
-- Create the subprogram body. For a function, the call to the
|
||||
-- actual subprogram has to be converted to the corresponding
|
||||
-- record if it is a controlling result.
|
||||
|
||||
if Ekind (Subp_Id) = E_Function then
|
||||
return
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification => Body_Spec,
|
||||
Declarations => Empty_List,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
Make_Simple_Return_Statement (Loc,
|
||||
Make_Function_Call (Loc,
|
||||
Name => Nam,
|
||||
Parameter_Associations => Actuals)))));
|
||||
declare
|
||||
Res : Node_Id;
|
||||
|
||||
begin
|
||||
Res :=
|
||||
Make_Function_Call (Loc,
|
||||
Name => Nam,
|
||||
Parameter_Associations => Actuals);
|
||||
|
||||
if Has_Controlling_Result (Subp_Id) then
|
||||
Res :=
|
||||
Unchecked_Convert_To
|
||||
(Corresponding_Record_Type (Etype (Subp_Id)), Res);
|
||||
end if;
|
||||
|
||||
return
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification => Body_Spec,
|
||||
Declarations => Empty_List,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => New_List (
|
||||
Make_Simple_Return_Statement (Loc, Res))));
|
||||
end;
|
||||
|
||||
else
|
||||
return
|
||||
|
|
@ -1819,7 +1843,8 @@ package body Exp_Ch9 is
|
|||
-- Determine whether the parameters of the generated entry wrapper
|
||||
-- and those of a primitive operation are type conformant. During
|
||||
-- this check, the first parameter of the primitive operation is
|
||||
-- always skipped.
|
||||
-- skipped if it is a controlling argument: protected functions
|
||||
-- may have a controlling result.
|
||||
|
||||
--------------------------------
|
||||
-- Type_Conformant_Parameters --
|
||||
|
|
@ -1835,9 +1860,16 @@ package body Exp_Ch9 is
|
|||
Wrapper_Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Skip the first parameter of the primitive operation
|
||||
-- Skip the first (controlling) parameter of primitive operation
|
||||
|
||||
Iface_Op_Param := First (Iface_Op_Params);
|
||||
|
||||
if Present (First_Formal (Iface_Op))
|
||||
and then Is_Controlling_Formal (First_Formal (Iface_Op))
|
||||
then
|
||||
Iface_Op_Param := Next (Iface_Op_Param);
|
||||
end if;
|
||||
|
||||
Iface_Op_Param := Next (First (Iface_Op_Params));
|
||||
Wrapper_Param := First (Wrapper_Params);
|
||||
while Present (Iface_Op_Param)
|
||||
and then Present (Wrapper_Param)
|
||||
|
|
@ -1917,7 +1949,9 @@ package body Exp_Ch9 is
|
|||
-- Skip the object parameter when dealing with primitives declared
|
||||
-- between two views.
|
||||
|
||||
if Is_Private_Primitive_Subprogram (Subp_Id) then
|
||||
if Is_Private_Primitive_Subprogram (Subp_Id)
|
||||
and then not Has_Controlling_Result (Subp_Id)
|
||||
then
|
||||
Formal := Next (Formal);
|
||||
end if;
|
||||
|
||||
|
|
@ -2046,11 +2080,21 @@ package body Exp_Ch9 is
|
|||
|
||||
New_Formals := Replicate_Formals (Loc, Formals);
|
||||
|
||||
-- A function with a controlling result and no first controlling
|
||||
-- formal needs no additional parameter.
|
||||
|
||||
if Has_Controlling_Result (Subp_Id)
|
||||
and then
|
||||
(No (First_Formal (Subp_Id))
|
||||
or else not Is_Controlling_Formal (First_Formal (Subp_Id)))
|
||||
then
|
||||
null;
|
||||
|
||||
-- Routine Subp_Id has been found to override an interface primitive.
|
||||
-- If the interface operation has an access parameter, create a copy
|
||||
-- of it, with the same null exclusion indicator if present.
|
||||
|
||||
if Present (First_Param) then
|
||||
elsif Present (First_Param) then
|
||||
if Nkind (Parameter_Type (First_Param)) = N_Access_Definition then
|
||||
Obj_Param_Typ :=
|
||||
Make_Access_Definition (Loc,
|
||||
|
|
@ -2072,11 +2116,15 @@ package body Exp_Ch9 is
|
|||
Out_Present => Out_Present (First_Param),
|
||||
Parameter_Type => Obj_Param_Typ);
|
||||
|
||||
-- If we are dealing with a primitive declared between two views,
|
||||
-- create a default parameter. The mode of the parameter must
|
||||
-- match that of the primitive operation.
|
||||
Prepend_To (New_Formals, Obj_Param);
|
||||
|
||||
else pragma Assert (Is_Private_Primitive_Subprogram (Subp_Id));
|
||||
-- If we are dealing with a primitive declared between two views,
|
||||
-- implemented by a synchronized operation, we need to create
|
||||
-- a default parameter. The mode of the parameter must match that
|
||||
-- of the primitive operation.
|
||||
|
||||
else
|
||||
pragma Assert (Is_Private_Primitive_Subprogram (Subp_Id));
|
||||
Obj_Param :=
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier =>
|
||||
|
|
@ -2084,19 +2132,33 @@ package body Exp_Ch9 is
|
|||
In_Present => In_Present (Parent (First_Entity (Subp_Id))),
|
||||
Out_Present => Ekind (Subp_Id) /= E_Function,
|
||||
Parameter_Type => New_Reference_To (Obj_Typ, Loc));
|
||||
Prepend_To (New_Formals, Obj_Param);
|
||||
end if;
|
||||
|
||||
Prepend_To (New_Formals, Obj_Param);
|
||||
|
||||
-- Build the final spec
|
||||
-- Build the final spec. If it is a function with a controlling
|
||||
-- result, it is a primitive operation of the corresponding
|
||||
-- record type, so mark the spec accordingly.
|
||||
|
||||
if Ekind (Subp_Id) = E_Function then
|
||||
return
|
||||
Make_Function_Specification (Loc,
|
||||
Defining_Unit_Name => Wrapper_Id,
|
||||
Parameter_Specifications => New_Formals,
|
||||
Result_Definition =>
|
||||
New_Copy (Result_Definition (Parent (Subp_Id))));
|
||||
|
||||
declare
|
||||
Res_Def : Node_Id;
|
||||
|
||||
begin
|
||||
if Has_Controlling_Result (Subp_Id) then
|
||||
Res_Def :=
|
||||
New_Occurrence_Of
|
||||
(Corresponding_Record_Type (Etype (Subp_Id)), Loc);
|
||||
else
|
||||
Res_Def := New_Copy (Result_Definition (Parent (Subp_Id)));
|
||||
end if;
|
||||
|
||||
return
|
||||
Make_Function_Specification (Loc,
|
||||
Defining_Unit_Name => Wrapper_Id,
|
||||
Parameter_Specifications => New_Formals,
|
||||
Result_Definition => Res_Def);
|
||||
end;
|
||||
else
|
||||
return
|
||||
Make_Procedure_Specification (Loc,
|
||||
|
|
|
|||
|
|
@ -56,7 +56,11 @@ package body System.VxWorks.Ext is
|
|||
-- semDelete --
|
||||
---------------
|
||||
|
||||
function semDelete (Sem : SEM_ID) return int;
|
||||
pragma Import (C, semDelete, "semDelete");
|
||||
function semDelete (Sem : SEM_ID) return int is
|
||||
function Os_Sem_Delete (Sem : SEM_ID) return int;
|
||||
pragma Import (C, Os_Sem_Delete, "semDelete");
|
||||
begin
|
||||
return Os_Sem_Delete (Sem);
|
||||
end semDelete;
|
||||
|
||||
end System.VxWorks.Ext;
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ with Interfaces.C;
|
|||
package System.VxWorks.Ext is
|
||||
pragma Preelaborate;
|
||||
|
||||
type SEM_ID is new Long_Integer;
|
||||
subtype SEM_ID is Long_Integer;
|
||||
-- typedef struct semaphore *SEM_ID;
|
||||
|
||||
type t_id is new Long_Integer;
|
||||
|
|
|
|||
|
|
@ -1766,6 +1766,30 @@ package body Sem is
|
|||
|
||||
Do_Action (Empty, Standard_Package_Node);
|
||||
|
||||
-- First place the context of all instance bodies on the corresponding
|
||||
-- spec, because it may be needed to analyze the code at the place of
|
||||
-- the instantiation.
|
||||
|
||||
Cur := First_Elmt (Comp_Unit_List);
|
||||
while Present (Cur) loop
|
||||
declare
|
||||
CU : constant Node_Id := Node (Cur);
|
||||
N : constant Node_Id := Unit (CU);
|
||||
|
||||
begin
|
||||
if Nkind (N) = N_Package_Body
|
||||
and then Is_Generic_Instance (Defining_Entity (N))
|
||||
then
|
||||
Append_List
|
||||
(Context_Items (CU), Context_Items (Library_Unit (CU)));
|
||||
end if;
|
||||
|
||||
Next_Elmt (Cur);
|
||||
end;
|
||||
end loop;
|
||||
|
||||
-- Now traverse compilation units in order.
|
||||
|
||||
Cur := First_Elmt (Comp_Unit_List);
|
||||
while Present (Cur) loop
|
||||
declare
|
||||
|
|
@ -1777,39 +1801,12 @@ package body Sem is
|
|||
|
||||
case Nkind (N) is
|
||||
|
||||
-- If it's a body, then ignore it, unless it's an instance (in
|
||||
-- which case we do the spec), or it's the main unit (in which
|
||||
-- case we do it). Note that it could be both, in which case we
|
||||
-- do the with_clauses of spec and body first,
|
||||
-- If it's a body, then ignore it, unless it's the main unit
|
||||
-- Otherwise bodies appear in the list because of inlining or
|
||||
-- instantiations, and they are processed immediately after
|
||||
-- the corresponding specs.
|
||||
|
||||
when N_Package_Body | N_Subprogram_Body =>
|
||||
declare
|
||||
Entity : Node_Id := N;
|
||||
|
||||
begin
|
||||
if Nkind (Entity) = N_Subprogram_Body then
|
||||
Entity := Specification (Entity);
|
||||
end if;
|
||||
|
||||
Entity := Defining_Entity (Entity);
|
||||
|
||||
if Is_Generic_Instance (Entity) then
|
||||
declare
|
||||
Spec_Unit : constant Node_Id := Library_Unit (CU);
|
||||
|
||||
begin
|
||||
-- Move context of body to that of spec, so it
|
||||
-- appears before the spec itself, in case it
|
||||
-- contains nested instances that generate late
|
||||
-- with_clauses that got attached to the body.
|
||||
|
||||
Append_List
|
||||
(Context_Items (CU), Context_Items (Spec_Unit));
|
||||
Do_Unit_And_Dependents
|
||||
(Spec_Unit, Unit (Spec_Unit));
|
||||
end;
|
||||
end if;
|
||||
end;
|
||||
|
||||
if CU = Cunit (Main_Unit) then
|
||||
Do_Unit_And_Dependents (CU, N);
|
||||
|
|
|
|||
|
|
@ -2685,11 +2685,18 @@ package body Sem_Ch6 is
|
|||
New_Overloaded_Entity (Designator);
|
||||
Check_Delayed_Subprogram (Designator);
|
||||
|
||||
-- If the type of the first formal of the current subprogram is a non
|
||||
-- generic tagged private type , mark the subprogram as being a private
|
||||
-- primitive.
|
||||
-- If the type of the first formal of the current subprogram is a
|
||||
-- nongeneric tagged private type, mark the subprogram as being a
|
||||
-- private primitive. Ditto if this is a function with controlling
|
||||
-- result, and the return type is currently private.
|
||||
|
||||
if Present (First_Formal (Designator)) then
|
||||
if Has_Controlling_Result (Designator)
|
||||
and then Is_Private_Type (Etype (Designator))
|
||||
and then not Is_Generic_Actual_Type (Etype (Designator))
|
||||
then
|
||||
Set_Is_Private_Primitive (Designator);
|
||||
|
||||
elsif Present (First_Formal (Designator)) then
|
||||
declare
|
||||
Formal_Typ : constant Entity_Id :=
|
||||
Etype (First_Formal (Designator));
|
||||
|
|
|
|||
Loading…
Reference in New Issue