2009-06-19 Emmanuel Briot <briot@adacore.com>

	* prj-ext.adb, makeutl.adb, makeutl.ads (Executable_Prefix_Path): Now
	make sure we always return a name ending with a path separator.

2009-06-19  Javier Miranda  <miranda@adacore.com>

	* sem_ch12.adb (Instantiate_Package_Body, Instantiate_Subprogram_Body):
	Save and restore the visibility of the parent when installed.

2009-06-19  Jose Ruiz  <ruiz@adacore.com>

	* s-tposen.ads (Protection_Entry): Replace fields L, Ceiling, and Owner
	by Common which contains all these fields.

	* s-tposen.adb (Initialize_Protection_Entry, Lock_Entry,
	Lock_Read_Only_Entry, Timed_Protected_Single_Entry_Call, Unlock_Entry):
	Remove code duplication in this package by means of calling the
	equivalent code in s-taprob.

2009-06-19  Robert Dewar  <dewar@adacore.com>

	* a-einuoc.ads: Minor reformatting



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148701 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 5 insertions, 123 deletions

diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb
index 73e4c9dd2c2..a429903d64b 100644
--- a/gcc/ada/s-tposen.adb
+++ b/gcc/ada/s-tposen.adb
@@ -318,15 +318,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is
       Compiler_Info     : System.Address;
       Entry_Body        : Entry_Body_Access)
    is
-      Init_Priority : Integer := Ceiling_Priority;
    begin
-      if Init_Priority = Unspecified_Priority then
-         Init_Priority := System.Priority'Last;
-      end if;
+      Initialize_Protection (Object.Common'Access, Ceiling_Priority);
 
-      STPO.Initialize_Lock (Init_Priority, Object.L'Access);
-      Object.Ceiling := System.Any_Priority (Init_Priority);
-      Object.Owner := Null_Task;
       Object.Compiler_Info := Compiler_Info;
       Object.Call_In_Progress := null;
       Object.Entry_Body := Entry_Body;
@@ -341,45 +335,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    --  Do not call this procedure from within the run-time system.
 
    procedure Lock_Entry (Object : Protection_Entry_Access) is
-      Ceiling_Violation : Boolean;
-
    begin
-      --  If pragma Detect_Blocking is active then, as described in the ARM
-      --  9.5.1, par. 15, we must check whether this is an external call on a
-      --  protected subprogram with the same target object as that of the
-      --  protected action that is currently in progress (i.e., if the caller
-      --  is already the protected object's owner). If this is the case hence
-      --  Program_Error must be raised.
-
-      if Detect_Blocking and then Object.Owner = Self then
-         raise Program_Error;
-      end if;
-
-      STPO.Write_Lock (Object.L'Access, Ceiling_Violation);
-
-      if Ceiling_Violation then
-         raise Program_Error;
-      end if;
-
-      --  We are entering in a protected action, so that we increase the
-      --  protected object nesting level (if pragma Detect_Blocking is
-      --  active), and update the protected object's owner.
-
-      if Detect_Blocking then
-         declare
-            Self_Id : constant Task_Id := Self;
-
-         begin
-            --  Update the protected object's owner
-
-            Object.Owner := Self_Id;
-
-            --  Increase protected object nesting level
-
-            Self_Id.Common.Protected_Action_Nesting :=
-              Self_Id.Common.Protected_Action_Nesting + 1;
-         end;
-      end if;
+      Lock (Object.Common'Access);
    end Lock_Entry;
 
    --------------------------
@@ -391,53 +348,8 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    --  Do not call this procedure from within the runtime system
 
    procedure Lock_Read_Only_Entry (Object : Protection_Entry_Access) is
-      Ceiling_Violation : Boolean;
-
    begin
-      --  If pragma Detect_Blocking is active then, as described in the ARM
-      --  9.5.1, par. 15, we must check whether this is an external call on a
-      --  protected subprogram with the same target object as that of the
-      --  protected action that is currently in progress (i.e., if the caller
-      --  is already the protected object's owner). If this is the case hence
-      --  Program_Error must be raised.
-
-      --  Note that in this case (getting read access), several tasks may
-      --  have read ownership of the protected object, so that this method of
-      --  storing the (single) protected object's owner does not work
-      --  reliably for read locks. However, this is the approach taken for two
-      --  major reasons: first, this function is not currently being used (it
-      --  is provided for possible future use), and second, it largely
-      --  simplifies the implementation.
-
-      if Detect_Blocking and then Object.Owner = Self then
-         raise Program_Error;
-      end if;
-
-      STPO.Read_Lock (Object.L'Access, Ceiling_Violation);
-
-      if Ceiling_Violation then
-         raise Program_Error;
-      end if;
-
-      --  We are entering in a protected action, so that we increase the
-      --  protected object nesting level (if pragma Detect_Blocking is
-      --  active), and update the protected object's owner.
-
-      if Detect_Blocking then
-         declare
-            Self_Id : constant Task_Id := Self;
-
-         begin
-            --  Update the protected object's owner
-
-            Object.Owner := Self_Id;
-
-            --  Increase protected object nesting level
-
-            Self_Id.Common.Protected_Action_Nesting :=
-              Self_Id.Common.Protected_Action_Nesting + 1;
-         end;
-      end if;
+      Lock_Read_Only (Object.Common'Access);
    end Lock_Read_Only_Entry;
 
    --------------------
@@ -665,7 +577,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is
    is
       Self_Id           : constant Task_Id  := STPO.Self;
       Entry_Call        : Entry_Call_Record renames Self_Id.Entry_Calls (1);
-      Ceiling_Violation : Boolean;
 
    begin
       --  If pragma Detect_Blocking is active then Program_Error must be
@@ -678,11 +589,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
          raise Program_Error with "potentially blocking operation";
       end if;
 
-      STPO.Write_Lock (Object.L'Access, Ceiling_Violation);
-
-      if Ceiling_Violation then
-         raise Program_Error;
-      end if;
+      Lock (Object.Common'Access);
 
       Entry_Call.Mode := Timed_Call;
       Entry_Call.State := Now_Abortable;
@@ -730,32 +637,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
 
    procedure Unlock_Entry (Object : Protection_Entry_Access) is
    begin
-      --  We are exiting from a protected action, so that we decrease the
-      --  protected object nesting level (if pragma Detect_Blocking is
-      --  active), and remove ownership of the protected object.
-
-      if Detect_Blocking then
-         declare
-            Self_Id : constant Task_Id := Self;
-
-         begin
-            --  Calls to this procedure can only take place when being within
-            --  a protected action and when the caller is the protected
-            --  object's owner.
-
-            pragma Assert (Self_Id.Common.Protected_Action_Nesting > 0
-                             and then Object.Owner = Self_Id);
-
-            --  Remove ownership of the protected object
-
-            Object.Owner := Null_Task;
-
-            Self_Id.Common.Protected_Action_Nesting :=
-              Self_Id.Common.Protected_Action_Nesting - 1;
-         end;
-      end if;
-
-      STPO.Unlock (Object.L'Access);
+      Unlock (Object.Common'Access);
    end Unlock_Entry;
 
 end System.Tasking.Protected_Objects.Single_Entry;