The package s-tposen is used to implement protected objects (with one entry) in the ravenscar profile. In fact, only a subset of the ravenscar profile is required to trigger the use of this package (instead of s-tpoben). This patch adds a restriction to the triggering conditions, in order to simplify the implementation and the interface of s-tposen. No functional change.
Tested on x86_64-pc-linux-gnu, committed on trunk 2014-01-31 Tristan Gingold <ging...@adacore.com> * exp_util.adb (Corresponding_Runtime_Package): Restrict the use of System_Tasking_Protected_Objects_Single_Entry. * exp_ch9.adb (Build_Simple_Entry_Call): Remove Mode parameter of Protected_Single_Entry_Call. (Expand_N_Timed_Entry_Call): Remove single_entry case. * exp_disp.adb (Make_Disp_Asynchronous_Select_Body): Remove single_entry case. (Make_Disp_Timed_Select_Body): Likewise. * rtsfind.ads (RE_Timed_Protected_Single_Entry_Call): Remove. * s-tposen.adb (Send_Program_Error, PO_Do_Or_Queue): Remove Self_Id parameter. (Wakeup_Entry_Caller): Remove Self_ID and New_State parameters. (Wait_For_Completion_With_Timeout): Remove. (Protected_Single_Entry_Call): Remove Mode parameter (always Simple_Call). (Service_Entry): Remove Self_Id constant (not used anymore). (Timed_Protected_Single_Entry_Call): Remove. * s-tposen.ads (Timed_Protected_Single_Entry_Call): Remove. (Protected_Single_Entry_Call): Remove Mode parameter.
Index: exp_util.adb =================================================================== --- exp_util.adb (revision 207348) +++ exp_util.adb (working copy) @@ -1646,6 +1646,7 @@ then if Abort_Allowed or else Restriction_Active (No_Entry_Queue) = False + or else Restriction_Active (No_Select_Statements) = False or else Number_Entries (Typ) > 1 or else (Has_Attach_Handler (Typ) and then not Restricted_Profile) Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 207348) +++ exp_ch9.adb (working copy) @@ -4682,12 +4682,10 @@ -- family index expressions are evaluated before the entry -- parameters. - if Abort_Allowed - or else Restriction_Active (No_Entry_Queue) = False - or else not Is_Protected_Type (Conctyp) - or else Number_Entries (Conctyp) > 1 - or else (Has_Attach_Handler (Conctyp) - and then not Restricted_Profile) + if not Is_Protected_Type (Conctyp) + or else + Corresponding_Runtime_Package (Conctyp) = + System_Tasking_Protected_Objects_Entries then X := Make_Defining_Identifier (Loc, Name_uX); @@ -4902,8 +4900,7 @@ when System_Tasking_Protected_Objects_Single_Entry => -- Protected_Single_Entry_Call ( -- Object => po._object'Access, - -- Uninterpreted_Data => P'Address; - -- Mode => Simple_Call); + -- Uninterpreted_Data => P'Address); Call := Make_Procedure_Call_Statement (Loc, @@ -4914,8 +4911,7 @@ Make_Attribute_Reference (Loc, Attribute_Name => Name_Unchecked_Access, Prefix => Parm1), - Parm3, - New_Reference_To (RTE (RE_Simple_Call), Loc))); + Parm3)); when others => raise Program_Error; @@ -12481,24 +12477,6 @@ (RTE (RE_Timed_Protected_Entry_Call), Loc), Parameter_Associations => Params)); - when System_Tasking_Protected_Objects_Single_Entry => - Param := First (Params); - while Present (Param) - and then not - Is_RTE (Etype (Param), RE_Protected_Entry_Index) - loop - Next (Param); - end loop; - - Remove (Param); - - Rewrite (Call, - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To - (RTE (RE_Timed_Protected_Single_Entry_Call), Loc), - Parameter_Associations => Params)); - when others => raise Program_Error; end case; Index: rtsfind.ads =================================================================== --- rtsfind.ads (revision 207348) +++ rtsfind.ads (working copy) @@ -1750,7 +1750,6 @@ RE_Exceptional_Complete_Single_Entry_Body, RE_Protected_Count_Entry, -- Protected_Objects.Single_Entry RE_Protected_Single_Entry_Caller, -- Protected_Objects.Single_Entry - RE_Timed_Protected_Single_Entry_Call, RE_Protected_Entry_Index, -- System.Tasking.Protected_Objects RE_Entry_Body, -- System.Tasking.Protected_Objects @@ -3062,8 +3061,6 @@ System_Tasking_Protected_Objects_Single_Entry, RE_Protected_Single_Entry_Caller => System_Tasking_Protected_Objects_Single_Entry, - RE_Timed_Protected_Single_Entry_Call => - System_Tasking_Protected_Objects_Single_Entry, RE_Protected_Entry_Index => System_Tasking_Protected_Objects, RE_Entry_Body => System_Tasking_Protected_Objects, Index: exp_disp.adb =================================================================== --- exp_disp.adb (revision 207348) +++ exp_disp.adb (working copy) @@ -2337,30 +2337,6 @@ New_Reference_To (Com_Block, Loc)))); -- comm block - when System_Tasking_Protected_Objects_Single_Entry => - - -- Generate: - -- procedure Protected_Single_Entry_Call - -- (Object : Protection_Entry_Access; - -- Uninterpreted_Data : System.Address; - -- Mode : Call_Modes); - - Append_To (Stmts, - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To - (RTE (RE_Protected_Single_Entry_Call), Loc), - Parameter_Associations => - New_List ( - Obj_Ref, - - Make_Attribute_Reference (Loc, - Prefix => Make_Identifier (Loc, Name_uP), - Attribute_Name => Name_Address), - - New_Reference_To - (RTE (RE_Asynchronous_Call), Loc)))); - when others => raise Program_Error; end case; @@ -3569,29 +3545,6 @@ Make_Identifier (Loc, Name_uM), -- delay mode Make_Identifier (Loc, Name_uF)))); -- status flag - when System_Tasking_Protected_Objects_Single_Entry => - -- Generate: - - -- Timed_Protected_Single_Entry_Call - -- (T._object'access, P, D, M, F); - - -- where T is the protected object, P is the wrapped - -- parameters, D is the delay amount, M is the delay mode, F - -- is the status flag. - - Append_To (Stmts, - Make_Procedure_Call_Statement (Loc, - Name => - New_Reference_To - (RTE (RE_Timed_Protected_Single_Entry_Call), Loc), - Parameter_Associations => - New_List ( - Obj_Ref, - Make_Identifier (Loc, Name_uP), -- parameter block - Make_Identifier (Loc, Name_uD), -- delay - Make_Identifier (Loc, Name_uM), -- delay mode - Make_Identifier (Loc, Name_uF)))); -- status flag - when others => raise Program_Error; end case; Index: s-tposen.adb =================================================================== --- s-tposen.adb (revision 207348) +++ s-tposen.adb (working copy) @@ -74,9 +74,7 @@ -- Local Subprograms -- ----------------------- - procedure Send_Program_Error - (Self_Id : Task_Id; - Entry_Call : Entry_Call_Link); + procedure Send_Program_Error (Entry_Call : Entry_Call_Link); pragma Inline (Send_Program_Error); -- Raise Program_Error in the caller of the specified entry call @@ -84,19 +82,12 @@ -- Entry Calls Handling -- -------------------------- - procedure Wakeup_Entry_Caller - (Self_ID : Task_Id; - Entry_Call : Entry_Call_Link; - New_State : Entry_Call_State); + procedure Wakeup_Entry_Caller (Entry_Call : Entry_Call_Link); pragma Inline (Wakeup_Entry_Caller); -- This is called at the end of service of an entry call, -- to abort the caller if he is in an abortable part, and -- to wake up the caller if he is on Entry_Caller_Sleep. -- Call it holding the lock of Entry_Call.Self. - -- - -- Timed_Call or Simple_Call: - -- The caller is waiting on Entry_Caller_Sleep, in - -- Wait_For_Completion, or Wait_For_Completion_With_Timeout. procedure Wait_For_Completion (Entry_Call : Entry_Call_Link); pragma Inline (Wait_For_Completion); @@ -105,13 +96,6 @@ -- queued. This waits for calls on protected entries. -- Call this only when holding Self_ID locked. - procedure Wait_For_Completion_With_Timeout - (Entry_Call : Entry_Call_Link; - Wakeup_Time : Duration; - Mode : Delay_Modes); - -- Same as Wait_For_Completion but it waits for a timeout with the value - -- specified in Wakeup_Time as well. - procedure Check_Exception (Self_ID : Task_Id; Entry_Call : Entry_Call_Link); @@ -122,8 +106,7 @@ -- The caller should not be holding any locks, or there will be deadlock. procedure PO_Do_Or_Queue - (Self_Id : Task_Id; - Object : Protection_Entry_Access; + (Object : Protection_Entry_Access; Entry_Call : Entry_Call_Link); -- This procedure executes or queues an entry call, depending -- on the status of the corresponding barrier. It assumes that the @@ -157,9 +140,7 @@ -- Send_Program_Error -- ------------------------ - procedure Send_Program_Error - (Self_Id : Task_Id; - Entry_Call : Entry_Call_Link) + procedure Send_Program_Error (Entry_Call : Entry_Call_Link) is Caller : constant Task_Id := Entry_Call.Self; begin @@ -170,7 +151,7 @@ end if; STPO.Write_Lock (Caller); - Wakeup_Entry_Caller (Self_Id, Entry_Call, Done); + Wakeup_Entry_Caller (Entry_Call); STPO.Unlock (Caller); if Single_Lock then @@ -190,51 +171,6 @@ Self_Id.Common.State := Runnable; end Wait_For_Completion; - -------------------------------------- - -- Wait_For_Completion_With_Timeout -- - -------------------------------------- - - procedure Wait_For_Completion_With_Timeout - (Entry_Call : Entry_Call_Link; - Wakeup_Time : Duration; - Mode : Delay_Modes) - is - Self_Id : constant Task_Id := Entry_Call.Self; - Timedout : Boolean; - - Yielded : Boolean; - pragma Unreferenced (Yielded); - - use type Ada.Exceptions.Exception_Id; - - begin - -- This procedure waits for the entry call to be served, with a timeout. - -- It tries to cancel the call if the timeout expires before the call is - -- served. - - -- If we wake up from the timed sleep operation here, it may be for the - -- following possible reasons: - - -- 1) The entry call is done being served. - -- 2) The timeout has expired (Timedout = True) - - -- Once the timeout has expired we may need to continue to wait if the - -- call is already being serviced. In that case, we want to go back to - -- sleep, but without any timeout. The variable Timedout is used to - -- control this. If the Timedout flag is set, we do not need to Sleep - -- with a timeout. We just sleep until we get a wakeup for some status - -- change. - - pragma Assert (Entry_Call.Mode = Timed_Call); - Self_Id.Common.State := Entry_Caller_Sleep; - - STPO.Timed_Sleep - (Self_Id, Wakeup_Time, Mode, Entry_Caller_Sleep, Timedout, Yielded); - - Entry_Call.State := (if Timedout then Cancelled else Done); - Self_Id.Common.State := Runnable; - end Wait_For_Completion_With_Timeout; - ------------------------- -- Wakeup_Entry_Caller -- ------------------------- @@ -246,31 +182,18 @@ -- (This enforces the rule that a task must be off-queue if its state is -- Done or Cancelled.) Call it holding the lock of Entry_Call.Self. - -- Timed_Call or Simple_Call: - -- The caller is waiting on Entry_Caller_Sleep, in - -- Wait_For_Completion, or Wait_For_Completion_With_Timeout. + -- The caller is waiting on Entry_Caller_Sleep, in Wait_For_Completion. - -- Conditional_Call: - -- The caller might be in Wait_For_Completion, - -- waiting for a rendezvous (possibly requeued without abort) - -- to complete. - procedure Wakeup_Entry_Caller - (Self_ID : Task_Id; - Entry_Call : Entry_Call_Link; - New_State : Entry_Call_State) + (Entry_Call : Entry_Call_Link) is - pragma Warnings (Off, Self_ID); - Caller : constant Task_Id := Entry_Call.Self; - begin - pragma Assert (New_State = Done or else New_State = Cancelled); pragma Assert (Caller.Common.State /= Terminated and then Caller.Common.State /= Unactivated); - Entry_Call.State := New_State; + Entry_Call.State := Done; STPO.Wakeup (Caller, Entry_Caller_Sleep); end Wakeup_Entry_Caller; @@ -338,8 +261,7 @@ -------------------- procedure PO_Do_Or_Queue - (Self_Id : Task_Id; - Object : Protection_Entry_Access; + (Object : Protection_Entry_Access; Entry_Call : Entry_Call_Link) is Barrier_Value : Boolean; @@ -356,7 +278,7 @@ -- This violates the No_Entry_Queue restriction, send -- Program_Error to the caller. - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); return; end if; @@ -370,45 +292,32 @@ end if; STPO.Write_Lock (Entry_Call.Self); - Wakeup_Entry_Caller (Self_Id, Entry_Call, Done); + Wakeup_Entry_Caller (Entry_Call); STPO.Unlock (Entry_Call.Self); if Single_Lock then STPO.Unlock_RTS; end if; - elsif Entry_Call.Mode /= Conditional_Call then + else + pragma Assert (Entry_Call.Mode = Simple_Call); + if Object.Entry_Queue /= null then -- This violates the No_Entry_Queue restriction, send -- Program_Error to the caller. - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); return; else Object.Entry_Queue := Entry_Call; end if; - else - -- Conditional_Call - - if Single_Lock then - STPO.Lock_RTS; - end if; - - STPO.Write_Lock (Entry_Call.Self); - Wakeup_Entry_Caller (Self_Id, Entry_Call, Cancelled); - STPO.Unlock (Entry_Call.Self); - - if Single_Lock then - STPO.Unlock_RTS; - end if; end if; exception when others => - Send_Program_Error - (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); end PO_Do_Or_Queue; ---------------------------- @@ -430,8 +339,7 @@ procedure Protected_Single_Entry_Call (Object : Protection_Entry_Access; - Uninterpreted_Data : System.Address; - Mode : Call_Modes) + Uninterpreted_Data : System.Address) is Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1); @@ -448,12 +356,12 @@ Lock_Entry (Object); - Entry_Call.Mode := Mode; + Entry_Call.Mode := Simple_Call; Entry_Call.State := Now_Abortable; Entry_Call.Uninterpreted_Data := Uninterpreted_Data; Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; - PO_Do_Or_Queue (Self_Id, Object, Entry_Call'Access); + PO_Do_Or_Queue (Object, Entry_Call'Access); Unlock_Entry (Object); -- The call is either `Done' or not. It cannot be cancelled since there @@ -493,7 +401,6 @@ ------------------- procedure Service_Entry (Object : Protection_Entry_Access) is - Self_Id : constant Task_Id := STPO.Self; Entry_Call : constant Entry_Call_Link := Object.Entry_Queue; Caller : Task_Id; @@ -507,7 +414,7 @@ -- Violation of No_Entry_Queue restriction, raise exception - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); Unlock_Entry (Object); return; end if; @@ -524,7 +431,7 @@ end if; STPO.Write_Lock (Caller); - Wakeup_Entry_Caller (Self_Id, Entry_Call, Done); + Wakeup_Entry_Caller (Entry_Call); STPO.Unlock (Caller); if Single_Lock then @@ -539,79 +446,10 @@ exception when others => - Send_Program_Error (Self_Id, Entry_Call); + Send_Program_Error (Entry_Call); Unlock_Entry (Object); end Service_Entry; - --------------------------------------- - -- Timed_Protected_Single_Entry_Call -- - --------------------------------------- - - -- Compiler interface only (do not call from within the RTS) - - procedure Timed_Protected_Single_Entry_Call - (Object : Protection_Entry_Access; - Uninterpreted_Data : System.Address; - Timeout : Duration; - Mode : Delay_Modes; - Entry_Call_Successful : out Boolean) - is - Self_Id : constant Task_Id := STPO.Self; - Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1); - - begin - -- If pragma Detect_Blocking is active then Program_Error must be - -- raised if this potentially blocking operation is called from a - -- protected action. - - if Detect_Blocking - and then Self_Id.Common.Protected_Action_Nesting > 0 - then - raise Program_Error with "potentially blocking operation"; - end if; - - Lock (Object.Common'Access); - - Entry_Call.Mode := Timed_Call; - Entry_Call.State := Now_Abortable; - Entry_Call.Uninterpreted_Data := Uninterpreted_Data; - Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id; - - PO_Do_Or_Queue (Self_Id, Object, Entry_Call'Access); - Unlock_Entry (Object); - - -- Try to avoid waiting for completed calls. - -- The call is either `Done' or not. It cannot be cancelled since there - -- is no ATC construct and the timed wait has not started yet. - - pragma Assert (Entry_Call.State /= Cancelled); - - if Entry_Call.State = Done then - Check_Exception (Self_Id, Entry_Call'Access); - Entry_Call_Successful := True; - return; - end if; - - if Single_Lock then - STPO.Lock_RTS; - else - STPO.Write_Lock (Self_Id); - end if; - - Wait_For_Completion_With_Timeout (Entry_Call'Access, Timeout, Mode); - - if Single_Lock then - STPO.Unlock_RTS; - else - STPO.Unlock (Self_Id); - end if; - - pragma Assert (Entry_Call.State >= Done); - - Check_Exception (Self_Id, Entry_Call'Access); - Entry_Call_Successful := Entry_Call.State = Done; - end Timed_Protected_Single_Entry_Call; - ------------------ -- Unlock_Entry -- ------------------ Index: s-tposen.ads =================================================================== --- s-tposen.ads (revision 207348) +++ s-tposen.ads (working copy) @@ -225,8 +225,7 @@ procedure Protected_Single_Entry_Call (Object : Protection_Entry_Access; - Uninterpreted_Data : System.Address; - Mode : Call_Modes); + Uninterpreted_Data : System.Address); -- Make a protected entry call to the specified object -- -- Pend a protected entry call on the protected object represented by @@ -237,19 +236,7 @@ -- This will be returned by Next_Entry_Call when this call is serviced. -- It can be used by the compiler to pass information between the -- caller and the server, in particular entry parameters. - -- - -- Mode - -- The kind of call to be pended - procedure Timed_Protected_Single_Entry_Call - (Object : Protection_Entry_Access; - Uninterpreted_Data : System.Address; - Timeout : Duration; - Mode : Delay_Modes; - Entry_Call_Successful : out Boolean); - -- Same as the Protected_Entry_Call but with time-out specified. - -- This routine is used to implement timed entry calls. - procedure Exceptional_Complete_Single_Entry_Body (Object : Protection_Entry_Access; Ex : Ada.Exceptions.Exception_Id);