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 );
-- Attach 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.
procedure Attach( this : not null access Process_Manager'Class;
proc : not null A_Process );
-- Detaches a Process from the process manager. This can be called at any
-- time. If 'destructor' is not null then the caller gives up ownership of
-- 'proc'; it will be passed on to the destructor after it has been detached.
--
-- Note that 'prop' may not 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( this : not null access Process_Manager'Class;
proc : not null A_Process;
destructor : A_Destructor := 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;
-- 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.
procedure Pause( 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
-- its 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 you're not careful.
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;