home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / s-tassta.adb < prev    next >
Text File  |  1996-09-28  |  30KB  |  928 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  4. --                                                                          --
  5. --                 S Y S T E M . T A S K I N G . S T A G E S                --
  6. --                                                                          --
  7. --                                  B o d y                                 --
  8. --                                                                          --
  9. --                             $Revision: 1.42 $                            --
  10. --                                                                          --
  11. --      Copyright (c) 1991,1992,1993,1994,1995 FSU, All Rights Reserved     --
  12. --                                                                          --
  13. -- GNARL is free software; you can redistribute it  and/or modify it  under --
  14. -- terms  of  the  GNU  Library General Public License  as published by the --
  15. -- Free Software  Foundation;  either version 2, or (at  your  option)  any --
  16. -- later  version.  GNARL is distributed  in the hope that  it will be use- --
  17. -- ful, but but WITHOUT ANY WARRANTY;  without even the implied warranty of --
  18. -- MERCHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
  19. -- eral Library Public License  for more details.  You should have received --
  20. -- a  copy of the GNU Library General Public License along with GNARL;  see --
  21. -- file COPYING.LIB.  If not,  write to the  Free Software Foundation,  675 --
  22. -- Mass Ave, Cambridge, MA 02139, USA.                                      --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Ada.Finalization;
  27. --  used to ensure that Complete_Task is called at the end of the program
  28.  
  29. with System.Compiler_Exceptions;
  30. --  Used for,  Compiler_Exceptions.Notify_Exception
  31. --             Null_Exception
  32.  
  33. with System.Compiler_Options;
  34. --  Used for, Main_Priority
  35.  
  36. --  The following two packages are not part of the GNARL proper.  They
  37. --  provide access to a compiler-specific per-task data area.
  38.  
  39. with System.Tasking_Soft_Links;
  40. --  Used for, Abort_Defer, Abort_Undefer, Get_TSD_Address
  41. --  These are procedure pointers to non-tasking routines that use
  42. --  task specific data.  In the absence of tasking, these routines
  43. --  refer to global data.  In the presense of tasking, they must be
  44. --  replaced with pointers to task-specific versions.
  45.  
  46. with System.Task_Specific_Data;
  47. --  Used for, Create_TSD, Destroy_TSD
  48. --  This package provides initialization routines for task specific data.
  49. --  The GNARL must call these to be sure that all non-tasking
  50. --  Ada constructs will work.
  51.  
  52. with System.Tasking.Utilities;
  53. --  Used for, Utilities.ATCB_To_Address
  54. --            Utilities.Task_Error
  55. --            Utilities.Vulnerable_Complete_Activation
  56. --            Utilities.Abort_To_Level
  57. --            Utilities.Abort_Dependents
  58. --            Utilities.Check_Exceptions
  59. --            Utilities.Runtime_Assert_Shutdown
  60.  
  61. with System.Tasking.Initialization;
  62. --  Used for, Remove_From_All_Tasks_List
  63. --            All_Tasks_List
  64. --            All_Tasks_L
  65. --            Defer_Abortion,
  66. --            Undefer_Abortion,
  67. --            Change_Base_Priority
  68. --            ATCB_Init
  69.  
  70. pragma Elaborate_All (System.Tasking.Initialization);
  71. --  This insures that tasking is initialized if any tasks are created.
  72.  
  73. with System.Task_Memory;
  74. --  Used for, Task_Memory.Low_Level_New,
  75. --            Task_Memory.Unsafe_Low_Level_New,
  76. --            Task_Memory.Low_Level_Free
  77.  
  78. with System.Task_Primitives; use System.Task_Primitives;
  79.  
  80. with Unchecked_Conversion;
  81. with Unchecked_Deallocation;
  82.  
  83. package body System.Tasking.Stages is
  84.  
  85.    Global_Task_Lock : Lock;
  86.    --  This is a global lock; it is used to execute in mutual exclusion
  87.    --  from all other tasks.  It is only used by Task_Lock and
  88.    --  Task_Unlock.
  89.  
  90.    procedure Defer_Abortion renames
  91.      System.Tasking.Initialization.Defer_Abortion;
  92.  
  93.    procedure Undefer_Abortion renames
  94.      System.Tasking.Initialization.Undefer_Abortion;
  95.  
  96.    function Get_TSD_Address (Dummy : Boolean) return Address;
  97.    --  This procedure returns the task-specific data pointer installed at
  98.    --  task creation time by the GNARL on behalf of the compiler.  A pointer
  99.    --  to this routine replaces the default pointer installed for the
  100.    --  non-tasking case.
  101.    --  The dummy parameter avoids a bug in GNAT.
  102.  
  103.    -----------------------------
  104.    -- Other Local Subprograms --
  105.    -----------------------------
  106.  
  107.    procedure Task_Wrapper (Arg : System.Address);
  108.    --  This is the procedure that is called by the GNULL from the
  109.    --  new context when a task is created.  It waits for activation
  110.    --  and then calls the task body procedure.  When the task body
  111.    --  procedure completes, it terminates the task.
  112.  
  113.    procedure Terminate_Dependents (ML : Master_ID := Master_ID'First);
  114.    --  Terminate all dependent tasks of given master level
  115.  
  116.    procedure Vulnerable_Complete_Task;
  117.    --  Complete the calling task.  This procedure must be called with
  118.    --  abortion deferred.
  119.  
  120.    -----------------------------
  121.    -- Finalization management --
  122.    -----------------------------
  123.  
  124.    type Final is new Ada.Finalization.Controlled with null record;
  125.    procedure Finalize (Object : in out Final);
  126.  
  127.    Task_Finalization_Object : Final;
  128.    --  The only purpose of this object is to force a call to Finalize at the
  129.    --  end of the program
  130.  
  131.    procedure Finalize (Object : in out Final) is
  132.    begin
  133.  
  134.       Complete_Task;
  135.       --  All tasks must be complete before shutting down tasking services.
  136.  
  137.       System.Tasking_Soft_Links.Abort_Defer :=
  138.         System.Tasking_Soft_Links.Abort_Defer_NT'Access;
  139.       System.Tasking_Soft_Links.Abort_Undefer :=
  140.         System.Tasking_Soft_Links.Abort_Undefer_NT'Access;
  141.       System.Tasking_Soft_Links.Get_TSD_Address :=
  142.         System.Tasking_Soft_Links.Get_TSD_Address_NT'Access;
  143.       System.Tasking_Soft_Links.Lock_Task :=
  144.         System.Tasking_Soft_Links.Task_Lock_NT'Access;
  145.       System.Tasking_Soft_Links.Unlock_Task :=
  146.         System.Tasking_Soft_Links.Task_Unlock_NT'Access;
  147.       System.Tasking_Soft_Links.SS_Init :=
  148.         System.Tasking_Soft_Links.SS_Init_NT'Access;
  149.       System.Tasking_Soft_Links.SS_Free :=
  150.         System.Tasking_Soft_Links.SS_Free_NT'Access;
  151.       Finalize_Lock (System.Tasking.Initialization.All_Tasks_L);
  152.       Finalize_Lock (Global_Task_Lock);
  153.  
  154.    end Finalize;
  155.  
  156.    ---------------------
  157.    -- Get_TSD_Address --
  158.    ---------------------
  159.  
  160.    function Get_TSD_Address (Dummy : Boolean) return Address is
  161.       T : Task_ID := Self;
  162.    begin
  163.       return T.Compiler_Data;
  164.    end Get_TSD_Address;
  165.  
  166.    ------------------
  167.    -- Task_Wrapper --
  168.    ------------------
  169.  
  170.    procedure Task_Wrapper (Arg : System.Address) is
  171.       function Address_To_Task_ID is new
  172.         Unchecked_Conversion (System.Address, Task_ID);
  173.       T : Task_ID := Address_To_Task_ID (Arg);
  174.  
  175.    begin
  176.  
  177.       Undefer_Abortion;
  178.  
  179.       --  Call the task body procedure.
  180.  
  181.       T.Task_Entry_Point (T.Task_Arg);
  182.       --  Return here after task finalization
  183.  
  184.       Defer_Abortion;
  185.  
  186.       --  This call won't return. Therefor no need for Undefer_Abortion
  187.  
  188.       Stages.Leave_Task;
  189.  
  190.    exception
  191.  
  192.    --  Only the call to user code (T.Task_Entry_Point) should raise an
  193.    --  exception.  An "at end" handler in the generated code should have
  194.    --  completed the the task, and the exception should not be propagated
  195.    --  further.  Terminate the task as though it had returned.
  196.  
  197.    when Standard'Abort_Signal =>
  198.       Defer_Abortion;
  199.       Stages.Leave_Task;
  200.    when others =>
  201.       Defer_Abortion;
  202.       Stages.Leave_Task;
  203.    end Task_Wrapper;
  204.  
  205.    -----------------
  206.    -- Create_Task --
  207.    -----------------
  208.  
  209.    procedure Create_Task
  210.      (Size          : Size_Type;
  211.       Priority      : Integer;
  212.       Num_Entries   : Task_Entry_Index;
  213.       Master        : Master_ID;
  214.       State         : Task_Procedure_Access;
  215.       Discriminants : System.Address;
  216.       Elaborated    : Access_Boolean;
  217.       Chain         : in out Activation_Chain;
  218.       Created_Task  : out Task_ID)
  219.    is
  220.  
  221.       T, P, S            : Task_ID;
  222.       Init               : System.Tasking.Initialization.ATCB_Init;
  223.       Default_Stack_Size : constant Size_Type := 10000;
  224.       Error              : Boolean;
  225.  
  226.    begin
  227.       S := Self;
  228.  
  229.       if Priority = Unspecified_Priority then
  230.          Init.Priority := Default_Priority;
  231.       else
  232.          Init.Priority := Priority;
  233.       end if;
  234.  
  235.       --  Find parent of new task, P, via master level number.
  236.  
  237.       P := S;
  238.       if P /= null then
  239.          while P.Master_of_Task >= Master loop
  240.             P := P.Parent;
  241.             exit when P = null;
  242.          end loop;
  243.       end if;
  244.  
  245.       Defer_Abortion;
  246.  
  247.       if P /= null then
  248.          Write_Lock (P.L, Error);
  249.  
  250.          if P /= S
  251.            and then P.Awaited_Dependent_Count /= 0
  252.            and then Master = P.Master_Within
  253.          then
  254.             P.Awaited_Dependent_Count := P.Awaited_Dependent_Count + 1;
  255.          end if;
  256.  
  257.          P.Awake_Count := P.Awake_Count + 1;
  258.          Unlock (P.L);
  259.       end if;
  260.  
  261.       Undefer_Abortion;
  262.  
  263.       Init.Entry_Num := Num_Entries;
  264.       Init.Task_Arg := Discriminants;
  265.       Init.Parent := P;
  266.       Init.Task_Entry_Point := State;
  267.  
  268.       if Size = Unspecified_Size then
  269.          Init.Stack_Size := Default_Stack_Size;
  270.       else
  271.          Init.Stack_Size := Size;
  272.       end if;
  273.  
  274.       Init.Activator := S;
  275.       Init.Master_of_Task := Master;
  276.       Init.Elaborated := Elaborated;
  277.       T := System.Tasking.Initialization.New_ATCB (Init);
  278.  
  279.       T.Compiler_Data := Task_Specific_Data.Create_TSD;
  280.       --  This needs to be done as early as possible in the creation
  281.       --  of a task, since the operation of Ada code within the task may
  282.       --  depend on task specific data.
  283.  
  284.       T.Activation_Link := Task_ID (Chain);
  285.       Chain := Activation_Chain (T);
  286.  
  287.       T.Aborter_Link := null;
  288.  
  289.       Created_Task := T;
  290.    end Create_Task;
  291.  
  292.    --------------------
  293.    -- Activate_Tasks --
  294.    --------------------
  295.  
  296.    procedure Activate_Tasks (Chain_Access : Activation_Chain_Access) is
  297.       This_Task      : Task_ID;
  298.       C              : Task_ID;
  299.       All_Elaborated : Boolean := True;
  300.       LL_Entry_Point : Task_Primitives.LL_Task_Procedure_Access;
  301.       Error          : Boolean;
  302.  
  303.    begin
  304.       This_Task := Self;
  305.  
  306.       C := Task_ID (Chain_Access.all);
  307.       while (C /= null) and All_Elaborated loop
  308.          if C.Elaborated /= null and then not C.Elaborated.all then
  309.             All_Elaborated := False;
  310.          end if;
  311.  
  312.          C := C.Activation_Link;
  313.       end loop;
  314.  
  315.       --  Check that all task bodies have been elaborated.
  316.  
  317.       if not All_Elaborated then
  318.          raise Program_Error;
  319.       end if;
  320.  
  321.       Defer_Abortion;
  322.  
  323.       Write_Lock (This_Task.L, Error);
  324.       This_Task.Activation_Count := 0;
  325.  
  326.       --  Wake up all the tasks so that they can activate themselves.
  327.  
  328.       LL_Entry_Point := Task_Wrapper'Access;
  329.  
  330.       C := Task_ID (Chain_Access.all);
  331.       while C /= null loop
  332.  
  333.          Write_Lock (C.L, Error);
  334.  
  335.          --  Note that the locks of the activator and created task are locked
  336.          --  here.  This is necessary because C.Stage and
  337.          --  This_Task.Activation_Count have to be synchronized.  This is also
  338.          --  done in Complete_Activation and Init_Abortion.  So long as the
  339.          --  activator lock is always locked first, this cannot lead to
  340.          --  deadlock.
  341.  
  342.          if C.Stage = Created then
  343.  
  344.             --  Create the task
  345.             --  Actual creation of LL_Task is deferred until the activation
  346.             --  time
  347.  
  348.             --  Ask for 4 extra bytes of stack space so that the ATCB
  349.             --  pointer can be stored below the stack limit, plus extra
  350.             --  space for the frame of Task_Wrapper.  This is so the use
  351.             --  gets the amount of stack requested exclusive of the needs
  352.             --  of the runtime.
  353.  
  354.             Create_LL_Task (
  355.               System.Priority (C.Current_Priority),
  356.               Task_Primitives.Task_Storage_Size (
  357.               Integer (C.Stack_Size) +
  358.               Integer (Task_Primitives.Task_Wrapper_Frame) + 4),
  359.               LL_Entry_Point,
  360.               Utilities.ATCB_To_Address (C),
  361.               C.LL_TCB'Access);
  362.  
  363.             C.Stage := Can_Activate;
  364.             This_Task.Activation_Count := This_Task.Activation_Count + 1;
  365.  
  366.          end if;
  367.  
  368.          Unlock (C.L);
  369.  
  370.          C := C.Activation_Link;
  371.       end loop;
  372.  
  373.       while This_Task.Activation_Count > 0 loop
  374.          if This_Task.Pending_Action then
  375.             if This_Task.Pending_Priority_Change then
  376.                System.Tasking.Initialization.Change_Base_Priority (This_Task);
  377.             end if;
  378.  
  379.             exit when
  380.                This_Task.Pending_ATC_Level < This_Task.ATC_Nesting_Level;
  381.             This_Task.Pending_Action := False;
  382.          end if;
  383.          Cond_Wait (This_Task.Cond, This_Task.L);
  384.       end loop;
  385.  
  386.       Unlock (This_Task.L);
  387.  
  388.       Chain_Access.all := null;
  389.       --  After the activation, tasks should be removed from the Chain
  390.  
  391.       Undefer_Abortion;
  392.       Utilities.Check_Exception;
  393.    end Activate_Tasks;
  394.  
  395.    -------------------------------
  396.    -- Expunge_Unactivated_Tasks --
  397.    -------------------------------
  398.  
  399.    procedure Expunge_Unactivated_Tasks (Chain : in out Activation_Chain) is
  400.       This_Task      : Task_ID := Self;
  401.       C              : Task_ID;
  402.       Temp           : Task_ID;
  403.       Result         : Boolean;
  404.    begin
  405.  
  406.       Defer_Abortion;
  407.  
  408.       C := Task_ID (Chain);
  409.  
  410.       while C /= null loop
  411.  
  412.          pragma Assert (
  413.            C.Stage <= Created or else
  414.              Utilities.Runtime_Assert_Shutdown (
  415.                "Trying to expunge task which went beyond CREATED stage"));
  416.  
  417.          Temp := C;
  418.          C := C.Activation_Link;
  419.  
  420.          Utilities.Complete (Temp);
  421.          --  This will take care of decrementing parent's Await_Count and
  422.          --  Awaited_Dependent_Count.
  423.  
  424.          System.Tasking.Initialization.Remove_From_All_Tasks_List
  425.            (Temp, Result);
  426.          pragma Assert (
  427.            Result or else Utilities.Runtime_Assert_Shutdown (
  428.              "Mismatch between All_Tasks_List and Chain to be expunged"));
  429.  
  430.          System.Tasking.Initialization.Free_ATCB (Temp);
  431.          --  Task is out of Chain and All_Tasks_List. It is now safe to
  432.          --  free the storage for ATCB.
  433.  
  434.       end loop;
  435.  
  436.       Chain := null;
  437.  
  438.       Undefer_Abortion;
  439.  
  440.    end Expunge_Unactivated_Tasks;
  441.  
  442.    --------------------
  443.    -- Current_Master --
  444.    --------------------
  445.  
  446.    function Current_Master return Master_ID is
  447.       T : Task_ID := Self;
  448.    begin
  449.       return T.Master_Within;
  450.    end Current_Master;
  451.  
  452.    ------------------------------
  453.    -- Vulnerable_Complete_Task --
  454.    ------------------------------
  455.  
  456.    --  WARNING : Only call this procedure with abortion deferred.
  457.    --  That's why the name has "Vulnerable" in it.
  458.  
  459.    --  This procedure needs to have abortion deferred while it has the current
  460.    --  task's lock locked.
  461.  
  462.    --  This procedure should be called to complete the current task.  This
  463.    --  should be done for:
  464.    --    normal termination via completion;
  465.    --    termination via unhandled exception;
  466.    --    terminate alternative;
  467.    --    abortion.
  468.  
  469.    procedure Vulnerable_Complete_Task is
  470.       P, T            : Task_ID := Self;
  471.       C               : Task_ID;
  472.       Never_Activated : Boolean;
  473.       Error           : Boolean;
  474.  
  475.    begin
  476.       --  T.Stage can be safely checked for Can_Activate here without
  477.       --  protection, since T does not get to run until Stage is Can_Activate,
  478.       --  and Vulnerable_Complete_Activation will check to see if it has moved
  479.       --  beyond Complete_Activation under the protection of the mutex
  480.       --  before decrementing the activator's Activation_Count.
  481.  
  482.       if T.Stage = Can_Activate then
  483.          Utilities.Vulnerable_Complete_Activation (T, Completed => True);
  484.       end if;
  485.  
  486.       --  Note that abortion is deferred (see WARNING above)
  487.  
  488.       Utilities.Complete (T);
  489.       if T.Stage = Created then
  490.          T.Stage := Terminated;
  491.       end if;
  492.  
  493.       Write_Lock (T.L, Error);
  494.  
  495.       --  If the task has been awakened due to abortion, this should
  496.       --  cause the dependents to abort themselves and cause the awake
  497.       --  count to go to zero.
  498.  
  499.       if T.Pending_ATC_Level < T.ATC_Nesting_Level
  500.         and then T.Awake_Count /= 0
  501.       then
  502.          Unlock (T.L);
  503.          Utilities.Abort_Dependents (T);
  504.          Write_Lock (T.L, Error);
  505.       end if;
  506.  
  507.       --  At this point we want to complete tasks created by T and not yet
  508.       --  activated, and also mark those tasks as terminated.
  509.  
  510.       Unlock (T.L);
  511.       Write_Lock (System.Tasking.Initialization.All_Tasks_L, Error);
  512.  
  513.       C := System.Tasking.Initialization.All_Tasks_List;
  514.  
  515.       while C /= null loop
  516.  
  517.          if C.Parent = T and then C.Stage = Created then
  518.             Utilities.Complete (C);
  519.             C.Stage := Terminated;
  520.          end if;
  521.  
  522.          C := C.All_Tasks_Link;
  523.       end loop;
  524.  
  525.       Unlock (System.Tasking.Initialization.All_Tasks_L);
  526.       Write_Lock (T.L, Error);
  527.  
  528.       while T.Awake_Count /= 0 loop
  529.          Cond_Wait (T.Cond, T.L);
  530.  
  531.          if T.Pending_ATC_Level < T.ATC_Nesting_Level
  532.            and then T.Awake_Count /= 0
  533.          then
  534.             --  The task may have been awakened to perform abortion.
  535.  
  536.             Unlock (T.L);
  537.             Utilities.Abort_Dependents (T);
  538.             Write_Lock (T.L, Error);
  539.          end if;
  540.       end loop;
  541.  
  542.       Unlock (T.L);
  543.       Terminate_Dependents;
  544.  
  545.    end Vulnerable_Complete_Task;
  546.  
  547.    ----------------
  548.    -- Leave_Task --
  549.    ----------------
  550.  
  551.    procedure Leave_Task is
  552.       P, T                    : Task_ID := Self;
  553.       Saved_Pending_ATC_Level : ATC_Level_Base;
  554.       Error                   : Boolean;
  555.  
  556.    begin
  557.       Saved_Pending_ATC_Level := T.Pending_ATC_Level;
  558.  
  559.       --  We are about to lose our ATCB. Save special fields for final cleanup.
  560.  
  561.       P := T.Parent;
  562.  
  563.       if P /= null then
  564.          Write_Lock (P.L, Error);
  565.          Write_Lock (T.L, Error);
  566.  
  567.          --  If T has a parent, then setting T.Stage to Terminated and
  568.          --  incrementing/decrementing P.Terminating_Dependent_Count
  569.          --  have to be synchronized here and in Terminate_Dependents.
  570.          --  This is done by locking the parent and dependent locks.  So
  571.          --  long as the parent lock is always locked first, this should not
  572.          --  cause deadlock.
  573.  
  574.          T.Stage := Terminated;
  575.  
  576.          if P.Terminating_Dependent_Count > 0
  577.            and then T.Master_of_Task = P.Master_Within
  578.          then
  579.             P.Terminating_Dependent_Count := P.Terminating_Dependent_Count - 1;
  580.  
  581.             if P.Terminating_Dependent_Count = 0 then
  582.                Cond_Signal (P.Cond);
  583.             end if;
  584.          end if;
  585.  
  586.          Task_Specific_Data.Destroy_TSD (T.Compiler_Data);
  587.          --  This should be the last thing done to a TCB, since the correct
  588.          --  operation of compiled code may depend on it.
  589.  
  590.          Unlock (T.L);
  591.          Unlock (P.L);
  592.  
  593.          --  WARNING - Once this lock is unlocked, it should be assumed that
  594.          --  the ATCB has been deallocated. It should not be accessed again.
  595.  
  596.       else
  597.          Write_Lock (T.L, Error);
  598.          T.Stage := Terminated;
  599.  
  600.          Task_Specific_Data.Destroy_TSD (T.Compiler_Data);
  601.          --  This should be the last thing done to a TCB, since the correct
  602.          --  operation of compiled code may depend on it.
  603.  
  604.          Unlock (T.L);
  605.       end if;
  606.  
  607.       Exit_LL_Task;
  608.  
  609.    end Leave_Task;
  610.  
  611.    -------------------
  612.    -- Complete_Task --
  613.    -------------------
  614.  
  615.    procedure Complete_Task is
  616.    begin
  617.       Defer_Abortion;
  618.       Vulnerable_Complete_Task;
  619.       Undefer_Abortion;
  620.    end Complete_Task;
  621.  
  622.    -------------------------
  623.    -- Complete_Activation --
  624.    -------------------------
  625.  
  626.    procedure Complete_Activation is
  627.       Dummy : Boolean;
  628.    begin
  629.       Defer_Abortion;
  630.  
  631.       Utilities.Vulnerable_Complete_Activation
  632.         (Self, Completed => False);
  633.  
  634.       Undefer_Abortion;
  635.    end Complete_Activation;
  636.  
  637.    --------------------------
  638.    -- Terminate_Dependents --
  639.    --------------------------
  640.  
  641.    --  WARNING : Only call this procedure with abortion deferred.
  642.    --  This procedure needs to have abortion deferred while it has
  643.    --  the current task's lock locked.  This is indicated by the commented
  644.    --  abortion control calls.  Since it is called from two procedures which
  645.    --  also need abortion deferred, it is left controlled on entry to
  646.    --  this procedure.
  647.    --
  648.    --  This relies that all dependents are passive.
  649.    --  That is, they may be :
  650.  
  651.    --  1) held in COMPLETE_TASK;
  652.    --  2) aborted, with forced-call to COMPLETE_TASK pending;
  653.    --  3) held in terminate-alternative of SELECT.
  654.  
  655.    procedure Terminate_Dependents (ML : Master_ID := Master_ID'First) is
  656.       Failed   : Boolean;
  657.       Taken    : Boolean;
  658.       T        : Task_ID := Self;
  659.       C        : Task_ID;
  660.       Previous : Task_ID;
  661.       Temp     : Task_ID;
  662.       Error    : Boolean;
  663.  
  664.    begin
  665.       Write_Lock (System.Tasking.Initialization.All_Tasks_L, Error);
  666.  
  667.       --  Abortion is deferred already (see WARNING above)
  668.  
  669.       Write_Lock (T.L, Error);
  670.  
  671.       --  Count the number of active dependents that must terminate before
  672.       --  proceeding.  If Terminating_Dependent_Count is not zero, then the
  673.       --  dependents have already been counted.  This can occur when a thread
  674.       --  executing this routine is canceled and the cancellation takes effect
  675.       --  when Cond_Wait is called to wait for Terminating_Dependent_Count to
  676.       --  go to zero.  In this case we just skip the count and continue waiting
  677.       --  for the count to go to zero.
  678.  
  679.       if T.Terminating_Dependent_Count = 0 then
  680.          C := System.Tasking.Initialization.All_Tasks_List;
  681.  
  682.          while C /= null loop
  683.  
  684.             --  The check for C.Stage=ATCB.Terminated and the increment of
  685.             --  T.Terminating_Dependent_Count must be synchronized here and in
  686.             --  Complete_Task using T.L and C.L.  So long as the parent T
  687.             --  is locked before the dependent C, this should not lead to
  688.             --  deadlock.
  689.  
  690.             if C /= T then
  691.                Write_Lock (C.L, Error);
  692.  
  693.                if C.Parent = T
  694.                  and then C.Master_of_Task >= ML
  695.                  and then C.Stage /= Terminated
  696.                then
  697.                   T.Terminating_Dependent_Count :=
  698.                     T.Terminating_Dependent_Count + 1;
  699.                end if;
  700.  
  701.                Unlock (C.L);
  702.             end if;
  703.  
  704.             C := C.All_Tasks_Link;
  705.          end loop;
  706.       end if;
  707.  
  708.       Unlock (T.L);
  709.  
  710.       C := System.Tasking.Initialization.All_Tasks_List;
  711.  
  712.       while C /= null loop
  713.          if C.Parent = T and then C.Master_of_Task >= ML then
  714.             Utilities.Complete (C);
  715.             Cond_Signal (C.Cond);
  716.          end if;
  717.  
  718.          C := C.All_Tasks_Link;
  719.       end loop;
  720.  
  721.       Unlock (System.Tasking.Initialization.All_Tasks_L);
  722.  
  723.       Write_Lock (T.L, Error);
  724.  
  725.       while T.Terminating_Dependent_Count /= 0 loop
  726.          Cond_Wait (T.Cond, T.L);
  727.       end loop;
  728.  
  729.       Unlock (T.L);
  730.  
  731.       --  We don't wake up for abortion here, since we are already
  732.       --  terminating just as fast as we can so there is no point.
  733.  
  734.       Write_Lock (System.Tasking.Initialization.All_Tasks_L, Error);
  735.       C := System.Tasking.Initialization.All_Tasks_List;
  736.       Previous := null;
  737.  
  738.       while C /= null loop
  739.          if C.Parent = T
  740.            and then C.Master_of_Task >= ML
  741.          then
  742.             if Previous /= null then
  743.                Previous.All_Tasks_Link := C.All_Tasks_Link;
  744.             else
  745.                System.Tasking.Initialization.All_Tasks_List :=
  746.                  C.All_Tasks_Link;
  747.             end if;
  748.  
  749.             Temp := C;
  750.             C := C.All_Tasks_Link;
  751.             System.Tasking.Initialization.Free_ATCB (Temp);
  752.  
  753.             --  It is OK to free the ATCB provided that the dependent task
  754.             --  does not access its ATCB in Complete_Task after signaling its
  755.             --  parent's (this task) condition variable and unlocking its lock.
  756.  
  757.          else
  758.             Previous := C;
  759.             C := C.All_Tasks_Link;
  760.          end if;
  761.       end loop;
  762.  
  763.       Unlock (System.Tasking.Initialization.All_Tasks_L);
  764.    end Terminate_Dependents;
  765.  
  766.    ------------------
  767.    -- Enter_Master --
  768.    ------------------
  769.  
  770.    procedure Enter_Master is
  771.       T : Task_ID := Self;
  772.  
  773.    begin
  774.       T.Master_Within :=
  775.         System.Tasking.Initialization.Increment_Master (T.Master_Within);
  776.    end Enter_Master;
  777.  
  778.    ---------------------
  779.    -- Complete_Master --
  780.    ---------------------
  781.  
  782.    procedure Complete_Master is
  783.       T          : Task_ID := Self;
  784.       C          : Task_ID;
  785.       CM         : Master_ID := T.Master_Within;
  786.       Taken      : Boolean;
  787.       Asleep     : Boolean;
  788.       TAS_Result : Boolean;
  789.       Error      : Boolean;
  790.  
  791.    begin
  792.       Defer_Abortion;
  793.  
  794.       Write_Lock (System.Tasking.Initialization.All_Tasks_L, Error);
  795.  
  796.       --  Cancel threads of dependent tasks that have not yet started
  797.       --  activation.
  798.  
  799.       C := System.Tasking.Initialization.All_Tasks_List;
  800.  
  801.       while C /= null loop
  802.          if C.Parent = T and then C.Master_of_Task = CM then
  803.             Write_Lock (C.L, Error);
  804.  
  805.             --  The only way that a dependent should not have been activated
  806.             --  at this point is if the master was aborted before it could
  807.             --  call Activate_Tasks.  Abort such dependents.
  808.  
  809.             if C.Stage = Created then
  810.                Unlock (C.L);
  811.                Utilities.Complete (C);
  812.                C.Stage := Terminated;
  813.                --  Task is not yet activated. So, just complete and
  814.                --  Mark it as Terminated.
  815.             else
  816.                Unlock (C.L);
  817.             end if;
  818.  
  819.          end if;
  820.  
  821.          C := C.All_Tasks_Link;
  822.       end loop;
  823.  
  824.       --  Note that Awaited_Dependent_Count must be zero at this point.  It is
  825.       --  initialized to zero, this is the only code that can increment it
  826.       --  when it is zero, and it will be zero again on exit from this routine.
  827.  
  828.       Write_Lock (T.L, Error);
  829.       C := System.Tasking.Initialization.All_Tasks_List;
  830.  
  831.       while C /= null loop
  832.          if C.Parent = T and then C.Master_of_Task = CM then
  833.             Write_Lock (C.L, Error);
  834.  
  835.             if C.Awake_Count /= 0 then
  836.                T.Awaited_Dependent_Count := T.Awaited_Dependent_Count + 1;
  837.             end if;
  838.  
  839.             Unlock (C.L);
  840.          end if;
  841.  
  842.          C := C.All_Tasks_Link;
  843.       end loop;
  844.  
  845.       Unlock (T.L);
  846.       --  Unlock T.L here to avoid improper lock nesting; All_Tasks_L
  847.       --  is always the outer lock to avoid deadlock, so we have to
  848.       --  unlock T.L before unlocking All_Tasks_L.
  849.  
  850.       Unlock (System.Tasking.Initialization.All_Tasks_L);
  851.  
  852.       Write_Lock (T.L, Error);
  853.  
  854.       --  If the task has been awakened due to abortion, this should
  855.       --  cause the dependents to abort themselves and cause
  856.       --  Awaited_Dependent_Count count to go to zero.
  857.  
  858.       if T.Pending_ATC_Level < T.ATC_Nesting_Level
  859.         and then T.Awaited_Dependent_Count /= 0
  860.       then
  861.          Unlock (T.L);
  862.          Utilities.Abort_Dependents (T);
  863.          Write_Lock (T.L, Error);
  864.       end if;
  865.  
  866.       if T.Awaited_Dependent_Count /= 0 then
  867.          T.Stage := Await_Dependents;
  868.       end if;
  869.  
  870.       while T.Awaited_Dependent_Count /= 0 loop
  871.          Cond_Wait (T.Cond, T.L);
  872.  
  873.          if T.Pending_ATC_Level < T.ATC_Nesting_Level
  874.            and then T.Awaited_Dependent_Count /= 0
  875.          then
  876.             --  The task may have been awakened to perform abortion.
  877.  
  878.             Unlock (T.L);
  879.             Utilities.Abort_Dependents (T);
  880.             Write_Lock (T.L, Error);
  881.          end if;
  882.  
  883.       end loop;
  884.  
  885.       Unlock (T.L);
  886.  
  887.       if T.Pending_ATC_Level < T.ATC_Nesting_Level then
  888.          Undefer_Abortion;
  889.          return;
  890.          --  Abort_Signal should be raised upon exit from at_end handler
  891.       end if;
  892.  
  893.       Terminate_Dependents (CM);
  894.  
  895.       T.Stage := Active;
  896.  
  897.       --  Make next master level up active.  This needs to be done before
  898.       --  decrementing the master level number, so that tasks finding
  899.       --  themselves dependent on the current master level do not think that
  900.       --  this master has been terminated (i.e. Stage=Await_Dependents and
  901.       --  Awaited_Dependent_Count=0).  This should be safe; the only thing that
  902.       --  can affect the stage of a task after it has become active is either
  903.       --  the task itself or abortion, which is deferred here.
  904.  
  905.       T.Master_Within := System.Tasking.Initialization.Decrement_Master (CM);
  906.  
  907.       --  Should not need protection; can only change if T executes an
  908.       --  Enter_Master or a Complete_Master.  T is only one task, and cannot
  909.       --  execute these while executing this.
  910.  
  911.       Undefer_Abortion;
  912.  
  913.    end Complete_Master;
  914.  
  915.    ----------------
  916.    -- Terminated --
  917.    ----------------
  918.  
  919.    function Terminated (T : Task_ID) return Boolean is
  920.    begin
  921.       --  Does not need protection; access is assumed to be atomic.
  922.       --  Why is this assumption made, is pragma Atomic applied properly???
  923.  
  924.       return T.Stage = Terminated;
  925.    end Terminated;
  926.  
  927. end System.Tasking.Stages;
  928.