Gem #96: Code Archetypes for Real-Time Programming - Part 4

by Marco Panunzio —University of Padua

Introduction

In the previous Ada Gem we started to describe a complete archetype for a sporadic task. We illustrated the structure of the task and the realization of a complex queuing policy for its synchronization agent (OBCS). In this Ada Gem, we complete the picture with the description of the OPCS, which contains the functional code executed by the sporadic task, and show how we complete the declaration of the OBCS and of the provided interface exposed to clients of the sporadic task.

Sporadic Task -- Functional code and complete OBCS

It is now time to create the functional code for the procedures executed by our sporadic task. Suppose we want a Consumer that provides operations Op1 and Op2 as depicted in the figure below.

The operations Op1 and Op2 would be included in an OPCS structure which encapsulates their respective functional code, decoupling it from other nonfunctional concerns. The OPCS is then embedded in the sporadic task structure.

First, we declare two simple enumeration types, T1 and T2, in a separate package, to be used by our functional code:

package Types is
   type T1 is (F1, F2);
   T1_Default_Value : constant T1 := F1;
   type T2 is (X1, X2);
   T2_Default_Value : constant T2 := X1;
end Types;

Then in another package we declare a new type, say Consumer_FC, that extends Controlled (thus it is a tagged type) and has two primitive procedures Op1(T1, T2) and Op2(T1):

with Types;
with Ada.Finalization; use Ada.Finalization;

package Consumer is

   type Consumer_FC is new Controlled with private;    
   type Consumer_FC_Ref is access all Consumer_FC'Class;
   type Consumer_FC_Static_Ref is access all Consumer_FC;
   type Consumer_FC_Arr is array(Standard.Integer range <>) of Consumer_FC_Ref;
   type Consumer_FC_Arr_Ref is access Consumer_FC_Arr;

   overriding
   procedure Initialize(This : in out Consumer_FC);
  
   procedure Op1 (This : in out Consumer_FC; a : in Types.T1; b : in Types.T2);
   procedure Op2 (This : in out Consumer_FC; a : in Types.T1);
   
private

    type Consumer_FC is new Controlled with null record ...;

end Consumer;

Consumer_FC is the type that represents what we called the OPCS. The sequential code is given in the bodies of the two procedures Op1 and Op2:

package body Consumer is

   -- procedure Initialize omitted

   procedure Op1(This : in out Consumer_FC; a : in Types.T1; b : in Types.T2) is
   begin
   -- User-defined sequential code here --
   end Op1;

   procedure Op2 (This : in out Consumer_FC; a : in Types.T1) is
   begin
   -- User-defined sequential code here --
   end Op2;

end Consumer;

Now let's complete the definition of the OBCS and discuss the instantiation of the sporadic task.

with System;
with Types;
with System_Types;
with Ada.Real_Time;

with Consumer;
with Ada.Real_Time; use Ada.Real_Time;

package Op1_Op2_Sporadic_Consumer is

   use System; use Types;
   
   use System_Types;

   -- Nested generic package for instantiating a sporadic task:

   generic
      Thread_Priority : Priority;
      Ceiling : Priority;
      MIAT : Integer;
      -- The OPCS instance
      OPCS_Instance : Consumer.Consumer_FC_Static_Ref;
   package My_Sporadic_Factory is

      procedure Op1(a : in T1; b : in T2);
      procedure Op2(a : in T1);

   private
      -- ...
   end My_Sporadic_Factory;
   
private

    Param_Queue_Size : constant Integer := 3;
    OBCS_Queue_Size : constant Integer := Param_Queue_Size * 2;

    -- Create data structures to reify invocations of Op1

    type Op1_Param_T is new Param_Type with record
       OPCS_Instance : Consumer.Consumer_FC_Static_Ref;
       a : T1;
       b : T2;
    end record;
 
    type Op1_Param_T_Ref is access all Op1_Param_T;

    type Op1_Param_Arr is array(Integer range <>) of aliased Op1_Param_T;
  
    overriding
    procedure My_OPCS(Self : in out Op1_Param_T);

    -- Create data structures to reify invocations of Op2

     type Op2_Param_T is new Param_Type with record
       OPCS_Instance : Consumer.Consumer_FC_Static_Ref;
       a : T1;
    end record;

    type Op2_Param_T_Ref is access all Op2_Param_T;

    type Op2_Param_Arr is array(Integer range <>) of aliased Op2_Param_T;

    overriding
    procedure My_OPCS(Self : in out Op2_Param_T);

    -- Create an OBCS that matches the interface of the OPCS (FC)
    protected type OBCS
     (Ceiling : Priority;
      Op1_Params_Arr_Ref_P : Param_Arr_Ref;
      Op2_Params_Arr_Ref_P : Param_Arr_Ref)
    is
      pragma Priority(Ceiling); 
  
      entry Get_Request(Req : out Request_Descriptor_T; Release : out Time);
      procedure Op2(a : in T1);
      procedure Op1(a : in T1; b : in T2);

    private

       -- The queue system for the OBCS
       OBCS_Queue : Sporadic_OBCS(OBCS_Queue_Size);
       -- Arrays to store a set of reified invocations for Op1 and Op2
       Op1_Params : Param_Buffer_T(Param_Queue_Size) := 
          (Size => Param_Queue_Size, Index => 1, Buffer => Op1_Params_Arr_Ref_P.all);
       Op2_Params : Param_Buffer_T(Param_Queue_Size) := 
          (Size => Param_Queue_Size, Index => 1, Buffer => Op2_Params_Arr_Ref_P.all);
       Pending : Standard.Boolean := False;

    end OBCS;

end Op1_Op2_Sporadic_Consumer;

In essence, in the specification above: (i) we declare a nested generic package (My_Sporadic_Factory) that we use to instantiate a sporadic task. In this manner we can instantiate several sporadic tasks which only differ in their timing attributes and properties (MIAT, priority and ceiling priority for the OBCS); the generic package provides an interface to the rest of the system that matches its OPCS (it provides Op1 and Op2 in our case); (ii) in the private part of the parent package (Op1_Op2_Sporadic_Consumer), we create the data structures to store reified invocations of Op1 and Op2. This is done by extending Param_Type (defined in System_Types, see the previous Ada Gem in this series) by new types Op1_Param_T and Op2_Param_T that are records containing the parameters of the call and a reference to the OPCS (an access to FC in our case). Additionally, we override procedure My_OPCS. Therefore, when My_OPCS is called on Op1_Param_T or Op2_Param_T, it will dispatch to the appropriate procedure that we later define in the body of this package. The reader can check again that this is what really happens when the sporadic task type (defined in the previous Gem in this series) calls the procedure My_OPCS after fetching the request descriptor from the OBCS.

with Ada.Real_Time; use Ada.Real_Time;

with Sporadic_Task;
with Types; use Types;

package body Op1_Op2_Sporadic_Consumer is

   use System_Types;

   -- Redefinition of My_OPCS. Call Consumer_FC.Op1 and set In_Use to False.

   procedure My_OPCS(Self : in out Op1_Param_T) is
   begin
      Self.OPCS_Instance.Op1(Self.a, Self.b);
      Self.In_Use := False;
   end My_OPCS;
   
   -- Redefinition of My_OPCS. Call Consumer_FC.Op2 and set In_Use to False.
   procedure My_OPCS(Self : in out Op2_Param_T) is
   begin
      Self.OPCS_Instance.Op2(Self.a);
      Self.In_Use := False;
   end My_OPCS;

   protected body OBCS is

      procedure Update_Barrier is
      begin
         Pending := (OBCS_Queue.Pending) > 0;
      end Update_Barrier;

      -- Get_Request stores the time of the release of the task,
      -- gets the next request (according to the OBCS queuing policy),
      -- and updates the guard.

      entry Get_Request (Req : out Request_Descriptor_T; Release : out Time) when Pending is
      begin
         Release := Clock;
         Get(OBCS_Queue, Req);
         Update_Barrier;
      end Get_Request;
      
      -- When a client calls Op1, the request is reified and put in the OBCS queue.
      
      procedure Op1(a : in T1; b : in T2) is
      begin
        if Op1_Params.Buffer(Op1_Params.Index).In_Use then
           Increase_Index(Op1_Params);
        end if;

        Op1_Param_T_Ref(Op1_Params.Buffer(Op1_Params.Index)).a := a;
        Op1_Param_T_Ref(Op1_Params.Buffer(Op1_Params.Index)).b := b;
        Put(OBCS_Queue, START_REQ, Op1_Params.Buffer(Op1_Params.Index));
        Increase_Index(Op1_Params);
        Update_Barrier;
      end Op1;

      -- When a client calls Op2, the request is reified and put in the OBCS queue.

      procedure Op2(a : in T1) is
      begin
         if Op2_Params.Buffer(Op2_Params.Index).In_Use then
             Increase_Index(Op2_Params);
         end if;
         
         Op2_Param_T_Ref(Op2_Params.Buffer(Op2_Params.Index)).a := a;
         Put(OBCS_Queue, ATC_REQ, Op2_Params.Buffer(Op2_Params.Index));
         Increase_Index(Op2_Params);
         Update_Barrier;
      end Op2;

   end OBCS;

   package body My_Sporadic_Factory is

       Op1_Par_Arr : Op1_Param_Arr(1..Param_Queue_Size) := (others => 
                     (False, 
                      OPCS_Instance,
                      T1_Default_Value,
                      T2_Default_Value));

       Op1_Ref_Par_Arr : aliased Param_Arr := (Op1_Par_Arr(1)'access,
           Op1_Par_Arr(2)'access, Op1_Par_Arr(3)'access);

       Op2_Par_Arr : Op2_Param_Arr(1..Param_Queue_Size) := (others =>
                    (false, 
                     OPCS_Instance, 
                     T1_Default_Value));    
       
       Op2_Ref_Par_Arr : aliased Param_Arr := (Op2_Par_Arr(1)'access,
            Op2_Par_Arr(2)'access, Op2_Par_Arr(3)'access);

       -- Creation of the OBCS
       Protocol : aliased OBCS(Ceiling, Op1_Ref_Par_Arr'access,
                                        Op2_Ref_Par_Arr'access);

       -- Indirection to Get_Request of the OBCS

       procedure Getter(Req : out Request_Descriptor_T; Release : out Time) is
       begin
          Protocol.Get_Request(Req, Release);
       end Getter;

       -- Instantiate the generic package using the procedure above

       package My_Sporadic_Task is new Sporadic_Task(Getter);

       Thread : My_Sporadic_Task.Thread_T(Thread_Priority, MIAT);

       -- When a client calls Op1, redirect the call to the OBCS
       procedure Op1(a : in T1; b : in T2) is
       begin
          Protocol.Op1(a, b);
       end Op1;

       -- When a client calls Op2, redirect the call to the OBCS
       procedure Op2(a : in T1) is
       begin
          Protocol.Op2(a);
       end Op2;

   end My_Sporadic_Factory;

end Op1_Op2_Sporadic_Consumer;

The package body above overrides My_OPCS for each operation provided to external clients (Op1 and Op2). The overriding simply ensures that My_OPCS calls the correct operation with the stored parameter of the original request and then signals that the parameters are no longer in use (which ensures correct management of the circular buffers in the OBCS).

The body of the OBCS follows the same logic as the simpler OBCS described in Gem #92. Procedure Op1 and Op2 are simply extended to reify call requests and correctly store the parameters of the calls in the request descriptor.

Finally, in the body of the generic package My_Sporadic_Factory, we create an OBCS with a defined ceiling priority and the queues to store the parameters of reified calls to Op1 and Op2. The sporadic thread is instantiated in the same package, and we complete the picture by redirecting the calls from Op1 and Op2, in the provided interface of the task structure, to the operations with the same names in the OBCS.