/usr/share/ada/adainclude/gnatcoll/gnatcoll-ravenscar-multiple_queue_sporadic_server.ads is in libgnatcoll1.6-dev 1.6gpl2014-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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-2014, 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;
|