File: gnatcoll-ravenscar-multiple_queue_sporadic_server.adb

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 (159 lines) | stat: -rw-r--r-- 5,637 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
------------------------------------------------------------------------------
--                                                                          --
--                	        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.      --
--                                                                          --
------------------------------------------------------------------------------

with GNATCOLL.Ravenscar.Utils;

package body GNATCOLL.Ravenscar.Multiple_Queue_Sporadic_Server is
   use GNATCOLL.Ravenscar.Utils;

   procedure Put_Request
     (Req      : Request;
      Kind : Request_Kind)
   is
   begin

      --  Simply delegates to Protocol.Put

      Protocol.Put (Req, Kind);

   end Put_Request;

   protected body Protocol is

      procedure Update_Barrier is
      begin
         Barrier := Pending > 0;
      end Update_Barrier;
      pragma Inline (Update_Barrier);

      procedure Put
        (Req      : Request;
         Kind : Request_Kind)
      is
         Ref : constant Request_Type_Ref :=
            Queues (Kind) (Insert_Index (Kind))'Access;
      begin

         --  put the Req in the appropriate queue

         Queues (Kind) (Insert_Index (Kind))   := Req;

         --  increase insert index

         Increase_Counter (Insert_Index (Kind), QS);
         if Pending < Pointer_Queue_Range_Max then
            Pending := Pending + 1;
         end if;

         --  save pointer to last Req on a queue

         Ptr_Queue (Pointer_Queue_Insert_Index) := (Kind, Ref);
         Increase_Counter
           (Pointer_Queue_Insert_Index,
            Pointer_Queue_Range_Max);

         --  if there has been an overflow, increase also the Extract index.
         --  This is because the insert index has surpassed the extract index,
         --  overwriting older request. It is thus necessary to increase the
         --  extract index to avoid to fetch a newly posted request instead
         --  of older ones.

         if Pointer_Queue_Overflow then
            Increase_Counter
              (Pointer_Queue_Extract_Index,
               Pointer_Queue_Range_Max);
         end if;

         --  Check if the Insert_Index is going to surpass the extract index
         if Pointer_Queue_Insert_Index = Pointer_Queue_Extract_Index then
            Pointer_Queue_Overflow := True;
         end if;

         --  update the barrier

         Update_Barrier;

      end Put;

      procedure Get_Next_Request (Req : out Request) is
         Ref : Pointer_Queue_Item_Ref := null;
      begin

         if Pointer_Queue_Insert_Index = Pointer_Queue_Extract_Index then
            Pointer_Queue_Overflow := False;
         end if;

         --  get the oldest Req
         Ref := Ptr_Queue (Pointer_Queue_Extract_Index)'Access;
         Increase_Counter
           (Pointer_Queue_Extract_Index,
            Pointer_Queue_Range_Max);

         Req     := Ref.Req.all;

         Pending := Pending - 1;

      end Get_Next_Request;
      pragma Inline (Get_Next_Request);

      entry Get
        (Req      : out Request;
         Release_Time : out Ada.Real_Time.Time) when Barrier
      is
      begin
         Release_Time := Ada.Real_Time.Clock;
         Get_Next_Request (Req);
         Update_Barrier;
      end Get;

   end Protocol;

   task body Sporadic_Task is
      Req      : Request;
      Release_Time : Ada.Real_Time.Time;
      Next_Time    : Ada.Real_Time.Time := System_Start_Time;
      use Ada.Real_Time;
   begin

      loop

         --  report.Print(natural'Image(Pointer_Queue_Range_Max));
         delay until Next_Time;

         Protocol.Get (Req, Release_Time);

         Dispatch (Req);

         Next_Time := Release_Time + Milliseconds (Minimum_Interelease_Time);

      end loop;

   end Sporadic_Task;

end GNATCOLL.Ravenscar.Multiple_Queue_Sporadic_Server;