-- Efficient event queue. Useful for timeouts, as an example.
-- Implemented with tagged types. That makes genericity unnecesary. A queue
-- can perform multiple kind of events.
with Agpl.Protected_sorted_index;
with Agpl.Sequence;
with Agpl.Trace;
with Ada.Real_time;
use Ada.Real_time;
package Agpl.Event_queues.Real_Time is
pragma Elaborate_Body;
-- Handle for an event. Can be used to cancel it:
type Event_type is private;
type Object (
Stack_size : Natural := 64 * 1024;
Tracer : Trace.Object_Access := Trace.Null_Object) is limited private;
type Object_access is access all Object;
-- Create an event
procedure Create (
This : in out Object;
Event : out Event_type;
Deadline : in Time;
Action : in Action_procedure;
Context : in Context_type'Class);
procedure Cancel (
This : in out Object;
Event : in out Event_type);
-- Pending events?
function Is_empty (This : in Object) return Boolean;
function Length (This : in Object) return Natural;
procedure Shutdown (This : in out Object);
private
-- Uses timestamp
function Less (L, R : in Event_type) return Boolean;
-- Uses Id.
function Equal (L, R : in Event_type) return Boolean;
pragma Inline (Less, Equal);
-- Maximum simultaneous pending events:
type Id_type is mod 2 ** 32;
package Id_sequence is new Sequence (Id_type);
type Event_type is record
Deadline : Time;
Id : Id_type;
Action : Action_procedure;
Context : Context_access;
end record;
package Event_list is new
Protected_sorted_index (Event_type, Less, Equal);
type Action_type is (New_event, Job_finished);
task type Active_object (Parent : access Object) is
entry Reschedule (Action : in Action_type);
entry Shutdown;
end Active_object;
task type Worker (Parent : access Object) is
pragma Storage_size (Parent.Stack_size);
entry Execute (Event : in Event_type);
end Worker;
type Object (
Stack_size : Natural := 64 * 1024;
Tracer : Trace.Object_Access := Trace.Null_Object) is
record
List : Event_list.Sorted_index;
Seq : Id_sequence.Object;
Waiter : Active_object (Object'Access);
Doer : Worker (Object'Access);
end record;
end Agpl.Event_queues.Real_Time;