home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnatlib / s-taskin.adb < prev    next >
Text File  |  2000-07-19  |  8KB  |  207 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
  4. --                                                                          --
  5. --                        S Y S T E M . T A S K I N G                       --
  6. --                                                                          --
  7. --                                  B o d y                                 --
  8. --                                                                          --
  9. --                             $Revision: 1.35 $
  10. --                                                                          --
  11. --             Copyright (C) 1991-2000 Florida State University             --
  12. --                                                                          --
  13. -- GNARL is free software; you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNARL; see file COPYING.  If not, write --
  21. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22. -- MA 02111-1307, USA.                                                      --
  23. --                                                                          --
  24. -- As a special exception,  if other files  instantiate  generics from this --
  25. -- unit, or you link  this unit with other files  to produce an executable, --
  26. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27. -- covered  by the  GNU  General  Public  License.  This exception does not --
  28. -- however invalidate  any other reasons why  the executable file  might be --
  29. -- covered by the  GNU Public License.                                      --
  30. --                                                                          --
  31. -- GNARL was developed by the GNARL team at Florida State University. It is --
  32. -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
  33. -- State University (http://www.gnat.com).                                  --
  34. --                                                                          --
  35. ------------------------------------------------------------------------------
  36.  
  37. with System.Task_Primitives.Operations;
  38. --  used for Self
  39.  
  40. with Unchecked_Deallocation;
  41. --  To recover from failure of ATCB initialization.
  42.  
  43. with System.Storage_Elements;
  44. --  Needed for initializing Stack_Info.Size
  45.  
  46. with System.Parameters;
  47. --  Used for Adjust_Storage_Size
  48.  
  49. package body System.Tasking is
  50.  
  51.    package STPO renames System.Task_Primitives.Operations;
  52.  
  53.    procedure Free is new
  54.      Unchecked_Deallocation (Ada_Task_Control_Block, Task_ID);
  55.  
  56.    ----------
  57.    -- Self --
  58.    ----------
  59.  
  60.    function Self return Task_ID renames STPO.Self;
  61.  
  62.    ---------------------
  63.    -- Initialize_ATCB --
  64.    ---------------------
  65.  
  66.    --  Call this only with abort deferred and holding All_Tasks_L.
  67.  
  68.    procedure Initialize_ATCB
  69.      (Self_ID          : Task_ID;
  70.       Task_Entry_Point : Task_Procedure_Access;
  71.       Task_Arg         : System.Address;
  72.       Parent           : Task_ID;
  73.       Elaborated       : Access_Boolean;
  74.       Base_Priority    : System.Any_Priority;
  75.       Task_Info        : System.Task_Info.Task_Info_Type;
  76.       Stack_Size       : System.Parameters.Size_Type;
  77.       Master_of_Task   : Master_Level;
  78.       T                : in out Task_ID;
  79.       Success          : out Boolean) is
  80.    begin
  81.       --  Initialize T.LL
  82.  
  83.       STPO.Initialize_TCB (T, Success);
  84.  
  85.       if not Success then
  86.          Free (T);
  87.          return;
  88.       end if;
  89.  
  90.       T.Common.Elaborated := Elaborated;
  91.       T.Common.Parent := Parent;
  92.       T.Common.Task_Entry_Point := Task_Entry_Point;
  93.       T.Common.Task_Arg := Task_Arg;
  94.       T.Common.Stack_Size := Parameters.Adjust_Storage_Size (Stack_Size);
  95.       T.Common.Base_Priority := Base_Priority;
  96.       T.Common.Activator := Self_ID;
  97.       T.Task_Info := Task_Info;
  98.  
  99.       T.Master_of_Task := Master_of_Task;
  100.       T.Master_Within := T.Master_of_Task + 1;
  101.  
  102.       if T.Common.Parent = null then
  103.          --  For the environment task, the adjusted stack size is
  104.          --  meaningless. For example, an unspecified Stack_Size means
  105.          --  that the stack size is determined by the environment, or
  106.          --  can grow dynamically. The Stack_Checking algorithm
  107.          --  therefore needs to use the requested size, or 0 in
  108.          --  case of an unknown size.
  109.  
  110.          T.Common.Compiler_Data.Pri_Stack_Info.Size :=
  111.             Storage_Elements.Storage_Offset (Stack_Size);
  112.  
  113.       else
  114.          T.Common.Compiler_Data.Pri_Stack_Info.Size :=
  115.             Storage_Elements.Storage_Offset (T.Common.Stack_Size);
  116.       end if;
  117.  
  118.       for J in 1 .. T.Entry_Num loop
  119.          T.Entry_Queues (J).Head := null;
  120.          T.Entry_Queues (J).Tail := null;
  121.       end loop;
  122.  
  123.       for L in T.Entry_Calls'Range loop
  124.          T.Entry_Calls (L).Self := T;
  125.          T.Entry_Calls (L).Level := L;
  126.       end loop;
  127.  
  128.       --  Link the task into the list of all tasks.
  129.  
  130.       T.Common.All_Tasks_Link := All_Tasks_List;
  131.       All_Tasks_List := T;
  132.    end Initialize_ATCB;
  133.  
  134.    --------------
  135.    -- Init_RTS --
  136.    --------------
  137.  
  138.    Main_Task_Control_Block : aliased Ada_Task_Control_Block (0);
  139.    --  We declare a global variable to avoid allocating dynamic memory that
  140.    --  will never be freed, so that gnatmem output looks clean.
  141.  
  142.    Main_Task_Image : aliased String := "main_task";
  143.    --  ditto
  144.  
  145.    Main_Priority : Priority;
  146.    pragma Import (C, Main_Priority, "__gl_main_priority");
  147.  
  148. begin
  149.    ----------------------------
  150.    -- Tasking Initialization --
  151.    ----------------------------
  152.  
  153.    --  This block constitutes the first part of the initialization of the
  154.    --  GNARL. This includes creating data structures to make the initial thread
  155.    --  into the environment task. The last part of the initialization is done
  156.    --  in System.Tasking[.Restricted].Initialization
  157.    --  All the initializations used to be in Tasking.Initialization, but this
  158.    --  is no longer possible with the run time simplification (including
  159.    --  optimized PO and the restricted run time) since one cannot rely on
  160.    --  System.Tasking.Initialization being present, as was done before.
  161.  
  162.    declare
  163.       T             : Task_ID;
  164.       Success       : Boolean;
  165.       Base_Priority : Any_Priority;
  166.  
  167.    begin
  168.       if Main_Priority = Unspecified_Priority then
  169.          Base_Priority := Default_Priority;
  170.       else
  171.          Base_Priority := Main_Priority;
  172.       end if;
  173.  
  174.       Success := True;
  175.       T := Main_Task_Control_Block'Access;
  176.       Initialize_ATCB (T, null, Null_Address, Null_Task, null, Base_Priority,
  177.         Task_Info.Unspecified_Task_Info, 0, Environment_Task_Level, T,
  178.         Success);
  179.       pragma Assert (Success);
  180.  
  181.       --  As a special exception, the environment task doesn't have an
  182.       --  Activator.
  183.  
  184.       T.Common.Activator := null;
  185.  
  186.       STPO.Initialize (T);
  187.       STPO.Set_Priority (T, T.Common.Base_Priority);
  188.  
  189.       T.Common.State := Runnable;
  190.  
  191.       T.Awake_Count := 1;
  192.       T.Alive_Count := 1;
  193.  
  194.       T.Master_Within := Library_Task_Level;
  195.       --  Normally, a task starts out with internal master nesting level
  196.       --  one larger than external master nesting level. It is incremented
  197.       --  to one by Enter_Master, which is called in the task body only if
  198.       --  the compiler thinks the task may have dependent tasks. There is no
  199.       --  corresponding call to Enter_Master for the environment task, so we
  200.       --  would need to increment it to 2 here.  Instead, we set it to 3.
  201.       --  By doing this we reserve the level 2 for server tasks of the runtime
  202.       --  system. The environment task does not need to wait for these server
  203.  
  204.       T.Common.Task_Image := Main_Task_Image'Unrestricted_Access;
  205.    end;
  206. end System.Tasking;
  207.