File: gnatcoll-ravenscar-multiple_queue_sporadic_server.ads

package info (click to toggle)
libgnatcoll 18-4
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 5,068 kB
  • sloc: ada: 40,393; python: 354; ansic: 310; makefile: 245; sh: 31
file content (183 lines) | stat: -rw-r--r-- 6,776 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
------------------------------------------------------------------------------
--                                                                          --
--                             G N A T C O L L                              --
--                                                                          --
--                      Copyright (C) 2008-2017, AdaCore                    --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT 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  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

--  This version of a Ravenscar-compliant sporadic server extends the behaviour
--  of GNAT.Ravenscar.Sporadic_Server by accepting multiple types of requests
--  reified in a single variant type. It shares all basic properties of
--  GNAT.Ravenscar.Sporadic_Server.
--
--  A typical example of usage is the following:
--
--  type Req is (REQ1, REQ2, REQ3);
--  type Par (R : Req := REQ1) is
--    record
--      Req : Req := R;
--      case R is
--         when REQ1 =>
--            null;
--         when REQ2 =>
--             P1 : Type1;
--         when REQ3 =>
--             P2 : Type2;
--             P3 : Type3;
--      end case;
--    end record;
--
--  procedure Dispatch(P : Par) is
--  begin
--    case P.Req is
--       when REQ1 =>
--          Do_Something;
--       when REQ2 =>
--           Do_Something(P.P1);
--       when REQ3 =>
--           Do_Something(P.P2, P.P3);
--     end case;
--  end Dispatch;
--
--  package My_Sporadic_Server is
--    new GNAT.Ravenscar.Multiple_Queue_Sporadic_Server
--      (Task_Priority => 10,
--       Minimum_Interelease_Time => 1_000,
--       Protocol_Ceiling => 15,
--       System_Start_Time => System_Properties.Start_UP_Time,
--       QS => 4,
--       Request_Kind => Req,
--       Param => Par,
--       Dispatch => Dispatch);
--
--  [...]
--  declare
--    P : Par(REQ2);
--  begin
--    -- fill parameters
--    P.P2 := Val;
--    -- Release the task --
--    My_Sporadic_Server.Put_Request(P);

with System;
with Ada.Real_Time;

generic

   Task_Priority : System.Priority;
   --  the priority of the server

   Minimum_Interelease_Time : Millisecond;
   --  the minimum time between two consecutive releases

   System_Start_Time : Ada.Real_Time.Time := Ada.Real_Time.Clock;
   --  the absolute instant in time for the release of the systems as a whole

   Protocol_Ceiling : System.Any_Priority;
   --  the ceiling priority of the protected object used to post and fetch
   --  requests

   QS : Queue_Size;
   --  the size of accepted requests

   type Request_Kind is (<>);
   --  an enumeration type identificng the possible kinds of request

   type Request is private;
   --  the reified request type

   with procedure Dispatch (Req : Request);
   --  the procedure invoked by the server to dispatch the fetched request

package GNATCOLL.Ravenscar.Multiple_Queue_Sporadic_Server is

   procedure Put_Request
     (Req      : Request;
      Kind : Request_Kind);
   --  Invoked by clients to post reified requests to be fetched and executed
   --  by the server

private

   type Request_Type_Ref is access all Request;
   --  pointer type for request

   type Request_Queue is array (1 .. QS) of aliased Request;
   --  physical queue for posted requests

   type All_Queue is array (Request_Kind'Range) of Request_Queue;
   --  the entire set of queues (one for each possible request)

   type All_Queue_Index is array (Request_Kind'Range) of Queue_Range;
   --  type to collect all indexes to access requests

   Pointer_Queue_Range_Max : constant Integer := QS;
   --  maximum index value

   type Pointer_Queue_Item is record
      Kind    : Request_Kind;
      Req : Request_Type_Ref;
   end record;
   --  reified request descriptor saved in a queue

   type Pointer_Queue_Item_Ref is access all Pointer_Queue_Item;
   --  pointer type to reified request descriptors

   type Pointer_Queue is
     array (Integer range 1 .. Pointer_Queue_Range_Max)
            of aliased Pointer_Queue_Item;
   --  logical queue of posted requests

   protected Protocol is
      --  the protected object used to post/fetch requests

      pragma Priority (Protocol_Ceiling);

      procedure Put
        (Req      : Request;
         Kind : Request_Kind);

      entry Get
        (Req      : out Request;
         Release_Time : out Ada.Real_Time.Time);

   private
      Barrier                     : Boolean              := False;
      Queues                      : All_Queue;
      Insert_Index                : All_Queue_Index      := (others => 1);
      Pending                     : Integer              := 0;
      Ptr_Queue                   : Pointer_Queue   :=
        (others => (Request_Kind'First, null));
      Pointer_Queue_Insert_Index  : Integer              := 1;
      Pointer_Queue_Extract_Index : Integer              := 1;
      Pointer_Queue_Overflow      : Boolean              := False;
   end Protocol;

   task Sporadic_Task is
      pragma Priority (Task_Priority);
   end Sporadic_Task;
   --  the cyclic server

end GNATCOLL.Ravenscar.Multiple_Queue_Sporadic_Server;