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