File: gnatcoll-ravenscar-timed_out_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 (150 lines) | stat: -rw-r--r-- 6,333 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
------------------------------------------------------------------------------
--                                                                          --
--                                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.      --
--                                                                          --
------------------------------------------------------------------------------

--  Ravenscar constraints prohibit the use of language-level timeout facilities
--  (via the select statement). This archetype manage to mimic the semantics of
--  a timeout within Ravenscar constraints: if the server is not released
--  (via Put_Request) within Maximum_Interelase_Time, it is automatically
--  released by the run-time and invokes an appropriate, user-specified handler
--
--  A typical example of usage is the following:
--
--  type Par is ...
--  procedure Sporadic_Operation(P : Par);
--  procedure Handler;
--  package My_Sporadic_Server is new Ravenscar.Timed_Out_Sporadic_Server
--      (Task_Priority => 10,
--       Minimum_Interelease_Time => 1_000,
--       Maximum_Interelease_Time => 2_000, -- wait at most 2 seconds
--       Protocol_Ceiling => 15,
--       System_Start_Time => System_Properties.Start_UP_Time,
--       QS => 4,
--       Param => Par,
--       Sporadic_Operation => Sporadic_Operation,
--       Time_Out_Handler => Handler);
--
--  [...]
--  declare
--    P : Par;
--  begin
--   -- Release the task --
--   My_Sporadic_Server.Put_Request(P);
--
--  BEHAVIOUR
--  If the time elapsed between two consecutive releases of the server is
--  greater then Maximimum_Interelease_Time, then Handler is invoked.
--
--  Explanations for GNAT.Ravenscar.Sporadic_Server still hold.
--
--  NOTE FOR THE ANALYSIS: the pattern is implemented as follows:
--  (1) A Timer is set to expires at each Maximum_Interelease_Time
--    (a) I can be deleted and re-set if the server is released
--    (b) If it expires, it release an additional task (see point 2)
--  (2) An additional sporadic task with minimum_interarrival_time =
--     maximum_interarrival_time is suspended waiting to be released by the
--     timer at point (1): this task executes the handler. It suspends on a
--     Suspension_Object.

with Ada.Real_Time;
with System;
with Ada.Synchronous_Task_Control;
with GNATCOLL.Ravenscar.Sporadic_Server;
with GNATCOLL.Ravenscar.Timers.One_Shot_Timer;

generic

   Task_Priority : System.Priority;
   --  The priority of the task

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

   Maximum_Interelease_Time : Millisecond;
   --  the maximum interrelease time which trigger the automatic release
   --  of the server

   System_Start_Time : Ada.Real_Time.Time := Ada.Real_Time.Clock;
   --  the system-wide relase time

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

   QS : Queue_Size;
   --  the maximum number of saved requests

   type Param is private;
   --  the request descriptor

   with procedure Sporadic_Operation (Par : Param);
   --  the procedure invoked when the server is released by the client

   with procedure Time_Out_Handler;
   --  the handler executed by the server when non released the maximum
   --  interrelease time

package GNATCOLL.Ravenscar.Timed_Out_Sporadic_Server is

   procedure Put_Request (Par : Param);
   --  invoked by the clients

private

   procedure Timed_Out_Sporadic_Operation (Par : Param);

   package Timed_Out_Sporadic_Server is new Sporadic_Server
     (Task_Priority,
      Minimum_Interelease_Time,
      System_Start_Time,
      Protocol_Ceiling,
      QS,
      Param,
      Timed_Out_Sporadic_Operation);
   --  The sporadic server

   Timer_Server_Suspender : Ada.Synchronous_Task_Control.Suspension_Object;
   --  A suspension object for the timer server (see below)

   task Timer_Server is
      pragma Priority (Task_Priority);
   end Timer_Server;
   --  The task which is triggered by the timer. We have an additional task
   --  to avoid having the timer itself to execute (it runs at interrupt
   --  priority).

   package My_Timer is new GNATCOLL.Ravenscar.Timers.One_Shot_Timer;
   --  the timer triggering the task if no request is posted within
   --  the maximum interrelease time

   procedure Handler;

   Handler_Access : constant GNATCOLL.Ravenscar.Timers.Timer_Action :=
                      Handler'Access;

end GNATCOLL.Ravenscar.Timed_Out_Sporadic_Server;