File : generic_event_queue.adb
------------------------------------------------------------------------------
-- ADAGIO - ADALID - AENEA. --
-- --
-- Copyright (C) 2003 --
-- A. Mosteo. --
-- --
-- Authors: A. Mosteo. (adagio@mosteo.com) --
-- --
-- If you have any questions in regard to this software, please address --
-- them to the above email. --
-- --
-- This program is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This program is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- You are not allowed to use any part of this code to develop a program --
-- whose output would be used to harass or prosecute other users of the --
-- networks Adagio connects with. All data collected with Adagio or a tool --
-- containing Adagio code about other network users must remain --
-- confidential and cannot be made public by any mean, nor be used to --
-- harass or legally prosecute these users. --
------------------------------------------------------------------------------
-- $Id: generic_event_queue.adb,v 1.4 2004/01/21 21:05:48 Jano Exp $
-- Efficient event queue. Useful for timeouts, as an example.
with Ada.Unchecked_deallocation; use Ada;
with Adagio.Trace; use Adagio;
package body Generic_event_queue is
procedure Free is new
Unchecked_deallocation (Context_type, Context_access);
-- Priority
function Less (L, R : in Event_type) return Boolean is
begin
return L.Deadline < R.Deadline or else
(L.Deadline = R.Deadline and L.Id < R.Id);
end Less;
-- Equal (by id)
function Equal (L, R : in Event_type) return Boolean is
begin
return L.Id = R.Id;
end Equal;
-- Create an avent
procedure Create (
This : in out Object;
Event : out Event_type;
Deadline : in Time;
Context : in Context_type) is
begin
This.Seq.Get_next (Event.Id);
Event.Deadline := Deadline;
Event.Context := new Context_type'(Context);
This.List.Insert (Event);
This.Waiter.Reschedule (New_event);
end Create;
procedure Cancel (
This : in out Object;
Event : in out Event_type) is
Found : Boolean;
begin
This.List.Get_remove (Event, Found);
if Found then
Free (Event.Context);
end if;
end Cancel;
-- Pending events?
function Is_empty (This : in Object) return Boolean is
begin
return This.List.Is_empty;
end Is_empty;
procedure Shutdown (This : in out Object) is
begin
This.Waiter.Shutdown;
end Shutdown;
task body Active_object is
Next : Event_type;
Deadline : Time;
Found : Boolean;
Worker_ready : Boolean := true;
begin
loop
-- Deadline triggered or rescheduling (new event)
Parent.List.Get_first_remove (Next, Found);
if not Found then
Deadline := Clock + To_time_span (60.0);
else
if Next.Deadline <= Clock then
-- Run it if possible
if Worker_ready then
Parent.Doer.Execute (Next.Context);
Worker_ready := false;
Deadline := Clock + To_time_span (60.0);
else
-- Busy. Delay until him signals us:
Deadline := Clock + To_time_span (60.0);
Parent.List.Insert (Next);
end if;
else
-- Reinsert it
Deadline := Next.Deadline;
Parent.List.Insert (Next);
end if;
end if;
-- Wait for news
select
accept Reschedule (Action : in Action_type) do
if Action = Job_finished then
Worker_ready := true;
end if;
end Reschedule;
or
accept Shutdown;
exit;
or
delay until Deadline;
end select;
end loop;
end Active_object;
task body Worker is
Context : Context_access;
begin
loop
select
accept Execute (Context : in Context_access) do
Worker.Context := Context;
end Execute;
begin
Action_on_timeout (Context.all);
exception
when E : others =>
Trace.Log ("Generic_event_queue: " & Trace.Report (E),
Trace.Error);
end;
Free (Context);
Parent.Waiter.Reschedule (Job_finished);
or
terminate;
end select;
end loop;
end Worker;
end Generic_event_queue;