with Locking_Objects; use Locking_Objects;
with Objects; use Objects;
with Processes; use Processes;
private with Ada.Containers.Doubly_Linked_Lists;
private with Ada.Strings.Unbounded;
package Processes.Managers is
-- A Process_Manager executes Process objects at fixed periodic intervals.
-- Each Process_Manager is backed by a single internal thread, with which it
-- delegates execution time to attached Process objects in time slices
-- (execution frames). Each Process is given a chance to execute via its
-- Tick method and is called at an approximate frequency determined by the
-- Process_Manager.
--
-- Hard time constraints are not guaranteed because any Process taking up
-- too much time will slow down the Process_Manager's tick rate.
type Process_Manager is new Limited_Object with private;
type A_Process_Manager is access all Process_Manager'Class;
-- Reference to a procedure that is responsible for destroying a process.
type A_Destructor is access procedure( process : in out A_Process );
-- An update rate of 0 hertz means maximum update rate, without delay
-- between frames. 'minHertz' is not the minimum actual rate of the process
-- manager because it is unable to interrupt or skip processes; it is the
-- minimum time delta reported to the processes on tick. If some processes
-- can't handle large time deltas but sometimes they do happen, 'minHertz'
-- will prevent the processes from getting a dt that's too big.
function Create_Process_Manager( name : String;
hertz : Natural := 0;
minHertz : Natural := 0 ) return A_Process_Manager;
pragma Postcondition( Create_Process_Manager'Result /= null );
-- Asynchronously attaches a process to the process manager for execution.
-- It will be executed last in the rotation of attached processes. This can
-- be called at any time before Stop. Constraint_Error will be raised if the
-- process manager has been stopped.
procedure Attach_Async( this : not null access Process_Manager'Class;
proc : not null A_Process );
-- Asynchronously detaches a Process from the process manager. This can be
-- called at any time before Stop.
--
-- Note that 'prop' cannot be immediately detached because it could be
-- executing. While the process manager is running, it is not safe for the
-- caller to call Detach and then delete 'proc', without additional
-- synchronization.
procedure Detach_Async( this : not null access Process_Manager'Class;
proc : not null A_Process );
-- Asynchronously detaches a Process from the process manager. This can be
-- called at any time. The 'destructor' procedure will be used to delete
-- 'proc' after it is fully detached from the process manager. 'proc' is
-- consumed.
procedure Detach_Async( this : not null access Process_Manager'Class;
proc : in out A_Process;
destructor : not null A_Destructor );
pragma Postcondition( proc = null );
-- Returns the name of the process manager as given at creation.
function Get_Name( this : not null access Process_Manager'Class ) return String;
-- Returns the actual rate in Hz that the process manager is ticking its
-- processes, if rate tracking is enabled. If rate tracking is not enabled,
-- then 0 will be returned.
function Get_Rate( this : not null access Process_Manager'Class ) return Natural;
-- Asynchronously pauses/resumes the given Process if it's attached to this
-- manager. If paused, Tick will not be called until after the Process has
-- been resumed. Constraint_Error will be raised if the process manager has
-- been stopped.
procedure Pause_Async( this : not null access Process_Manager'Class;
proc : not null A_Process;
paused : Boolean );
-- Starts execution of the processes.
procedure Start( this : not null access Process_Manager'Class );
-- Stops execution of the processes.
procedure Stop( this : not null access Process_Manager'Class );
-- Instructs the process manager to track the rate at which it is executing
-- processes. This is useful for determining frame rates or finding which
-- process manager threads are running too slowly. Note that rate tracking
-- does impose some overhead and should only be enabled for debugging
-- purposes.
procedure Track_Rate( this : not null access Process_Manager'Class;
enabled : Boolean );
-- Deletes a process manager. Its attached processes, if it has any at the
-- time of deletion, are detached and left unchanged. This may result in a
-- leak if the processes are not deleted elsewhere.
procedure Delete( this : in out A_Process_Manager );
pragma Postcondition( this = null );
private
use Ada.Strings.Unbounded;
-- The execution context of a Process.
type Execution is
record
process : A_Process := null;
firstTick : Time := Time_First;
lastTick : Time := Time_First;
paused : Boolean := False;
pauseTime : Time := Time_First;
end record;
type A_Execution is access all Execution;
-- Deletes the Execution.
procedure Delete( exec : in out A_Execution );
-- Compares 'l' and 'r' by their Process.
function Eq( l, r : A_Execution ) return Boolean;
-- An ordered list of Execution contexts that the Ticker_Task repeatedly
-- iterates to tick processes.
package Execution_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Execution, Eq );
use Execution_Lists;
----------------------------------------------------------------------------
-- An Operation represents a queued asynchronous operation involving a
-- Process: Attach, Detach, Pause, etc. All of these operations are
-- asynchronous so they can be performed by a Process in its Tick method.
type Operation is abstract tagged
record
process : A_Process := null;
end record;
type A_Operation is access all Operation'Class;
-- Executes the Operation on the process manager's Process list.
procedure Execute( this : access Operation;
plist : in out Execution_Lists.List ) is abstract;
-- Deletes the Operation.
procedure Delete( this : in out A_Operation );
-- A list of Operations to be used as a queue.
package Operation_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Operation, "=" );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Appends a process to the execution list.
type Attach_Operation is new Operation with null record;
procedure Execute( this : access Attach_Operation;
execList : in out Execution_Lists.List );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Removes a process from the execution list.
type Detach_Operation is new Operation with
record
destroy : A_Destructor := null;
end record;
-- Detaches the operation's process from 'execList'. If a destructor was
-- provided, it will be called with the detached process.
procedure Execute( this : access Detach_Operation;
execList : in out Execution_Lists.List );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Pauses the execution of a process before its next Tick.
type Pause_Operation is new Operation with null record;
procedure Execute( this : access Pause_Operation;
execList : in out Execution_Lists.List );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-- Resumes the execution of a process on its next Tick.
type Resume_Operation is new Operation with null record;
procedure Execute( this : access Resume_Operation;
execList : in out Execution_Lists.List );
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
function Create_Attach_Operation( process : not null A_Process ) return A_Operation;
-- If 'destructor' is not null, the detached process will be passed to it.
function Create_Detach_Operation( process : not null A_Process;
destructor : A_Destructor ) return A_Operation;
function Create_Pause_Operation( process : not null A_Process ) return A_Operation;
function Create_Resume_Operation( process : not null A_Process ) return A_Operation;
----------------------------------------------------------------------------
-- The internal task that runs the Process.Tick procedures. Each process
-- manager has exactly one Ticker_Task.
task type Ticker_Task is
entry Init( pman : A_Process_Manager; hertz, minHertz : Natural );
entry Start;
entry Stop;
end Ticker_Task;
type A_Ticker_Task is access all Ticker_Task;
-- Deletes the Ticker_Task.
procedure Delete( ticker : in out A_Ticker_Task );
----------------------------------------------------------------------------
type Process_Manager is new Limited_Object with
record
lock : A_Locking_Object; -- protects all other fields
name : Unbounded_String;
operations : Operation_Lists.List;
trackRate : Boolean := False;
rate : Natural := 0;
ticker : A_Ticker_Task := null;
started : Boolean := False;
stopped : Boolean := False;
end record;
procedure Construct( this : access Process_Manager;
name : String;
hertz : Natural;
minHertz : Natural );
procedure Delete( this : in out Process_Manager );
end Processes.Managers;