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
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396 | -- --
-- package Copyright (c) Dmitry A. Kazakov --
-- Synchronization.Interprocess Luebeck --
-- Interface Spring, 2018 --
-- --
-- Last revision : 22:08 06 Jan 2020 --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public License as --
-- published by the Free Software Foundation; either version 2 of --
-- the License, or (at your option) any later version. This library --
-- is distributed in the hope that it will be useful, but WITHOUT --
-- 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 along with --
-- this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
--____________________________________________________________________--
--
-- The parent package of the child packages providing implementations
-- of various inter-process synchronization primitives. This is Linux
-- variant of the package.
--
with Ada.Streams; use Ada.Streams;
with Interfaces.C.Strings; use Interfaces;
with System.Storage_Elements; use System.Storage_Elements;
with System.Storage_Pools; use System.Storage_Pools;
with Ada.Finalization;
with Synchronization.Linux;
package Synchronization.Interprocess is
--
-- Shared_Directory -- The location of shared memory mapped files. The
-- shared mapping file is constructed from this
-- prefix and the name supplied in Create or Open.
--
Shared_Directory : constant String := "/tmp/";
--
-- Environment is an object handling inter-process syncronization. Each
-- process must have an instance of the environment. The first process
-- creates environment under a system-wide name. The following
-- processes connect to the environment using this name.
--
type Abstract_Shared_Environment is abstract
new Ada.Finalization.Limited_Controlled with private;
--
-- Abstract_Shared_Object -- Base type of a shared object
--
type Abstract_Shared_Object is abstract
new Ada.Finalization.Limited_Controlled with private;
--
-- Create -- Environment
--
-- Shared - The environment object
-- Name - The unique system-wide name to identify the environment
--
-- The name must be a legal simple file name. The first process must use
-- this call to create and initialize the environment.
--
-- Exceptions :
--
-- Data_Error - I/O errors
-- Mode_Error - Invalid configuration of the environment
-- Name_Error - Invalid name
-- Status_Error - The environment is alreay open
-- Use_Error - The environment already exists
--
procedure Create
( Shared : in out Abstract_Shared_Environment;
Name : String
);
--
-- Close -- Environment
--
-- Shared - The environment object
--
-- This procedure is void if the system automatically collects the
-- shared environment resource. Under an OS like Linux it can be used
-- to ensure that the resource, e.g. file is deleted upon abnormal
-- completion of the program. The effect of a call to close can be that
-- no more processes can join using the environment.
--
-- Exceptions :
--
-- Status_Error - The environment is not open
--
procedure Close (Shared : in out Abstract_Shared_Environment);
--
-- Finalize -- Destruction
--
-- Shared - The environment object
--
-- When the process that created environment destroys the object no more
-- processes can connect to it. The processes already connected may
-- continue using it. The environment is ultimately destroyed when the
-- last process destroys its object.
--
procedure Finalize (Shared : in out Abstract_Shared_Environment);
--
-- Get_Offset -- The offset in the shared memory
--
-- Object - The shared object
--
-- Returns :
--
-- The offset to the object data in the shared memory
--
function Get_Offset
( Object : Abstract_Shared_Object
) return Storage_Offset;
--
-- Get_Signature -- The signature of the object, used for checking
--
-- Object - The shared object
--
-- The signature is used in order to verify if the shared environment
-- contains same objects in all instances. The default implementation
-- calculates the signature from the external tag name.
--
-- Returns :
--
-- The signature
--
function Get_Signature
( Object : Abstract_Shared_Object
) return Unsigned_16;
--
-- Get_Size -- The amount of shared memory required by the object
--
-- Object - The shared object
--
-- Returns :
--
-- Memory in storage elements
--
function Get_Size
( Object : Abstract_Shared_Object
) return Storage_Count is abstract;
--
-- Get_Size -- The amount of shared memory used by the environment
--
-- Returns :
--
-- Memory in storage elements
--
function Get_Size
( Shared : Abstract_Shared_Environment
) return Storage_Count;
--
-- Initialize -- Construction
--
-- Shared - The environment object
--
-- The environment is first usable after Create or Open.
--
procedure Initialize (Shared : in out Abstract_Shared_Environment);
--
-- Map -- Object mapping notification
--
-- Object - The object
-- Shared - The shared environment holding the object
-- Location - The address assigned to the object in the shared memory
-- Size - Of the object as reported by Get_Size
-- Owner - The shared memory is owned by the process
--
-- This procedure is called once upon shared memory is mapped. The
-- parameter Owner is true when the process created the memory map. Thus
-- if the shared object requires initialization done once, this is a
-- hint when to perform initialization. After returning from Map the
-- object must become fully operational.
--
-- Exceptions :
--
-- Mode_Error - Invalid configuration of the environment
--
procedure Map
( Object : in out Abstract_Shared_Object;
Shared : in out Abstract_Shared_Environment'Class;
Location : System.Address;
Size : Storage_Count;
Owner : Boolean
) is abstract;
--
-- Open -- Connect to an existing environment
--
-- Shared - The environment object
-- Name - The name
-- Create - Create if does not exist
--
-- Exceptions :
--
-- Data_Error - I/O errors
-- Mode_Error - Invalid configuration of the environment
-- Name_Error - Invalid name
-- Status_Error - The environment is alreay open
-- Use_Error - The environment does not exist (Create is False)
--
procedure Open
( Shared : in out Abstract_Shared_Environment;
Name : String;
Create : Boolean := False
);
--
-- Start -- Object start notification
--
-- Object - The object
-- Shared - The shared environment holding the object
-- Owner - The shared memory is owned by the process
--
-- This procedure is called after all objects are mapped. The default
-- implementation does nothing.
--
-- Exceptions :
--
-- Mode_Error - Invalid configuration of the environment
--
procedure Start
( Object : in out Abstract_Shared_Object;
Shared : in out Abstract_Shared_Environment'Class;
Owner : Boolean
);
--
-- Unmap -- The object
--
-- Object - The object
-- Owner - The shared memory is owned by the process
--
-- This procedure is reverse to Map. The default implementation does
-- nothing.
--
procedure Unmap
( Object : in out Abstract_Shared_Object;
Shared : in out Abstract_Shared_Environment'Class;
Owner : Boolean
);
--
-- Generic_Map -- Mapping and initializing objects
--
-- Location - The address of the object
-- Owner - True if the object is to be initialized
--
-- Returns :
--
-- Pointer to the object
--
generic
type Object_Type is limited private;
package Generic_Memory_Mapper is
type Object_Type_Ptr is access all Object_Type;
function Map
( Location : System.Address;
Owner : Boolean
) return Object_Type_Ptr;
end Generic_Memory_Mapper;
--
-- Get_Signature -- From a string
--
-- Data - To compute signature
--
-- Returns :
--
-- The signature
--
function Get_Signature (Data : String) return Unsigned_16;
--
-- Process_ID -- The process ID
--
subtype Process_ID is Synchronization.Linux.pid_t;
Null_Process : constant Process_ID := 0;
--
-- Get_Process_ID -- Get process ID
--
-- Returns :
--
-- The process ID
--
function Get_Process_ID return Process_ID
renames Synchronization.Linux.getpid;
private
use Interfaces.C;
use Interfaces.C.Strings;
use Synchronization.Linux;
use System;
type Abstract_Shared_Object_Ptr is
access all Abstract_Shared_Object'Class;
type Abstract_Shared_Object is abstract
new Ada.Finalization.Limited_Controlled with
record
Self : Abstract_Shared_Object_Ptr :=
Abstract_Shared_Object'Unchecked_Access;
Next : Abstract_Shared_Object_Ptr;
Shared_Size : Storage_Count := 0;
Offset : Storage_Offset := 0;
end record;
--
-- Enumerate -- Fake stream I/O procedure
--
-- This procedure is used internally in order to enumerate the contents
-- of the record type, a descendant of Connection. The elements of the
-- record type derived from Data_Item are ones which will be fed with
-- data received from the socket.
--
procedure Enumerate
( Stream : access Root_Stream_Type'Class;
Object : Abstract_Shared_Object
);
for Abstract_Shared_Object'Write use Enumerate;
type Head is record
Size : Storage_Count; -- Size of the mapping
Checksum : Unsigned_32; -- Of the contents
Initialized : Boolean;
Owner : pid_t; -- The owner process ID
end record;
type Head_Ptr is access all Head;
type Abstract_Shared_Environment is abstract
new Ada.Finalization.Limited_Controlled with
record
File : int := -1; -- FD of mapping
Owner : Boolean := False; -- Created here
Name : chars_ptr := Null_Ptr; -- File mapping name
Map : Head_Ptr; -- Address of the memory
First : Abstract_Shared_Object_Ptr; -- The first object inside
end record;
procedure Write
( Stream : access Root_Stream_Type'Class;
Environment : Abstract_Shared_Environment
);
for Abstract_Shared_Environment'Write use Write;
type Walker is new Root_Stream_Type with record
Sum_1 : Unsigned_32 := 0; -- Checksum accumulators
Sum_2 : Unsigned_32 := 0;
Position : Unsigned_32 := 0;
Size : Storage_Count := 0; -- The memory map size
First : Abstract_Shared_Object_Ptr; -- First object inside
Last : Abstract_Shared_Object_Ptr; -- First object inside
end record;
procedure Read
( Stream : in out Walker;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset
);
procedure Write
( Stream : in out Walker;
Item : in Stream_Element_Array
);
--
-- Round -- To the memory marging
--
-- Offset - The memory offset
--
function Round (Offset : Storage_Count) return Storage_Count;
--
-- Memory_Mapper -- Initialization of external objects
--
type Memory_Mapper is new Root_Storage_Pool with record
Location : Address;
end record;
procedure Allocate
( Pool : in out Memory_Mapper;
Storage_Address : out Address;
Size : Storage_Count;
Alignment : Storage_Count
);
procedure Deallocate
( Pool : in out Memory_Mapper;
Storage_Address : Address;
Size : Storage_Count;
Alignment : Storage_Count
);
function Storage_Size (Pool : Memory_Mapper) return Storage_Count;
function Compare_And_Swap
( Target : access short;
Old_Val : short;
New_Val : short
) return Boolean;
pragma Import
( Intrinsic,
Compare_And_Swap,
"__sync_bool_compare_and_swap_2"
);
end Synchronization.Interprocess;
|