* 41intnam.ads, 42intnam.ads, 4aintnam.ads, 4cintnam.ads,

	4dintnam.ads, 4gintnam.ads, 4hintnam.ads, 4lintnam.ads,
	4mintnam.ads, 4pintnam.ads, 4rintnam.ads, 4sintnam.ads,
	4uintnam.ads, 4vcalend.adb, 4zintnam.ads, 52system.ads,
	5amastop.adb, 5asystem.ads, 5ataprop.adb, 5atpopsp.adb,
	5avxwork.ads, 5bosinte.adb, 5bsystem.ads, 5esystem.ads,
	5fsystem.ads, 5ftaprop.adb, 5ginterr.adb, 5gmastop.adb,
	5gsystem.ads, 5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads,
	5hparame.ads, 5hsystem.ads, 5htaprop.adb, 5htraceb.adb,
	5itaprop.adb, 5ksystem.ads, 5kvxwork.ads, 5lintman.adb,
	5lsystem.ads, 5mvxwork.ads, 5ninmaop.adb, 5nosinte.ads,
	5ntaprop.adb, 5ointerr.adb, 5omastop.adb, 5oosinte.adb,
	5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5pvxwork.ads,
	5qtaprop.adb, 5sintman.adb, 5ssystem.ads, 5staprop.adb,
	5stpopse.adb, 5svxwork.ads, 5tosinte.ads, 5uintman.adb,
	5vasthan.adb, 5vinmaop.adb, 5vinterr.adb, 5vintman.adb,
	5vmastop.adb, 5vparame.ads, 5vsystem.ads, 5vtaprop.adb,
	5vtpopde.adb, 5wmemory.adb, 5wsystem.ads, 5wtaprop.adb,
	5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zosinte.adb,
	5zosinte.ads, 5zsystem.ads, 5ztaprop.adb, 6vcpp.adb, 6vcstrea.adb,
	7sintman.adb, 7staprop.adb, 7stpopsp.adb, 9drpc.adb,
	Make-lang.in, Makefile.in, a-caldel.adb, a-comlin.ads,
	a-dynpri.adb, a-except.adb, a-except.ads, a-finali.adb,
	a-ncelfu.ads, a-reatim.adb, a-retide.adb, a-stream.ads,
	a-ststio.adb, a-ststio.ads, a-stwifi.adb, a-tags.adb, a-tasatt.adb,
	a-textio.adb, a-tideau.adb, a-tiflau.adb, a-tigeau.adb,
	a-tigeau.ads, a-tiinau.adb, a-timoau.adb, a-witeio.adb,
	a-wtdeau.adb, a-wtenau.adb, a-wtflau.adb, a-wtgeau.adb,
	a-wtgeau.ads, a-wtinau.adb, a-wtmoau.adb, ada-tree.def, ada-tree.h,
	adaint.c, adaint.h, ali-util.adb, ali.adb, ali.ads, atree.adb,
	atree.ads, atree.h, back_end.adb, bcheck.adb, bindgen.adb,
	bindusg.adb, checks.adb, comperr.adb, config-lang.in, csets.adb,
	csets.ads, cstand.adb, cstreams.c, debug.adb, debug.ads, decl.c,
	einfo.adb, einfo.ads, einfo.h, elists.h, errout.adb, errout.ads,
	eval_fat.adb, exp_aggr.adb, exp_attr.adb, exp_ch11.adb,
	exp_ch12.adb, exp_ch13.adb, exp_ch2.adb, exp_ch3.adb, exp_ch3.ads,
	exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch7.ads,
	exp_ch9.adb, exp_ch9.ads, exp_dbug.adb, exp_dbug.ads, exp_disp.ads,
	exp_dist.adb, exp_fixd.adb, exp_intr.adb, exp_pakd.adb,
	exp_prag.adb, exp_strm.adb, exp_util.adb, exp_util.ads,
	expander.adb, expect.c, fe.h, fmap.adb, fmap.ads, fname-uf.adb,
	freeze.adb, frontend.adb, g-awk.adb, g-cgideb.adb, g-comlin.adb,
	g-comlin.ads, g-debpoo.adb, g-dirope.adb, g-dirope.ads,
	g-dyntab.adb, g-expect.adb, g-expect.ads, g-io.ads, g-io_aux.adb,
	g-io_aux.ads, g-locfil.adb, g-locfil.ads, g-os_lib.adb,
	g-os_lib.ads, g-regexp.adb, g-regpat.adb, g-socket.adb,
	g-socket.ads, g-spipat.adb, g-table.adb, g-trasym.adb,
	g-trasym.ads, gigi.h, gmem.c, gnat1drv.adb, gnatbind.adb, gnatbl.c,
	gnatchop.adb, gnatcmd.adb, gnatdll.adb, gnatfind.adb, gnatlbr.adb,
	gnatlink.adb, gnatls.adb, gnatmem.adb, gnatprep.adb, gnatvsn.ads,
	gnatxref.adb, hlo.adb, hostparm.ads, i-cobol.adb, i-cpp.adb,
	i-cstrea.ads, i-cstrin.adb, i-pacdec.adb, i-vxwork.ads,
	impunit.adb, init.c, inline.adb, io-aux.c, layout.adb, lib-load.adb,
	lib-util.adb, lib-writ.adb, lib-writ.ads, lib-xref.adb,
	lib-xref.ads, lib.adb, lib.ads, make.adb, makeusg.adb, mdll.adb,
	memroot.adb, misc.c, mlib-tgt.adb, mlib-utl.adb, mlib-utl.ads,
	mlib.adb, namet.adb, namet.ads, namet.h, nlists.h, nmake.adb,
	nmake.ads, nmake.adt, opt.adb, opt.ads, osint.adb, osint.ads,
	output.adb, output.ads, par-ch2.adb, par-ch3.adb, par-ch5.adb,
	par-prag.adb, par-tchk.adb, par-util.adb, par.adb, prj-attr.adb,
	prj-dect.adb, prj-env.adb, prj-env.ads, prj-nmsc.adb, prj-part.adb,
	prj-proc.adb, prj-strt.adb, prj-tree.adb, prj-tree.ads, prj.adb,
	prj.ads, raise.c, raise.h, repinfo.adb, restrict.adb, restrict.ads,
	rident.ads, rtsfind.adb, rtsfind.ads, s-arit64.adb, s-asthan.adb,
	s-atacco.adb, s-atacco.ads, s-auxdec.adb, s-crc32.adb, s-crc32.ads,
	s-direio.adb, s-fatgen.adb, s-fileio.adb, s-finimp.adb,
	s-gloloc.adb, s-gloloc.ads, s-interr.adb, s-mastop.adb,
	s-mastop.ads, s-memory.adb, s-parame.ads, s-parint.adb,
	s-pooglo.adb, s-pooloc.adb, s-rpc.adb, s-secsta.adb, s-sequio.adb,
	s-shasto.adb, s-soflin.adb, s-soflin.ads, s-stache.adb,
	s-taasde.adb, s-taasde.ads, s-tadeca.adb, s-tadeca.ads,
	s-tadert.adb, s-tadert.ads, s-taenca.adb, s-taenca.ads,
	s-taprob.adb, s-taprop.ads, s-tarest.adb, s-tasdeb.adb,
	s-tasini.adb, s-tasini.ads, s-taskin.adb, s-taskin.ads,
	s-tasque.adb, s-tasque.ads, s-tasren.adb, s-tasren.ads,
	s-tassta.adb, s-tasuti.adb, s-tasuti.ads, s-tataat.adb,
	s-tataat.ads, s-tpoben.adb, s-tpoben.ads, s-tpobop.adb,
	s-tposen.adb, s-tposen.ads, s-traceb.adb, s-traceb.ads,
	s-unstyp.ads, s-widenu.adb, scn-nlit.adb, scn.adb, sem.adb,
	sem_aggr.adb, sem_attr.adb, sem_attr.ads, sem_case.adb,
	sem_ch10.adb, sem_ch11.adb, sem_ch11.ads, sem_ch12.adb,
	sem_ch13.adb, sem_ch13.ads, sem_ch2.adb, sem_ch3.adb, sem_ch3.ads,
	sem_ch4.adb, sem_ch5.adb, sem_ch6.adb, sem_ch6.ads, sem_ch7.adb,
	sem_ch8.adb, sem_ch8.ads, sem_ch9.adb, sem_disp.adb, sem_dist.adb,
	sem_elab.adb, sem_elim.adb, sem_elim.ads, sem_eval.adb,
	sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb,
	sem_type.adb, sem_util.adb, sem_util.ads, sem_vfpt.adb,
	sem_warn.adb, sinfo.adb, sinfo.ads, sinfo.h, sinput-l.adb,
	sinput-l.ads, sinput.adb, sinput.ads, snames.adb, snames.ads,
	snames.h, sprint.adb, sprint.ads, stringt.adb, stringt.ads,
	stringt.h, style.adb, switch.adb, switch.ads, sysdep.c, system.ads,
	table.adb, targparm.adb, targparm.ads, targtyps.c, tbuild.adb,
	tbuild.ads, tracebak.c, trans.c, tree_gen.adb, tree_io.adb,
	treepr.adb, treepr.ads, treeprs.ads, treeprs.adt, ttypes.ads,
	types.adb, types.ads, types.h, uintp.ads, urealp.ads, usage.adb,
	utils.c, utils2.c, validsw.adb, xnmake.adb, xr_tabls.adb,
	xr_tabls.ads, xref_lib.adb, xref_lib.ads : Merge in ACT changes.

	* 1ssecsta.adb, 1ssecsta.ads, a-chlat9.ads, a-cwila9.ads,
	g-enblsp.adb, g-md5.adb, g-md5.ads, gnatname.adb, gnatname.ads,
	mkdir.c, osint-b.adb, osint-b.ads, osint-c.adb, osint-c.ads,
	osint-l.adb, osint-l.ads, osint-m.adb, osint-m.ads : New files

	* 3lsoccon.ads, 5qparame.ads, 5qvxwork.ads, 5smastop.adb,
	5zparame.ads, gnatmain.adb, gnatmain.ads, gnatpsys.adb : Removed

	* mdllfile.adb, mdllfile.ads, mdlltool.adb, mdlltool.ads : Renamed
	to mdll-fil.ad[bs] and mdll-util.ad[bs]

	* mdll-fil.adb, mdll-fil.ads, mdll-utl.adb, mdll-utl.ads : Renamed
	from mdllfile.ad[bs] and mdlltool.ad[bs]


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

1 files changed, 509 insertions, 543 deletions

diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb
index 516cee0fd2e..9bc84b663b5 100644
--- a/gcc/ada/s-tasren.adb
+++ b/gcc/ada/s-tasren.adb
@@ -6,9 +6,9 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.101 $
+--                            $Revision$
 --                                                                          --
---            Copyright (C) 1991-2001, Florida State University             --
+--         Copyright (C) 1992-2001, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL 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- --
@@ -29,8 +29,7 @@
 -- covered by the  GNU Public License.                                      --
 --                                                                          --
 -- GNARL was developed by the GNARL team at Florida State University. It is --
--- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
--- State University (http://www.gnat.com).                                  --
+-- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com).     --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -79,14 +78,23 @@ with System.Tasking.Protected_Objects.Operations;
 with System.Tasking.Debug;
 --  used for Trace
 
+with System.Parameters;
+--  used for Single_Lock
+--           Runtime_Traces
+
+with System.Traces.Tasking;
+--  used for Send_Trace_Info
+
 package body System.Tasking.Rendezvous is
 
    package STPO renames System.Task_Primitives.Operations;
-   package POO renames System.Tasking.Protected_Objects.Operations;
-   package POE renames System.Tasking.Protected_Objects.Entries;
+   package POO renames Protected_Objects.Operations;
+   package POE renames Protected_Objects.Entries;
 
-   use System.Task_Primitives;
-   use System.Task_Primitives.Operations;
+   use Parameters;
+   use Task_Primitives.Operations;
+   use System.Traces;
+   use System.Traces.Tasking;
 
    type Select_Treatment is (
      Accept_Alternative_Selected,   --  alternative with non-null body
@@ -138,12 +146,10 @@ package body System.Tasking.Rendezvous is
    --  means either the user is trying to do a potentially blocking
    --  operation from within a protected object, or there is a
    --  runtime system/compiler error that has failed to undefer
-   --  an earlier abort deferral.  Thus, for debugging it may be
+   --  an earlier abort deferral. Thus, for debugging it may be
    --  wise to modify the above renamings to the non-nestable forms.
 
-   procedure Boost_Priority
-     (Call     : Entry_Call_Link;
-      Acceptor : Task_ID);
+   procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_ID);
    pragma Inline (Boost_Priority);
    --  Call this only with abort deferred and holding lock of Acceptor.
 
@@ -174,36 +180,13 @@ package body System.Tasking.Rendezvous is
    pragma Inline (Wait_For_Call);
    --  Call this only with abort deferred and holding lock of Self_Id.
    --  An accepting task goes into Sleep by calling this routine
-   --  waiting for a call from the caller or waiting for an abortion.
+   --  waiting for a call from the caller or waiting for an abort.
    --  Make sure Self_Id is locked before calling this routine.
 
    -----------------
    -- Accept_Call --
    -----------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-
-   --  source:
-   --              accept E do  ...A... end E;
-   --  expansion:
-   --              A27b : address;
-   --              L26b : label
-   --              begin
-   --                 accept_call (1, A27b);
-   --                 ...A...
-   --                 complete_rendezvous;
-   --              <<L26b>>
-   --              exception
-   --              when all others =>
-   --                 exceptional_complete_rendezvous (get_gnat_exception);
-   --              end;
-
-   --  The handler for Abort_Signal (*all* others) is to handle the case when
-   --  the acceptor is aborted between Accept_Call and the corresponding
-   --  Complete_Rendezvous call. We need to wake up the caller in this case.
-
-   --   See also Selective_Wait
-
    procedure Accept_Call
      (E                  : Task_Entry_Index;
       Uninterpreted_Data : out System.Address)
@@ -216,6 +199,10 @@ package body System.Tasking.Rendezvous is
    begin
       Initialization.Defer_Abort (Self_Id);
 
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
@@ -224,6 +211,11 @@ package body System.Tasking.Rendezvous is
          pragma Assert (Self_Id.Pending_Action);
 
          STPO.Unlock (Self_Id);
+
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
          Initialization.Undefer_Abort (Self_Id);
 
          --  Should never get here ???
@@ -232,17 +224,6 @@ package body System.Tasking.Rendezvous is
          raise Standard'Abort_Signal;
       end if;
 
-      --  If someone completed this task, this task should not try to
-      --  access its pending entry calls or queues in this case, as they
-      --  are being emptied. Wait for abortion to kill us.
-      --  ?????
-      --  Recheck the correctness of the above, now that we have made
-      --  changes.  The logic above seems to be based on the assumption
-      --  that one task can safely clean up another's in-service accepts.
-      --  ?????
-      --  Why do we need to block here in this case?
-      --  Why not just return and let Undefer_Abort do its work?
-
       Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
 
       if Entry_Call /= null then
@@ -259,60 +240,60 @@ package body System.Tasking.Rendezvous is
 
          --  Wait for normal call
 
+         if Parameters.Runtime_Traces then
+            Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
+         end if;
+
          pragma Debug
            (Debug.Trace (Self_Id, "Accept_Call: wait", 'R'));
          Wait_For_Call (Self_Id);
 
          pragma Assert (Self_Id.Open_Accepts = null);
 
-         if Self_Id.Pending_ATC_Level >= Self_Id.ATC_Nesting_Level then
+         if Self_Id.Common.Call /= null then
             Caller := Self_Id.Common.Call.Self;
             Uninterpreted_Data :=
               Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
-         end if;
-
-         --  If this task has been aborted, skip the Uninterpreted_Data load
-         --  (Caller will not be reliable) and fall through to
-         --  Undefer_Abort which will allow the task to be killed.
-         --  ?????
-         --  Perhaps we could do the code anyway, if it has no harm, in order
-         --  to get better performance for the normal case.
+         else
+            --  Case of an aborted task.
 
+            Uninterpreted_Data := System.Null_Address;
+         end if;
       end if;
 
       --  Self_Id.Common.Call should already be updated by the Caller
       --  On return, we will start the rendezvous.
 
       STPO.Unlock (Self_Id);
+
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
       Initialization.Undefer_Abort (Self_Id);
+
+      if Parameters.Runtime_Traces then
+         Send_Trace_Info (M_Accept_Complete, Caller, Entry_Index (E));
+      end if;
    end Accept_Call;
 
    --------------------
    -- Accept_Trivial --
    --------------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-   --  This should only be called when there is no accept body,
-   --  or the except body is empty.
-
-   --  source:
-   --               accept E;
-   --  expansion:
-   --               accept_trivial (1);
-
-   --  The compiler is also able to recognize the following and
-   --  translate it the same way.
-
-   --     accept E do null; end E;
-
    procedure Accept_Trivial (E : Task_Entry_Index) is
-      Self_Id       : constant Task_ID := STPO.Self;
-      Caller        : Task_ID := null;
-      Open_Accepts  : aliased Accept_List (1 .. 1);
-      Entry_Call    : Entry_Call_Link;
+      Self_Id      : constant Task_ID := STPO.Self;
+      Caller       : Task_ID := null;
+      Open_Accepts : aliased Accept_List (1 .. 1);
+      Entry_Call   : Entry_Call_Link;
 
    begin
       Initialization.Defer_Abort_Nestable (Self_Id);
+
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
@@ -321,6 +302,11 @@ package body System.Tasking.Rendezvous is
          pragma Assert (Self_Id.Pending_Action);
 
          STPO.Unlock (Self_Id);
+
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
          Initialization.Undefer_Abort_Nestable (Self_Id);
 
          --  Should never get here ???
@@ -329,23 +315,19 @@ package body System.Tasking.Rendezvous is
          raise Standard'Abort_Signal;
       end if;
 
-      --  If someone completed this task, this task should not try to
-      --  access its pending entry calls or queues in this case, as they
-      --  are being emptied. Wait for abortion to kill us.
-      --  ?????
-      --  Recheck the correctness of the above, now that we have made
-      --  changes.
-
       Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
 
       if Entry_Call = null then
-
          --  Need to wait for entry call
 
          Open_Accepts (1).Null_Body := True;
          Open_Accepts (1).S := E;
          Self_Id.Open_Accepts := Open_Accepts'Unrestricted_Access;
 
+         if Parameters.Runtime_Traces then
+            Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
+         end if;
+
          pragma Debug
           (Debug.Trace (Self_Id, "Accept_Trivial: wait", 'R'));
 
@@ -359,7 +341,6 @@ package body System.Tasking.Rendezvous is
          STPO.Unlock (Self_Id);
 
       else  --  found caller already waiting
-
          pragma Assert (Entry_Call.State < Done);
 
          STPO.Unlock (Self_Id);
@@ -370,6 +351,19 @@ package body System.Tasking.Rendezvous is
          STPO.Unlock (Caller);
       end if;
 
+      if Parameters.Runtime_Traces then
+         Send_Trace_Info (M_Accept_Complete);
+
+         --  Fake one, since there is (???) no way
+         --  to know that the rendezvous is over
+
+         Send_Trace_Info (M_RDV_Complete);
+      end if;
+
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
       Initialization.Undefer_Abort_Nestable (Self_Id);
    end Accept_Trivial;
 
@@ -377,10 +371,8 @@ package body System.Tasking.Rendezvous is
    -- Boost_Priority --
    --------------------
 
-   --  Call this only with abort deferred and holding lock of Acceptor.
-
    procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_ID) is
-      Caller        : Task_ID := Call.Self;
+      Caller        : constant Task_ID := Call.Self;
       Caller_Prio   : System.Any_Priority := Get_Priority (Caller);
       Acceptor_Prio : System.Any_Priority := Get_Priority (Acceptor);
 
@@ -398,8 +390,6 @@ package body System.Tasking.Rendezvous is
    -- Call_Simple --
    -----------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-
    procedure Call_Simple
      (Acceptor           : Task_ID;
       E                  : Task_Entry_Index;
@@ -415,8 +405,7 @@ package body System.Tasking.Rendezvous is
    -- Call_Synchronous --
    ----------------------
 
-   --  Compiler interface.
-   --  Also called from inside Call_Simple and Task_Entry_Call.
+   --  Called from Call_Simple and Task_Entry_Call.
 
    procedure Call_Synchronous
      (Acceptor              : Task_ID;
@@ -443,6 +432,10 @@ package body System.Tasking.Rendezvous is
       Entry_Call.Mode := Mode;
       Entry_Call.Cancellation_Attempted := False;
 
+      if Parameters.Runtime_Traces then
+         Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
+      end if;
+
       --  If this is a call made inside of an abort deferred region,
       --  the call should be never abortable.
 
@@ -458,12 +451,25 @@ package body System.Tasking.Rendezvous is
       Entry_Call.Called_Task := Acceptor;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
 
-      --  Note: the caller will undefer abortion on return (see WARNING above)
+      --  Note: the caller will undefer abort on return (see WARNING above)
+
+      if Single_Lock then
+         Lock_RTS;
+      end if;
 
       if not Task_Do_Or_Queue
         (Self_Id, Entry_Call, With_Abort => True)
       then
          Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level - 1;
+
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
+         if Parameters.Runtime_Traces then
+            Send_Trace_Info (E_Missed, Acceptor);
+         end if;
+
          Initialization.Undefer_Abort (Self_Id);
          pragma Debug
            (Debug.Trace (Self_Id, "CS: exited to ATC level: " &
@@ -474,11 +480,16 @@ package body System.Tasking.Rendezvous is
       STPO.Write_Lock (Self_Id);
       pragma Debug
         (Debug.Trace (Self_Id, "Call_Synchronous: wait", 'R'));
-      Entry_Calls.Wait_For_Completion (Self_Id, Entry_Call);
+      Entry_Calls.Wait_For_Completion (Entry_Call);
       pragma Debug
         (Debug.Trace (Self_Id, "Call_Synchronous: done waiting", 'R'));
       Rendezvous_Successful := Entry_Call.State = Done;
       STPO.Unlock (Self_Id);
+
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
       Local_Undefer_Abort (Self_Id);
       Entry_Calls.Check_Exception (Self_Id, Entry_Call);
    end Call_Synchronous;
@@ -487,19 +498,25 @@ package body System.Tasking.Rendezvous is
    -- Callable --
    --------------
 
-   --  Compiler interface.
-   --  Do not call from within the RTS,
-   --  except for body of Ada.Task_Identification.
-
    function Callable (T : Task_ID) return Boolean is
       Result  : Boolean;
       Self_Id : constant Task_ID := STPO.Self;
 
    begin
       Initialization.Defer_Abort (Self_Id);
+
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
       STPO.Write_Lock (T);
       Result := T.Callable;
       STPO.Unlock (T);
+
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
       Initialization.Undefer_Abort (Self_Id);
       return Result;
    end Callable;
@@ -508,9 +525,6 @@ package body System.Tasking.Rendezvous is
    -- Cancel_Task_Entry_Call --
    ----------------------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-   --  Call only with abort deferred.
-
    procedure Cancel_Task_Entry_Call (Cancelled : out Boolean) is
    begin
       Entry_Calls.Try_To_Cancel_Entry_Call (Cancelled);
@@ -520,8 +534,6 @@ package body System.Tasking.Rendezvous is
    -- Complete_Rendezvous --
    -------------------------
 
-   --  See comments for Exceptional_Complete_Rendezvous.
-
    procedure Complete_Rendezvous is
    begin
       Exceptional_Complete_Rendezvous (Ada.Exceptions.Null_Id);
@@ -531,22 +543,6 @@ package body System.Tasking.Rendezvous is
    -- Exceptional_Complete_Rendezvous --
    -------------------------------------
 
-   --  Compiler interface.
-   --  Also called from Complete_Rendezvous.
-   --  ?????
-   --  Consider phasing out Complete_Rendezvous in favor
-   --  of direct call to this with Ada.Exceptions.Null_ID.
-   --  See code expansion examples for Accept_Call and Selective_Wait.
-   --  ?????
-   --  If we don't change the interface, consider instead
-   --  putting an explicit re-raise after this call, in
-   --  the generated code.  That way we could eliminate the
-   --  code here that reraises the exception.
-
-   --  The deferral level is critical here,
-   --  since we want to raise an exception or allow abort to take
-   --  place, if there is an exception or abort pending.
-
    procedure Exceptional_Complete_Rendezvous
      (Ex : Ada.Exceptions.Exception_Id)
    is
@@ -565,12 +561,28 @@ package body System.Tasking.Rendezvous is
       use type STPE.Protection_Entries_Access;
 
    begin
+      --  Consider phasing out Complete_Rendezvous in favor
+      --  of direct call to this with Ada.Exceptions.Null_ID.
+      --  See code expansion examples for Accept_Call and Selective_Wait.
+      --  Also consider putting an explicit re-raise after this call, in
+      --  the generated code. That way we could eliminate the
+      --  code here that reraises the exception.
+
+      --  The deferral level is critical here,
+      --  since we want to raise an exception or allow abort to take
+      --  place, if there is an exception or abort pending.
+
       pragma Debug
        (Debug.Trace (Self_Id, "Exceptional_Complete_Rendezvous", 'R'));
 
       if Ex = Ada.Exceptions.Null_Id then
          --  The call came from normal end-of-rendezvous,
          --  so abort is not yet deferred.
+
+         if Parameters.Runtime_Traces then
+            Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
+         end if;
+
          Initialization.Defer_Abort_Nestable (Self_Id);
       end if;
 
@@ -578,6 +590,10 @@ package body System.Tasking.Rendezvous is
       --  been serving when it was aborted.
 
       if Ex = Standard'Abort_Signal'Identity then
+         if Single_Lock then
+            Lock_RTS;
+         end if;
+
          while Entry_Call /= null loop
             Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
 
@@ -593,12 +609,15 @@ package body System.Tasking.Rendezvous is
             --  Complete the call abnormally, with exception.
 
             STPO.Write_Lock (Caller);
-
             Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
             STPO.Unlock (Caller);
             Entry_Call := Entry_Call.Acceptor_Prev_Call;
          end loop;
 
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
       else
          Caller := Entry_Call.Self;
 
@@ -612,13 +631,25 @@ package body System.Tasking.Rendezvous is
             if Entry_Call.Called_Task /= null then
                --  Requeue to another task entry
 
+               if Single_Lock then
+                  Lock_RTS;
+               end if;
+
                if not Task_Do_Or_Queue
                  (Self_Id, Entry_Call, Entry_Call.Requeue_With_Abort)
                then
+                  if Single_Lock then
+                     Lock_RTS;
+                  end if;
+
                   Initialization.Undefer_Abort (Self_Id);
                   raise Tasking_Error;
                end if;
 
+               if Single_Lock then
+                  Unlock_RTS;
+               end if;
+
             else
                --  Requeue to a protected entry
 
@@ -630,11 +661,20 @@ package body System.Tasking.Rendezvous is
 
                   Exception_To_Raise := Program_Error'Identity;
                   Entry_Call.Exception_To_Raise := Exception_To_Raise;
+
+                  if Single_Lock then
+                     Lock_RTS;
+                  end if;
+
                   STPO.Write_Lock (Caller);
                   Initialization.Wakeup_Entry_Caller
                     (Self_Id, Entry_Call, Done);
                   STPO.Unlock (Caller);
 
+                  if Single_Lock then
+                     Unlock_RTS;
+                  end if;
+
                else
                   POO.PO_Do_Or_Queue
                     (Self_Id, Called_PO, Entry_Call,
@@ -644,14 +684,19 @@ package body System.Tasking.Rendezvous is
                end if;
             end if;
 
-            Entry_Calls.Reset_Priority (Entry_Call.Acceptor_Prev_Priority,
-              Self_Id);
+            Entry_Calls.Reset_Priority
+              (Self_Id, Entry_Call.Acceptor_Prev_Priority);
 
          else
             --  The call does not need to be requeued.
 
             Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
             Entry_Call.Exception_To_Raise := Ex;
+
+            if Single_Lock then
+               Lock_RTS;
+            end if;
+
             STPO.Write_Lock (Caller);
 
             --  Done with Caller locked to make sure that Wakeup is not lost.
@@ -664,8 +709,13 @@ package body System.Tasking.Rendezvous is
 
             Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
             STPO.Unlock (Caller);
-            Entry_Calls.Reset_Priority (Entry_Call.Acceptor_Prev_Priority,
-              Self_Id);
+
+            if Single_Lock then
+               Unlock_RTS;
+            end if;
+
+            Entry_Calls.Reset_Priority
+              (Self_Id, Entry_Call.Acceptor_Prev_Priority);
          end if;
       end if;
 
@@ -675,10 +725,8 @@ package body System.Tasking.Rendezvous is
          Internal_Reraise;
       end if;
 
-      --  ?????
-      --  Do we need to
-      --  give precedence to Program_Error that might be raised
-      --  due to failure of finalization, over Tasking_Error from
+      --  ??? Do we need to give precedence to Program_Error that might be
+      --  raised due to failure of finalization, over Tasking_Error from
       --  failure of requeue?
    end Exceptional_Complete_Rendezvous;
 
@@ -710,43 +758,6 @@ package body System.Tasking.Rendezvous is
    -- Requeue_Protected_To_Task_Entry --
    -------------------------------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-
-   --  entry e2 when b is
-   --  begin
-   --     b := false;
-   --     ...A...
-   --     requeue t.e2;
-   --  end e2;
-
-   --  procedure rPT__E14b (O : address; P : address; E :
-   --    protected_entry_index) is
-   --     type rTVP is access rTV;
-   --     freeze rTVP []
-   --     _object : rTVP := rTVP!(O);
-   --  begin
-   --     declare
-   --        rR : protection renames _object._object;
-   --        vP : integer renames _object.v;
-   --        bP : boolean renames _object.b;
-   --     begin
-   --        b := false;
-   --        ...A...
-   --        requeue_protected_to_task_entry (rR'unchecked_access, tTV!(t).
-   --          _task_id, 2, false);
-   --        return;
-   --     end;
-   --     complete_entry_body (_object._object'unchecked_access, objectF =>
-   --       0);
-   --     return;
-   --  exception
-   --     when others =>
-   --        abort_undefer.all;
-   --        exceptional_complete_entry_body (_object._object'
-   --          unchecked_access, current_exception, objectF => 0);
-   --        return;
-   --  end rPT__E14b;
-
    procedure Requeue_Protected_To_Task_Entry
      (Object     : STPE.Protection_Entries_Access;
       Acceptor   : Task_ID;
@@ -768,41 +779,13 @@ package body System.Tasking.Rendezvous is
    -- Requeue_Task_Entry --
    ------------------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-   --  The code generation for task entry requeues is different from that
-   --  for protected entry requeues.  There is a "goto" that skips around
-   --  the call to Complete_Rendezous, so that Requeue_Task_Entry must also
-   --  do the work of Complete_Rendezvous.  The difference is that it does
-   --  not report that the call's State = Done.
-
-   --     accept e1 do
-   --       ...A...
-   --       requeue e2;
-   --       ...B...
-   --     end e1;
-
-   --     A62b : address;
-   --     L61b : label
-   --     begin
-   --        accept_call (1, A62b);
-   --        ...A...
-   --        requeue_task_entry (tTV!(t)._task_id, 2, false);
-   --        goto L61b;
-   --        ...B...
-   --        complete_rendezvous;
-   --        <<L61b>>
-   --     exception
-   --        when others =>
-   --           exceptional_complete_rendezvous (current_exception);
-   --     end;
-
    procedure Requeue_Task_Entry
      (Acceptor   : Task_ID;
       E          : Task_Entry_Index;
       With_Abort : Boolean)
    is
-      Self_Id       : constant Task_ID := STPO.Self;
-      Entry_Call    : constant Entry_Call_Link := Self_Id.Common.Call;
+      Self_Id    : constant Task_ID := STPO.Self;
+      Entry_Call : constant Entry_Call_Link := Self_Id.Common.Call;
 
    begin
       Initialization.Defer_Abort (Self_Id);
@@ -817,71 +800,6 @@ package body System.Tasking.Rendezvous is
    -- Selective_Wait --
    --------------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-   --  See comments on Accept_Call.
-
-   --  source code:
-
-   --     select accept e1 do
-   --           ...A...
-   --        end e1;
-   --        ...B...
-   --     or accept e2;
-   --        ...C...
-   --     end select;
-
-   --  expansion:
-
-   --     A32b : address;
-   --     declare
-   --        null;
-   --        if accept_alternative'size * 2 >= 16#8000_0000# then
-   --           raise storage_error;
-   --        end if;
-   --        A37b : T36b;
-   --        A37b (1) := (null_body => false, s => 1);
-   --        A37b (2) := (null_body => true, s => 2);
-   --        if accept_alternative'size * 2 >= 16#8000_0000# then
-   --           raise storage_error;
-   --        end if;
-   --        S0 : aliased T36b := accept_list'A37b;
-   --        J1 : select_index := 0;
-   --        L3 : label
-   --        L1 : label
-   --        L2 : label
-   --        procedure e1A is
-   --        begin
-   --           abort_undefer.all;
-   --           L31b : label
-   --           ...A...
-   --           <<L31b>>
-   --           complete_rendezvous;
-   --        exception
-   --           when all others =>
-   --              exceptional_complete_rendezvous (get_gnat_exception);
-   --        end e1A;
-   --     begin
-   --        selective_wait (S0'unchecked_access, simple_mode, A32b, J1);
-   --        case J1 is
-   --           when 0 =>
-   --              goto L3;
-   --           when 1 =>
-   --              e1A;
-   --              goto L1;
-   --           when 2 =>
-   --              goto L2;
-   --           when others =>
-   --              goto L3;
-   --        end case;
-   --        <<L1>>
-   --        ...B...
-   --        goto L3;
-   --        <<L2>>
-   --        ...C...
-   --        goto L3;
-   --        <<L3>>
-   --     end;
-
    procedure Selective_Wait
      (Open_Accepts       : Accept_List_Access;
       Select_Mode        : Select_Modes;
@@ -897,6 +815,11 @@ package body System.Tasking.Rendezvous is
 
    begin
       Initialization.Defer_Abort (Self_Id);
+
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
@@ -906,8 +829,12 @@ package body System.Tasking.Rendezvous is
 
          STPO.Unlock (Self_Id);
 
-         --  ??? In some cases abort is deferred more than once. Need to figure
-         --  out why.
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
+         --  ??? In some cases abort is deferred more than once. Need to
+         --  figure out why this happens.
 
          Self_Id.Deferral_Level := 1;
 
@@ -919,15 +846,10 @@ package body System.Tasking.Rendezvous is
          raise Standard'Abort_Signal;
       end if;
 
-      --  If someone completed this task, this task should not try to
-      --  access its pending entry calls or queues in this case, as they
-      --  are being emptied. Wait for abortion to kill us.
-      --  ?????
-      --  Recheck the correctness of the above, now that we have made
-      --  changes.
-
       pragma Assert (Open_Accepts /= null);
 
+      Uninterpreted_Data := Null_Address;
+
       Queuing.Select_Task_Entry_Call
         (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
 
@@ -940,7 +862,6 @@ package body System.Tasking.Rendezvous is
          if Entry_Call /= null then
             if Open_Accepts (Selection).Null_Body then
                Treatment := Accept_Alternative_Completed;
-
             else
                Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
                Treatment := Accept_Alternative_Selected;
@@ -953,195 +874,194 @@ package body System.Tasking.Rendezvous is
          end if;
       end if;
 
-      --  ??????
-      --  Recheck the logic above against the ARM.
-
       --  Handle the select according to the disposition selected above.
 
       case Treatment is
+         when Accept_Alternative_Selected =>
+            --  Ready to rendezvous
 
-      when Accept_Alternative_Selected =>
-
-         --  Ready to rendezvous
-
-         Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
-
-         --  In this case the accept body is not Null_Body. Defer abortion
-         --  until it gets into the accept body.
-
-         pragma Assert (Self_Id.Deferral_Level = 1);
+            Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
 
-         Initialization.Defer_Abort_Nestable (Self_Id);
-         STPO.Unlock (Self_Id);
+            --  In this case the accept body is not Null_Body. Defer abort
+            --  until it gets into the accept body.
 
-      when Accept_Alternative_Completed =>
+            pragma Assert (Self_Id.Deferral_Level = 1);
 
-         --  Accept body is null, so rendezvous is over immediately.
+            Initialization.Defer_Abort_Nestable (Self_Id);
+            STPO.Unlock (Self_Id);
 
-         STPO.Unlock (Self_Id);
-         Caller := Entry_Call.Self;
+         when Accept_Alternative_Completed =>
+            --  Accept body is null, so rendezvous is over immediately.
 
-         STPO.Write_Lock (Caller);
-         Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
-         STPO.Unlock (Caller);
-
-      when Accept_Alternative_Open =>
+            if Parameters.Runtime_Traces then
+               Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
+            end if;
 
-         --  Wait for caller.
+            STPO.Unlock (Self_Id);
+            Caller := Entry_Call.Self;
 
-         Self_Id.Open_Accepts := Open_Accepts;
-         pragma Debug
-           (Debug.Trace (Self_Id, "Selective_Wait: wait", 'R'));
-         Wait_For_Call (Self_Id);
+            STPO.Write_Lock (Caller);
+            Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+            STPO.Unlock (Caller);
 
-         pragma Assert (Self_Id.Open_Accepts = null);
+         when Accept_Alternative_Open =>
+            --  Wait for caller.
 
-         --  Self_Id.Common.Call should already be updated by the Caller if
-         --  not aborted. It might also be ready to do rendezvous even if
-         --  this wakes up due to an abortion.
-         --  Therefore, if the call is not empty we need to do the rendezvous
-         --  if the accept body is not Null_Body.
+            Self_Id.Open_Accepts := Open_Accepts;
+            pragma Debug
+              (Debug.Trace (Self_Id, "Selective_Wait: wait", 'R'));
 
-         --  ?????
-         --  aren't the first two conditions below redundant?
+            if Parameters.Runtime_Traces then
+               Send_Trace_Info (W_Select, Self_Id,
+                                Integer (Open_Accepts'Length));
+            end if;
 
-         if Self_Id.Chosen_Index /= No_Rendezvous and then
-           Self_Id.Common.Call /= null and then
-           not Open_Accepts (Self_Id.Chosen_Index).Null_Body
-         then
-            Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
+            Wait_For_Call (Self_Id);
 
-            pragma Assert (Self_Id.Deferral_Level = 1);
+            pragma Assert (Self_Id.Open_Accepts = null);
 
-            Initialization.Defer_Abort_Nestable (Self_Id);
+            --  Self_Id.Common.Call should already be updated by the Caller if
+            --  not aborted. It might also be ready to do rendezvous even if
+            --  this wakes up due to an abortion.
+            --  Therefore, if the call is not empty we need to do the
+            --  rendezvous if the accept body is not Null_Body.
 
-            --  Leave abort deferred until the accept body
-         end if;
+            --  Aren't the first two conditions below redundant???
 
-         STPO.Unlock (Self_Id);
+            if Self_Id.Chosen_Index /= No_Rendezvous
+              and then Self_Id.Common.Call /= null
+              and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
+            then
+               Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
 
-      when Else_Selected =>
-         pragma Assert (Self_Id.Open_Accepts = null);
+               pragma Assert (Self_Id.Deferral_Level = 1);
 
-         STPO.Unlock (Self_Id);
+               Initialization.Defer_Abort_Nestable (Self_Id);
 
-      when Terminate_Selected =>
+               --  Leave abort deferred until the accept body
+            end if;
 
-         --  Terminate alternative is open
+            STPO.Unlock (Self_Id);
 
-         Self_Id.Open_Accepts := Open_Accepts;
-         Self_Id.Common.State := Acceptor_Sleep;
-         STPO.Unlock (Self_Id);
+         when Else_Selected =>
+            pragma Assert (Self_Id.Open_Accepts = null);
 
-         --  ?????
-         --  We need to check if a signal is pending on an open interrupt
-         --  entry. Otherwise this task would become potentially terminatable
-         --  and, if none of the siblings are active
-         --  any more, the task could not wake up any more, even though a
-         --  signal might be pending on an open interrupt entry.
-         --  -------------
-         --  This comment paragraph does not make sense.  Is it obsolete?
-         --  There was no code here to check for pending signals.
+            if Parameters.Runtime_Traces then
+               Send_Trace_Info (M_Select_Else);
+            end if;
 
-         --  Notify ancestors that this task is on a terminate alternative.
+            STPO.Unlock (Self_Id);
 
-         Utilities.Make_Passive (Self_Id, Task_Completed => False);
+         when Terminate_Selected =>
+            --  Terminate alternative is open
 
-         --  Wait for normal entry call or termination
+            Self_Id.Open_Accepts := Open_Accepts;
+            Self_Id.Common.State := Acceptor_Sleep;
+            STPO.Unlock (Self_Id);
 
-         pragma Assert (Self_Id.ATC_Nesting_Level = 1);
+            --  Notify ancestors that this task is on a terminate alternative.
 
-         STPO.Write_Lock (Self_Id);
+            Utilities.Make_Passive (Self_Id, Task_Completed => False);
 
-         loop
-            Initialization.Poll_Base_Priority_Change (Self_Id);
-            exit when Self_Id.Open_Accepts = null;
-            Sleep (Self_Id, Acceptor_Sleep);
-         end loop;
+            --  Wait for normal entry call or termination
 
-         Self_Id.Common.State := Runnable;
+            pragma Assert (Self_Id.ATC_Nesting_Level = 1);
 
-         pragma Assert (Self_Id.Open_Accepts = null);
+            STPO.Write_Lock (Self_Id);
 
-         if Self_Id.Terminate_Alternative then
+            loop
+               Initialization.Poll_Base_Priority_Change (Self_Id);
+               exit when Self_Id.Open_Accepts = null;
+               Sleep (Self_Id, Acceptor_Sleep);
+            end loop;
 
-            --  An entry call should have reset this to False,
-            --  so we must be aborted.
-            --  We cannot be in an async. select, since that
-            --  is not legal, so the abort must be of the entire
-            --  task.  Therefore, we do not need to cancel the
-            --  terminate alternative.  The cleanup will be done
-            --  in Complete_Master.
+            Self_Id.Common.State := Runnable;
 
-            pragma Assert (Self_Id.Pending_ATC_Level = 0);
+            pragma Assert (Self_Id.Open_Accepts = null);
 
-            pragma Assert (Self_Id.Awake_Count = 0);
+            if Self_Id.Terminate_Alternative then
+               --  An entry call should have reset this to False,
+               --  so we must be aborted.
+               --  We cannot be in an async. select, since that
+               --  is not legal, so the abort must be of the entire
+               --  task.  Therefore, we do not need to cancel the
+               --  terminate alternative.  The cleanup will be done
+               --  in Complete_Master.
 
-            --  Trust that it is OK to fall through.
+               pragma Assert (Self_Id.Pending_ATC_Level = 0);
+               pragma Assert (Self_Id.Awake_Count = 0);
 
-            null;
+               --  Trust that it is OK to fall through.
+               null;
 
-         else
-            --  Self_Id.Common.Call and Self_Id.Chosen_Index
-            --  should already be updated by the Caller.
+            else
+               --  Self_Id.Common.Call and Self_Id.Chosen_Index
+               --  should already be updated by the Caller.
 
-            if Self_Id.Chosen_Index /= No_Rendezvous
-              and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
-            then
-               Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
+               if Self_Id.Chosen_Index /= No_Rendezvous
+                 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
+               then
+                  Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
 
-               pragma Assert (Self_Id.Deferral_Level = 1);
+                  pragma Assert (Self_Id.Deferral_Level = 1);
 
-               --  We need an extra defer here, to keep abort
-               --  deferred until we get into the accept body
+                  --  We need an extra defer here, to keep abort
+                  --  deferred until we get into the accept body
 
-               Initialization.Defer_Abort_Nestable (Self_Id);
+                  Initialization.Defer_Abort_Nestable (Self_Id);
+               end if;
             end if;
-         end if;
 
-         STPO.Unlock (Self_Id);
+            STPO.Unlock (Self_Id);
 
-      when No_Alternative_Open =>
+         when No_Alternative_Open =>
+            --  In this case, Index will be No_Rendezvous on return, which
+            --  should cause a Program_Error if it is not a Delay_Mode.
 
-         --  In this case, Index will be No_Rendezvous on return, which
-         --  should cause a Program_Error if it is not a Delay_Mode.
+            --  If delay alternative exists (Delay_Mode) we should suspend
+            --  until the delay expires.
 
-         --  If delay alternative exists (Delay_Mode) we should suspend
-         --  until the delay expires.
+            Self_Id.Open_Accepts := null;
 
-         Self_Id.Open_Accepts := null;
+            if Select_Mode = Delay_Mode then
+               Self_Id.Common.State := Delay_Sleep;
 
-         if Select_Mode = Delay_Mode then
-            Self_Id.Common.State := Delay_Sleep;
+               loop
+                  Initialization.Poll_Base_Priority_Change (Self_Id);
+                  exit when
+                    Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
+                  Sleep (Self_Id, Delay_Sleep);
+               end loop;
 
-            loop
-               Initialization.Poll_Base_Priority_Change (Self_Id);
-               exit when Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
-               Sleep (Self_Id, Delay_Sleep);
-            end loop;
+               Self_Id.Common.State := Runnable;
+               STPO.Unlock (Self_Id);
 
-            Self_Id.Common.State := Runnable;
-            STPO.Unlock (Self_Id);
+            else
+               STPO.Unlock (Self_Id);
 
-         else
-            STPO.Unlock (Self_Id);
-            Initialization.Undefer_Abort (Self_Id);
-            Ada.Exceptions.Raise_Exception (Program_Error'Identity,
-              "Entry call not a delay mode");
-         end if;
+               if Single_Lock then
+                  Unlock_RTS;
+               end if;
 
+               Initialization.Undefer_Abort (Self_Id);
+               Ada.Exceptions.Raise_Exception
+                 (Program_Error'Identity, "Entry call not a delay mode");
+            end if;
       end case;
 
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
       --  Caller has been chosen.
       --  Self_Id.Common.Call should already be updated by the Caller.
       --  Self_Id.Chosen_Index should either be updated by the Caller
       --  or by Test_Selective_Wait.
       --  On return, we sill start rendezvous unless the accept body is
-      --  null.  In the latter case, we will have already completed the RV.
+      --  null. In the latter case, we will have already completed the RV.
 
       Index := Self_Id.Chosen_Index;
       Initialization.Undefer_Abort_Nestable (Self_Id);
-
    end Selective_Wait;
 
    ------------------------------------
@@ -1152,8 +1072,7 @@ package body System.Tasking.Rendezvous is
 
    procedure Setup_For_Rendezvous_With_Body
      (Entry_Call : Entry_Call_Link;
-      Acceptor   : Task_ID)
-   is
+      Acceptor   : Task_ID) is
    begin
       Entry_Call.Acceptor_Prev_Call := Acceptor.Common.Call;
       Acceptor.Common.Call := Entry_Call;
@@ -1169,17 +1088,25 @@ package body System.Tasking.Rendezvous is
    -- Task_Count --
    ----------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-
    function Task_Count (E : Task_Entry_Index) return Natural is
       Self_Id      : constant Task_ID := STPO.Self;
       Return_Count : Natural;
 
    begin
       Initialization.Defer_Abort (Self_Id);
+
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
       STPO.Write_Lock (Self_Id);
       Return_Count := Queuing.Count_Waiting (Self_Id.Entry_Queues (E));
       STPO.Unlock (Self_Id);
+
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
       Initialization.Undefer_Abort (Self_Id);
       return Return_Count;
    end Task_Count;
@@ -1188,56 +1115,45 @@ package body System.Tasking.Rendezvous is
    -- Task_Do_Or_Queue --
    ----------------------
 
-   --  Call this only with abort deferred and holding no locks.
-   --  May propagate an exception, including Abort_Signal & Tasking_Error.
-   --  ?????
-   --  See Check_Callable.  Check all call contexts to verify
-   --  it is OK to raise an exception.
-
-   --  Find out whether Entry_Call can be accepted immediately.
-   --  If the Acceptor is not callable, raise Tasking_Error.
-   --  If the rendezvous can start, initiate it.
-   --  If the accept-body is trivial, also complete the rendezvous.
-   --  If the acceptor is not ready, enqueue the call.
-
-   --  ?????
-   --  This should have a special case for Accept_Call and
-   --  Accept_Trivial, so that
-   --  we don't have the loop setup overhead, below.
-
-   --  ?????
-   --  The call state Done is used here and elsewhere to include
-   --  both the case of normal successful completion, and the case
-   --  of an exception being raised.  The difference is that if an
-   --  exception is raised no one will pay attention to the fact
-   --  that State = Done.  Instead the exception will be raised in
-   --  Undefer_Abort, and control will skip past the place where
-   --  we normally would resume from an entry call.
-
    function Task_Do_Or_Queue
      (Self_ID    : Task_ID;
       Entry_Call : Entry_Call_Link;
       With_Abort : Boolean) return Boolean
    is
-      E         : constant Task_Entry_Index := Task_Entry_Index (Entry_Call.E);
-      Old_State : constant Entry_Call_State := Entry_Call.State;
-      Acceptor  : constant Task_ID := Entry_Call.Called_Task;
-      Parent    : constant Task_ID := Acceptor.Common.Parent;
+      E             : constant Task_Entry_Index :=
+        Task_Entry_Index (Entry_Call.E);
+      Old_State     : constant Entry_Call_State := Entry_Call.State;
+      Acceptor      : constant Task_ID := Entry_Call.Called_Task;
+      Parent        : constant Task_ID := Acceptor.Common.Parent;
       Parent_Locked : Boolean := False;
-      Null_Body : Boolean;
+      Null_Body     : Boolean;
 
    begin
+      --  Find out whether Entry_Call can be accepted immediately.
+      --  If the Acceptor is not callable, return False.
+      --  If the rendezvous can start, initiate it.
+      --  If the accept-body is trivial, also complete the rendezvous.
+      --  If the acceptor is not ready, enqueue the call.
+
+      --  This should have a special case for Accept_Call and Accept_Trivial,
+      --  so that we don't have the loop setup overhead, below.
+
+      --  The call state Done is used here and elsewhere to include both the
+      --  case of normal successful completion, and the case of an exception
+      --  being raised. The difference is that if an exception is raised no one
+      --  will pay attention to the fact that State = Done. Instead the
+      --  exception will be raised in Undefer_Abort, and control will skip past
+      --  the place where we normally would resume from an entry call.
+
       pragma Assert (not Queuing.Onqueue (Entry_Call));
 
-      --  We rely that the call is off-queue for protection,
-      --  that the caller will not exit the Entry_Caller_Sleep,
-      --  and so will not reuse the call record for another call.
+      --  We rely that the call is off-queue for protection, that the caller
+      --  will not exit the Entry_Caller_Sleep, and so will not reuse the call
+      --  record for another call.
       --  We rely on the Caller's lock for call State mod's.
 
       --  We can't lock Acceptor.Parent while holding Acceptor,
       --  so lock it in advance if we expect to need to lock it.
-      --  ?????
-      --  Is there some better solution?
 
       if Acceptor.Terminate_Alternative then
          STPO.Write_Lock (Parent);
@@ -1246,18 +1162,13 @@ package body System.Tasking.Rendezvous is
 
       STPO.Write_Lock (Acceptor);
 
-      --  If the acceptor is not callable, abort the call
-      --  and raise Tasking_Error.  The call is not aborted
-      --  for an asynchronous call, since Cancel_Task_Entry_Call
-      --  will do the cancelation in that case.
-      --  ????? .....
-      --  Does the above still make sense?
+      --  If the acceptor is not callable, abort the call and return False.
 
       if not Acceptor.Callable then
          STPO.Unlock (Acceptor);
 
          if Parent_Locked then
-            STPO.Unlock (Acceptor.Common.Parent);
+            STPO.Unlock (Parent);
          end if;
 
          pragma Assert (Entry_Call.State < Done);
@@ -1269,6 +1180,7 @@ package body System.Tasking.Rendezvous is
          Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
          Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
          STPO.Unlock (Entry_Call.Self);
+
          return False;
       end if;
 
@@ -1291,7 +1203,6 @@ package body System.Tasking.Rendezvous is
                end if;
 
                if Acceptor.Terminate_Alternative then
-
                   --  Cancel terminate alternative.
                   --  See matching code in Selective_Wait and
                   --  Vulnerable_Complete_Master.
@@ -1307,8 +1218,8 @@ package body System.Tasking.Rendezvous is
 
                      Parent.Awake_Count := Parent.Awake_Count + 1;
 
-                     if Parent.Common.State = Master_Completion_Sleep and then
-                        Acceptor.Master_of_Task = Parent.Master_Within
+                     if Parent.Common.State = Master_Completion_Sleep
+                       and then Acceptor.Master_of_Task = Parent.Master_Within
                      then
                         Parent.Common.Wait_Count :=
                           Parent.Common.Wait_Count + 1;
@@ -1317,7 +1228,6 @@ package body System.Tasking.Rendezvous is
                end if;
 
                if Null_Body then
-
                   --  Rendezvous is over immediately.
 
                   STPO.Wakeup (Acceptor, Acceptor_Sleep);
@@ -1379,13 +1289,12 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Parent);
          end if;
 
-         if Old_State /= Entry_Call.State and then
-           Entry_Call.State = Now_Abortable and then
-           Entry_Call.Mode > Simple_Call and then
-
-            --  Asynchronous_Call or Conditional_Call
+         if Old_State /= Entry_Call.State
+           and then Entry_Call.State = Now_Abortable
+           and then Entry_Call.Mode > Simple_Call
+           and then Entry_Call.Self /= Self_ID
 
-           Entry_Call.Self /= Self_ID
+         --  Asynchronous_Call or Conditional_Call
 
          then
             --  Because of ATCB lock ordering rule
@@ -1437,6 +1346,10 @@ package body System.Tasking.Rendezvous is
       Entry_Call : Entry_Call_Link;
 
    begin
+      if Parameters.Runtime_Traces then
+         Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
+      end if;
+
       if Mode = Simple_Call or else Mode = Conditional_Call then
          Call_Synchronous
            (Acceptor, E, Uninterpreted_Data, Mode, Rendezvous_Successful);
@@ -1466,6 +1379,10 @@ package body System.Tasking.Rendezvous is
          Entry_Call.Called_PO := Null_Address;
          Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
 
+         if Single_Lock then
+            Lock_RTS;
+         end if;
+
          if not Task_Do_Or_Queue
            (Self_Id, Entry_Call, With_Abort => True)
          then
@@ -1473,7 +1390,17 @@ package body System.Tasking.Rendezvous is
             pragma Debug
               (Debug.Trace (Self_Id, "TEC: exited to ATC level: " &
                ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
+
+            if Single_Lock then
+               Unlock_RTS;
+            end if;
+
             Initialization.Undefer_Abort (Self_Id);
+
+            if Parameters.Runtime_Traces then
+               Send_Trace_Info (E_Missed, Acceptor);
+            end if;
+
             raise Tasking_Error;
          end if;
 
@@ -1488,6 +1415,10 @@ package body System.Tasking.Rendezvous is
             Entry_Calls.Wait_Until_Abortable (Self_Id, Entry_Call);
          end if;
 
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
          --  Note: following assignment needs to be atomic.
 
          Rendezvous_Successful := Entry_Call.State = Done;
@@ -1498,14 +1429,13 @@ package body System.Tasking.Rendezvous is
    -- Task_Entry_Caller --
    -----------------------
 
-   --  Compiler interface only.
-
    function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_ID is
       Self_Id    : constant Task_ID := STPO.Self;
       Entry_Call : Entry_Call_Link;
 
    begin
       Entry_Call := Self_Id.Common.Call;
+
       for Depth in 1 .. D loop
          Entry_Call := Entry_Call.Acceptor_Prev_Call;
          pragma Assert (Entry_Call /= null);
@@ -1518,8 +1448,6 @@ package body System.Tasking.Rendezvous is
    -- Timed_Selective_Wait --
    --------------------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-
    procedure Timed_Selective_Wait
      (Open_Accepts       : Accept_List_Access;
       Select_Mode        : Select_Modes;
@@ -1535,7 +1463,8 @@ package body System.Tasking.Rendezvous is
       Selection        : Select_Index;
       Open_Alternative : Boolean;
       Timedout         : Boolean := False;
-      Yielded          : Boolean := False;
+      Yielded          : Boolean := True;
+
    begin
       pragma Assert (Select_Mode = Delay_Mode);
 
@@ -1543,6 +1472,10 @@ package body System.Tasking.Rendezvous is
 
       --  If we are aborted here, the effect will be pending
 
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
       STPO.Write_Lock (Self_Id);
 
       if not Self_Id.Callable then
@@ -1551,6 +1484,11 @@ package body System.Tasking.Rendezvous is
          pragma Assert (Self_Id.Pending_Action);
 
          STPO.Unlock (Self_Id);
+
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
          Initialization.Undefer_Abort (Self_Id);
 
          --  Should never get here ???
@@ -1559,12 +1497,7 @@ package body System.Tasking.Rendezvous is
          raise Standard'Abort_Signal;
       end if;
 
-      --  If someone completed this task, this task should not try to
-      --  access its pending entry calls or queues in this case, as they
-      --  are being emptied. Wait for abortion to kill us.
-      --  ?????
-      --  Recheck the correctness of the above, now that we have made
-      --  changes.
+      Uninterpreted_Data := Null_Address;
 
       pragma Assert (Open_Accepts /= null);
 
@@ -1596,115 +1529,124 @@ package body System.Tasking.Rendezvous is
       --  Handle the select according to the disposition selected above.
 
       case Treatment is
+         when Accept_Alternative_Selected =>
+            --  Ready to rendezvous
+            --  In this case the accept body is not Null_Body. Defer abort
+            --  until it gets into the accept body.
 
-      when Accept_Alternative_Selected =>
-
-         --  Ready to rendezvous
-         --  In this case the accept body is not Null_Body. Defer abortion
-         --  until it gets into the accept body.
-
-         Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
-         Initialization.Defer_Abort (Self_Id);
-         STPO.Unlock (Self_Id);
-
-      when Accept_Alternative_Completed =>
+            Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
+            Initialization.Defer_Abort (Self_Id);
+            STPO.Unlock (Self_Id);
 
-         --  Rendezvous is over
+         when Accept_Alternative_Completed =>
+            --  Rendezvous is over
 
-         STPO.Unlock (Self_Id);
-         Caller := Entry_Call.Self;
+            if Parameters.Runtime_Traces then
+               Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
+            end if;
 
-         STPO.Write_Lock (Caller);
-         Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
-         STPO.Unlock (Caller);
+            STPO.Unlock (Self_Id);
+            Caller := Entry_Call.Self;
 
-      when Accept_Alternative_Open =>
+            STPO.Write_Lock (Caller);
+            Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+            STPO.Unlock (Caller);
 
-         --  Wait for caller.
+         when Accept_Alternative_Open =>
+            --  Wait for caller.
 
-         Self_Id.Open_Accepts := Open_Accepts;
+            Self_Id.Open_Accepts := Open_Accepts;
 
-         --  Wait for a normal call and a pending action until the
-         --  Wakeup_Time is reached.
+            --  Wait for a normal call and a pending action until the
+            --  Wakeup_Time is reached.
 
-         Self_Id.Common.State := Acceptor_Sleep;
+            Self_Id.Common.State := Acceptor_Sleep;
 
-         loop
-            Initialization.Poll_Base_Priority_Change (Self_Id);
-            exit when Self_Id.Open_Accepts = null;
+            loop
+               Initialization.Poll_Base_Priority_Change (Self_Id);
+               exit when Self_Id.Open_Accepts = null;
 
-            if Timedout then
-               Sleep (Self_Id, Acceptor_Sleep);
-            else
-               STPO.Timed_Sleep (Self_Id, Timeout, Mode,
-                 Acceptor_Sleep, Timedout, Yielded);
-            end if;
+               if Timedout then
+                  Sleep (Self_Id, Acceptor_Sleep);
+               else
+                  if Parameters.Runtime_Traces then
+                     Send_Trace_Info (WT_Select,
+                                      Self_Id,
+                                      Integer (Open_Accepts'Length),
+                                      Timeout);
+                  end if;
 
-            if Timedout then
-               Self_Id.Open_Accepts := null;
-            end if;
-         end loop;
+                  STPO.Timed_Sleep (Self_Id, Timeout, Mode,
+                    Acceptor_Sleep, Timedout, Yielded);
+               end if;
 
-         Self_Id.Common.State := Runnable;
+               if Timedout then
+                  Self_Id.Open_Accepts := null;
 
-         --  Self_Id.Common.Call should already be updated by the Caller if
-         --  not aborted. It might also be ready to do rendezvous even if
-         --  this wakes up due to an abortion.
-         --  Therefore, if the call is not empty we need to do the rendezvous
-         --  if the accept body is not Null_Body.
+                  if Parameters.Runtime_Traces then
+                     Send_Trace_Info (E_Timeout);
+                  end if;
+               end if;
+            end loop;
 
-         if Self_Id.Chosen_Index /= No_Rendezvous and then
-           Self_Id.Common.Call /= null and then
-           not Open_Accepts (Self_Id.Chosen_Index).Null_Body
-         then
-            Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
+            Self_Id.Common.State := Runnable;
 
-            pragma Assert (Self_Id.Deferral_Level = 1);
+            --  Self_Id.Common.Call should already be updated by the Caller if
+            --  not aborted. It might also be ready to do rendezvous even if
+            --  this wakes up due to an abortion.
+            --  Therefore, if the call is not empty we need to do the
+            --  rendezvous if the accept body is not Null_Body.
 
-            Initialization.Defer_Abort_Nestable (Self_Id);
+            if Self_Id.Chosen_Index /= No_Rendezvous
+              and then Self_Id.Common.Call /= null
+              and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
+            then
+               Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
 
-            --  Leave abort deferred until the accept body
+               pragma Assert (Self_Id.Deferral_Level = 1);
 
-         end if;
+               Initialization.Defer_Abort_Nestable (Self_Id);
 
-         STPO.Unlock (Self_Id);
-         if not Yielded then
-            Yield;
-         end if;
+               --  Leave abort deferred until the accept body
+            end if;
 
-      when No_Alternative_Open =>
+            STPO.Unlock (Self_Id);
 
-         --  In this case, Index will be No_Rendezvous on return. We sleep
-         --  for the time we need to.
-         --  Wait for a signal or timeout. A wakeup can be made
-         --  for several reasons:
-         --  1) Delay is expired
-         --  2) Pending_Action needs to be checked
-         --     (Abortion, Priority change)
-         --  3) Spurious wakeup
+         when No_Alternative_Open =>
+            --  In this case, Index will be No_Rendezvous on return. We sleep
+            --  for the time we need to.
+            --  Wait for a signal or timeout. A wakeup can be made
+            --  for several reasons:
+            --  1) Delay is expired
+            --  2) Pending_Action needs to be checked
+            --     (Abortion, Priority change)
+            --  3) Spurious wakeup
 
-         Self_Id.Open_Accepts := null;
-         Self_Id.Common.State := Acceptor_Sleep;
+            Self_Id.Open_Accepts := null;
+            Self_Id.Common.State := Acceptor_Sleep;
 
-         Initialization.Poll_Base_Priority_Change (Self_Id);
+            Initialization.Poll_Base_Priority_Change (Self_Id);
 
-         STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
-           Timedout, Yielded);
+            STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
+              Timedout, Yielded);
 
-         Self_Id.Common.State := Runnable;
+            Self_Id.Common.State := Runnable;
 
-         STPO.Unlock (Self_Id);
+            STPO.Unlock (Self_Id);
 
-         if not Yielded then
-            Yield;
-         end if;
+         when others =>
+            --  Should never get here
+            pragma Assert (False);
+            null;
+      end case;
 
-      when others =>
-         --  Should never get here ???
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
 
-         pragma Assert (False);
-         null;
-      end case;
+      if not Yielded then
+         Yield;
+      end if;
 
       --  Caller has been chosen
 
@@ -1717,15 +1659,12 @@ package body System.Tasking.Rendezvous is
       Initialization.Undefer_Abort_Nestable (Self_Id);
 
       --  Start rendezvous, if not already completed
-
    end Timed_Selective_Wait;
 
    ---------------------------
    -- Timed_Task_Entry_Call --
    ---------------------------
 
-   --  Compiler interface only.  Do not call from within the RTS.
-
    procedure Timed_Task_Entry_Call
      (Acceptor              : Task_ID;
       E                     : Task_Entry_Index;
@@ -1737,6 +1676,7 @@ package body System.Tasking.Rendezvous is
       Self_Id    : constant Task_ID := STPO.Self;
       Level      : ATC_Level;
       Entry_Call : Entry_Call_Link;
+      Yielded    : Boolean;
 
    begin
       Initialization.Defer_Abort (Self_Id);
@@ -1746,6 +1686,11 @@ package body System.Tasking.Rendezvous is
         (Debug.Trace (Self_Id, "TTEC: entered ATC level: " &
          ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
 
+      if Parameters.Runtime_Traces then
+         Send_Trace_Info (WT_Call, Acceptor,
+                          Entry_Index (E), Timeout);
+      end if;
+
       Level := Self_Id.ATC_Nesting_Level;
       Entry_Call := Self_Id.Entry_Calls (Level)'Access;
       Entry_Call.Next := null;
@@ -1770,6 +1715,10 @@ package body System.Tasking.Rendezvous is
 
       --  Note: the caller will undefer abortion on return (see WARNING above)
 
+      if Single_Lock then
+         Lock_RTS;
+      end if;
+
       if not Task_Do_Or_Queue
        (Self_Id, Entry_Call, With_Abort => True)
       then
@@ -1779,12 +1728,29 @@ package body System.Tasking.Rendezvous is
            (Debug.Trace (Self_Id, "TTEC: exited to ATC level: " &
             ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
 
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
+
          Initialization.Undefer_Abort (Self_Id);
+
+         if Parameters.Runtime_Traces then
+            Send_Trace_Info (E_Missed, Acceptor);
+         end if;
          raise Tasking_Error;
       end if;
 
+      Write_Lock (Self_Id);
       Entry_Calls.Wait_For_Completion_With_Timeout
-        (Self_Id, Entry_Call, Timeout, Mode);
+        (Entry_Call, Timeout, Mode, Yielded);
+      Unlock (Self_Id);
+
+      if Single_Lock then
+         Unlock_RTS;
+      end if;
+
+      --  ??? Do we need to yield in case Yielded is False
+
       Rendezvous_Successful := Entry_Call.State = Done;
       Initialization.Undefer_Abort (Self_Id);
       Entry_Calls.Check_Exception (Self_Id, Entry_Call);