--  $Id: threads-sched_dss.adb,v 1.3 2008/11/20 22:18:50 baker Exp baker $

--  deadline sporadic scheduler

--  ??? With all these events, and duplicate data between the task
--  and thread views, this "object oriented" version of the
--  program has become a lot more complicated (and likely to run
--  slower) than the old monolithic model with global visibility
--  of all information. :-{


--  ----------
--  Overview
--  ----------

--  The policy is implemented by call-backs that correspond
--  to events that control server priority changes.
--  For each such event there is a scheduler call-back to this policy.

--  In the comments,  Ds = server deadline.
--  In the code, Ds = -P.T.Priority;

--  In the code, server_period = P.T.Policy_Data.Budget_Interval
--  In the code, server_budget = P.T.Policy_Data.Budge

--  In the DSS paper, this is Tz + server_period, wheren
--  Tz = time at which the current server priority became active.
--  Here, everything is in terms of Ds.


--  -----------
--  Initially
--  ------------

--  Ds = Time'last (corresponds to "undefined" in the paper)
--  This is implemented in procedure Bind.

--  -----------------------
--  Server replenishments
--  -----------------------

--  If the server is ready (has work to do)
--  and Ds = Time'Last, then

--  Ds = current_time + server_period

--  This implemented by Replenishment_Events.Handler().

--  -------------------------------------
--  Arrival of an aperiodic job request
--  -------------------------------------

--  If the server has non-empty budget
--  and Tz is not defined (Ds = Time'Last), then do the same as above.

--  This will be detected by the task's arrival event handler, which
--  will eventuall call Unsuspend().

--  ---------------------------------
--  Choice of a new task to execute
--  ---------------------------------

--  Let Dc = the deadline of the new task

--  (1) if Tz is undefined

--  If Dc <= current_time + server_period
--  (Ds = Time'Last)
--  Tz = current_time
--  Ds = current time + server_period

--  (2) if Tz is defined

--  If Dc > current_time + server_period
--  Tz = undefined (Time'Last)
--  Ds = Time'Last

--  If Dc <= current_time + server_period
--  and Ds <= Dc,
--  Ds = Dc - server_period

--  This is implemented by New_Current_Thread().

--  ------------------------------
--  Server priority "activation"
--  ------------------------------

--  Actually, any time the server priority is inactive,
--   or the instant where the server priority becomes active.

--  Coalesce all the available chunks into a single chunk
--  with replenishment time equal to the current time.

--  This is implemented by New_Current_Thread().

--  ---------------------------------------------
--  Server starts to execute a new budget chunk
--  ---------------------------------------------

--  Tz = chunk replenishment time
--  Ds = chunk.replenishment_time + server_period

--  This is implemented in Budget_Exhaustion_Events.Handler().

--  ---------------------------------
--  Server completes a budgdt chunk
--  ---------------------------------

--  (1) The amount of time consumed by the server is split off
--  and scheduled for replenishment at the current deadline of
--  the server

--  (2) If there is another chunk, the server executes using that

--  (3) If there are no more chunks, the server becomes inactive

--  This is implemented in Budget_Exhaustion_Events.Handler().

--  -------------------------------------------------
--  Server suspends itself (for an empty job queue)
--  -------------------------------------------------

--  Do the same as (1) above, except that we can't assume the chunk
--  has been exhausted.

--  This is implemented in Suspend().

--  --------------------------------
--  The entire system becomes idle
--  --------------------------------

--  This event is not important for the DSS algorithm, but
--  notification of this event may be needed for some other server
--  algorithms, to merge all server replenishments and set
--  the replenishment amount to full budget.

--  To catch this event, one can use the New_Current_Thread call-out,
--  and check for Current_Thread = Idle_Thread.

with Replenishments; use Replenishments;
with Simulator;
with Error_Log; use Error_Log;
with Ada.Text_IO; use Ada.Text_IO;
package body Threads.Sched_DSS is

   type Policy_Ref is access all Object;

   ----------------------------
   --  Replenishment_Events  --
   ----------------------------

   package body Replenishment_Events is

      procedure Handler (E : in out Object) is
         --  Cast type of policy
         --  to the specific type for this policy.
         P : constant Policy_Ref := Policy_Ref (E.T.Policy);
         Now : constant Time := Simulator.Current_Time;
      begin
         pragma Assert (not P.R_Queue.Is_Empty);
         Policy_Unsuspend (E.T, Now + P.Parms.Budget_Interval);
         Schedule;
      end Handler;

      function Name (E : Object) return String is
      begin
         return Name (E.T.all) & "replenishment " & Events.Object (E).Name;
      end Name;

   end Replenishment_Events;

   --------------------------------
   --  Budget_Exhaustion_Events  --
   --------------------------------

   package body Budget_Exhaustion_Events is

      procedure Handler (E : in out Object) is
         Now : constant Time := Simulator.Current_Time;
         P : constant Policy_Ref := Policy_Ref (E.T.Policy);
         R : R_Info;
      begin
         pragma Assert (not P.R_Queue.Is_Empty);
         R := P.R_Queue.Front_Of;
         P.R_Queue.Pop;
         R.R_Time := E.T.Priority;
         --  Set replenishment time to current deadline.
         --  The amount should be unchanged.
         --  Put the replenishment back in queue, in new position.
         P.R_Queue.Add (R);
         pragma Debug (Check_R_Sum
                       (P.R_Queue, P.Parms.Budget,"Exhaustion"));
         --  Fetch the earliest replenishment chunk
         R := P.R_Queue.Front_Of;
         --  Only schedule a replenishment event if we need to.
         if R.R_time > Now then
            --  We need to set a timer for the replenishment.
            P.Replenishment.Event_Time := R.R_Time;
            Simulator.Schedule_Event (P.Replenishment);
            pragma Debug (Debug (5, Name (P.T.all) &
                                   "next replenishment due at" &
                                   Time'Image (R.R_Time)));
            --  Suspend this thread until the replenishment arrives.

            Policy_Suspend (P.T);
            --  Call the scheduler to choose another thread.
            Schedule;
         else
            --  We can continue, using the next relenishment chunk.
            pragma Debug
              (Debug (7, Name (P.T.all)
                        & "starting new replenishment chunk"));
            --  Start using the new chunk (**)
            --  The priority is the chunk arrival time
            --  plus the server "period"
            P.T.Priority := R.R_Time + P.Parms.Budget_Interval;
         end if;
      end Handler;

      function Name (E : Object) return String is
      begin
         return Name (E.T.all) & "budget_exhaustion " & Events.Object (E).Name;
      end Name;

   end Budget_Exhaustion_Events;

   ----------
   --  Go  --
   ----------

   --  This is called whenever Current_Thread is set to a new
   --  value, for the new thread.  It indicates that the
   --  thread has just started or resumed executing, after
   --  a suspension or preemption.

   procedure Go
     (P : in out Object) is
   begin
      pragma Debug (Check_R_Sum (P.R_Queue, P.Parms.Budget, "Go"));
      pragma Assert (not P.R_Queue.Is_Empty);

      --  Schedule a timer for when the current replenishment
      --  chunk will run out, assuming the thread runs that long.

      P.Exhaustion.Event_Time :=
        Simulator.Current_Time + P.R_Queue.Front_Of.R_Amount;
      Simulator.Schedule_Event (P.Exhaustion);
   end Go;

   ------------
   --  Stop  --
   ------------

   --  This is called whenever Current_Thread is set to a new
   --  value, for the old current thread.  It indicates that the
   --  thread has been suspended or preempted.

   procedure Stop
     (P : in out Object) is
   begin

      --  Cancel budget timeout, if one is pending.

      if P.Exhaustion.Enqueued then
         Simulator.Cancel_Event (P.Exhaustion);
      end if;
   end Stop;

   ------------------
   --  Bind_Parms  --
   ------------------

   procedure Bind_Parms
     (P : in out Object;
      Parms : Aperiodic_Server_Parameters.Parameters) is
   begin
      P.Parms := Parms;
   end Bind_Parms;

   ------------
   --  Init  --
   ------------

   procedure Init
     (P : in out Object) is
   begin
      P.T.Priority :=  Time'Last;
      P.Replenishment.T := P.T;
      P.Exhaustion.T := P.T;
      P.R_Queue.Clear;
      --  set up first replenishment
      P.R_Queue.Add ((R_Time => 0,
                      R_Amount => P.Parms.Budget));
      P.T.Is_In_Ready_Queue := False;
   end Init;

   -------------------------
   --  New_Current_Thread --
   -------------------------

   --  This is called for *ALL* threads :-( whenever the value of
   --  Current_Thread has changed.

   procedure New_Current_Thread
     (P : Object) is
      DC : Time;
      DS : Time := P.T.Priority;
      TD : constant Time :=
        Simulator.Current_Time + P.Parms.Budget_Interval;
   begin
      if Current /= null then
         DC := Current.Priority;
      else
         DC := Time'Last;
      end if;
      if DC > TD then
         DS := Time'Last; -- "undefined"
      elsif DS <= DC then
         DS := Time'Min (DC, TD);
      end if;
      P.T.Priority := DS;
   end New_Current_Thread;

   -----------------
   --  Unsuspend  --
   -----------------

   --  This is called whenever a thread has suspended itself.  For
   --  a server, this means the server has no jobs in its queue.

   procedure Unsuspend (P : Object) is
   begin
      if P.T.Priority = Time'Last then
         P.T.Priority := Simulator.Current_Time + P.Parms.Budget_Interval;
      end if;
   end Unsuspend;

   ---------------
   --  Suspend  --
   ---------------

   --  This is called whenever a thread that earlier suspended
   --  itself wakes up. For a server, this means a job has arrived
   --  for a server previously had no jobs in its queue.

   procedure Suspend (P : in out Object) is
      Now : constant Time := Simulator.Current_Time;
      R, R2 : R_Info;
   begin
      pragma Assert (not P.R_Queue.Is_Empty);
      R := P.R_Queue.Front_Of;
      P.R_Queue.Pop;
      R2.R_Amount := Simulator.Current_Time - Last_Dispatching_Time;
      --  ??? or, should we rely on task's own view of when it started,
      --  by using P.T.Last_Start_Time insteasd of Scheduler.Last_Dispatch_Time?
      R2.R_Time := P.T.Priority;  -- = deadline
      P.R_Queue.Add (R2);
      R.R_Amount := R.R_Amount - R2.R_Amount;
      --  R.R_Time is unchanged
      pragma Assert (R.R_Amount >= 0);
      if R.R_Amount > 0 then
         P.R_Queue.Add (R);
      end if;
      pragma Debug (Check_R_Sum (P.R_Queue, P.Parms.Budget, "Suspend"));
      R := P.R_Queue.Front_of;
      if R.R_time > Now then
         P.Replenishment.Event_Time := R.R_Time;
         Simulator.Schedule_Event (P.Replenishment);
         pragma Debug (Debug (5, Name (P.T.all) &
                                "next replenishment due at" &
                                Time'Image (R.R_Time)));
         Policy_Suspend (P.T);
         Schedule;
      else
         pragma Debug
           (Debug (7, Name (P.T.all)
                     & "starting new replenishment chunk"));
         --  start using new chunk (**)
         P.T.Priority := R.R_Time + P.Parms.Budget_Interval;
      end if;
   end Suspend;

   ---------------
   --  New_Job  --
   ---------------

   --  This is called when a server starts working on a new job
   --  from its queue.  We don't need this for most (all?)
   --  aperiodic server policies, but we may need this to provide
   --  the deadline for periodic tasks that are scheduled
   --  according to individual job deadlines.

   procedure New_Job
     (P : in out Object;
      J : in Jobs.Job) is
   begin
      P.Current_Job := J;
   end New_Job;

end Threads.Sched_DSS;