1. -- 
  2. -- Copyright (c) 2012 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Locking_Objects;                   use Locking_Objects; 
  10. with Objects;                           use Objects; 
  11. with Processes;                         use Processes; 
  12.  
  13. private with Ada.Containers.Doubly_Linked_Lists; 
  14. private with Ada.Strings.Unbounded; 
  15. --private with Mutable_Lists; 
  16.  
  17. package Processes.Managers is 
  18.  
  19.     -- A Process_Manager executes Process objects at fixed periodic intervals. 
  20.     -- Each Process_Manager is backed by a single internal thread, with which it 
  21.     -- delegates execution time to attached Process objects in time slices 
  22.     -- (execution frames). Each Process is given a chance to execute via its 
  23.     -- Tick method and is called at an approximate frequency determined by the 
  24.     -- Process_Manager. 
  25.     -- 
  26.     -- Hard time constraints are not guaranteed because any Process taking up 
  27.     -- too much time will slow down the Process_Manager's tick rate. 
  28.     type Process_Manager is new Limited_Object with private; 
  29.     type A_Process_Manager is access all Process_Manager'Class; 
  30.  
  31.     -- Reference to a procedure that is responsible for destroying a process. 
  32.     type A_Destructor is access procedure( process : in out A_Process ); 
  33.  
  34.     -- An update rate of 0 hertz means maximum update rate, without delay 
  35.     -- between frames. 'minHertz' is not the minimum actual rate of the process 
  36.     -- manager because it is unable to interrupt or skip processes; it is the 
  37.     -- minimum time delta reported to the processes on tick. If some processes 
  38.     -- can't handle large time deltas but sometimes they do happen, 'minHertz' 
  39.     -- will prevent the processes from getting a dt that's too big. 
  40.     function Create_Process_Manager( name     : String; 
  41.                                      hertz    : Natural := 0; 
  42.                                      minHertz : Natural := 0 ) return A_Process_Manager; 
  43.     pragma Postcondition( Create_Process_Manager'Result /= null ); 
  44.  
  45.     -- Asynchronously attaches a process to the process manager for execution. 
  46.     -- It will be executed last in the rotation of attached processes. This can 
  47.     -- be called at any time before Stop. Constraint_Error will be raised if the 
  48.     -- process manager has been stopped. 
  49.     procedure Attach_Async( this : not null access Process_Manager'Class; 
  50.                             proc : not null A_Process ); 
  51.  
  52.     -- Asynchronously detaches a Process from the process manager. This can be 
  53.     -- called at any time before Stop. 
  54.     -- 
  55.     -- Note that 'prop' cannot be immediately detached because it could be 
  56.     -- executing. While the process manager is running, it is not safe for the 
  57.     -- caller in an external thread to call Detach and then delete 'proc', 
  58.     -- without additional synchronization. 
  59.     -- 
  60.     -- However, if the calling thread is this process manager (as an executing 
  61.     -- Process), then it is safe to delete 'proc' immediately after calling 
  62.     -- this as long as the calling Process isn't trying to delete itself. 
  63.     procedure Detach_Async( this : not null access Process_Manager'Class; 
  64.                             proc : not null A_Process ); 
  65.  
  66.     -- Asynchronously detaches a Process from the process manager. This can be 
  67.     -- called at any time. The 'destructor' procedure will be used to delete 
  68.     -- 'proc' after it is detached from the process manager. 'proc' is consumed. 
  69.     procedure Detach_Async( this       : not null access Process_Manager'Class; 
  70.                             proc       : in out A_Process; 
  71.                             destructor : not null A_Destructor ); 
  72.     pragma Postcondition( proc = null ); 
  73.  
  74.     -- Returns the name of the process manager as given at creation. 
  75.     function Get_Name( this : not null access Process_Manager'Class ) return String; 
  76.  
  77.     -- Returns the actual rate in Hz that the process manager is ticking its 
  78.     -- processes, if rate tracking is enabled. If rate tracking is not enabled, 
  79.     -- then 0 will be returned. 
  80.     function Get_Rate( this : not null access Process_Manager'Class ) return Natural; 
  81.  
  82.     -- Asynchronously pauses/resumes the given Process if it's attached to this 
  83.     -- manager. If paused, Tick will not be called until after the Process has 
  84.     -- been resumed. Constraint_Error will be raised if the process manager has 
  85.     -- been stopped. 
  86.     procedure Pause_Async( this   : not null access Process_Manager'Class; 
  87.                            proc   : not null A_Process; 
  88.                            paused : Boolean ); 
  89.  
  90.     -- Starts execution of the processes. 
  91.     procedure Start( this : not null access Process_Manager'Class ); 
  92.  
  93.     -- Stops execution of the processes. 
  94.     procedure Stop( this : not null access Process_Manager'Class ); 
  95.  
  96.     -- Instructs the process manager to track the rate at which it is executing 
  97.     -- processes. This is useful for determining frame rates or finding which 
  98.     -- process manager threads are running too slowly. Note that rate tracking 
  99.     -- does impose some overhead and should only be enabled for debugging 
  100.     -- purposes. 
  101.     procedure Track_Rate( this    : not null access Process_Manager'Class; 
  102.                           enabled : Boolean ); 
  103.  
  104.     -- Deletes a process manager. Its attached processes, if it has any at the 
  105.     -- time of deletion, are detached and left unchanged. This may result in a 
  106.     -- leak if the processes are not deleted elsewhere. 
  107.     procedure Delete( this : in out A_Process_Manager ); 
  108.     pragma Postcondition( this = null ); 
  109.  
  110. private 
  111.  
  112.     use Ada.Strings.Unbounded; 
  113.  
  114.     -- The execution context of a Process. 
  115.     type Execution is 
  116.         record 
  117.             process    : A_Process := null; 
  118.  
  119.             firstTick  : Time := Time_First; 
  120.             lastTick   : Time := Time_First; 
  121.  
  122.             paused     : Boolean := False; 
  123.             pauseTime  : Time := Time_First; 
  124.  
  125.             detachMe   : Boolean := False;        -- to be detached by Ticker_Task 
  126.             destructor : A_Destructor := null;    -- optional destructor after detach 
  127.         end record; 
  128.     type A_Execution is access all Execution; 
  129.  
  130.     -- Compares 'l' and 'r' by their Process. 
  131.     function Eq( l, r : A_Execution ) return Boolean; 
  132.  
  133.     -- An ordered list of Execution contexts that the Ticker_Task repeatedly 
  134.     -- iterates to tick processes. 
  135.     package Execution_Lists is new Ada.Containers.Doubly_Linked_Lists(A_Execution, Eq); 
  136. --    package Execution_Lists is new Mutable_Lists(A_Execution, Eq); 
  137.     use Execution_Lists; 
  138.  
  139.     ---------------------------------------------------------------------------- 
  140.  
  141.     -- An Operation represents a queued asynchronous operation involving a 
  142.     -- Process: Attach, Detach, Pause, etc. All of these operations are 
  143.     -- asynchronous so they can be performed by a Process in its Tick method. 
  144.     type Operation is abstract tagged 
  145.         record 
  146.             process : A_Process := null; 
  147.         end record; 
  148.     type A_Operation is access all Operation'Class; 
  149.  
  150.     -- Executes the Operation on the process manager's Process list. 'now' is 
  151.     -- the time of the operation. 
  152.     procedure Execute( this     : access Operation; 
  153.                        now      : Time; 
  154.                        execList : in out Execution_Lists.List ) is abstract; 
  155.  
  156.     -- A list of Operations to be used as a queue. 
  157.     package Operation_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Operation, "=" ); 
  158.  
  159.     ---------------------------------------------------------------------------- 
  160.  
  161.     -- The internal task that runs the Process.Tick procedures. Each process 
  162.     -- manager has exactly one Ticker_Task. 
  163.     task type Ticker_Task is 
  164.         entry Init( pman : A_Process_Manager; hertz, minHertz : Natural ); 
  165.         entry Start; 
  166.         entry Stop; 
  167.     end Ticker_Task; 
  168.     type A_Ticker_Task is access all Ticker_Task; 
  169.  
  170.     ---------------------------------------------------------------------------- 
  171.  
  172.     type Process_Manager is new Limited_Object with 
  173.         record 
  174.             lock       : A_Locking_Object;       -- protects all other fields 
  175.             name       : Unbounded_String; 
  176.             operations : Operation_Lists.List; 
  177.             trackRate  : Boolean := False; 
  178.             rate       : Natural := 0; 
  179.             ticker     : A_Ticker_Task := null; 
  180.             started    : Boolean := False; 
  181.             stopped    : Boolean := False; 
  182.         end record; 
  183.  
  184.     procedure Construct( this     : access Process_Manager; 
  185.                          name     : String; 
  186.                          hertz    : Natural; 
  187.                          minHertz : Natural ); 
  188.  
  189.     procedure Delete( this : in out Process_Manager ); 
  190.  
  191. end Processes.Managers;