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 | -------------------------------------------------------------------------------
-- --
-- Copyright (C) 2020-2030, per.s.sandberg@bahnhof.se --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files --
-- (the "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, sublicense, and / or sell copies of the Software, and to --
-- permit persons to whom the Software is furnished to do so, subject to --
-- the following conditions : --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, --
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL --
-- THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR --
-- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, --
-- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR --
-- OTHER DEALINGS IN THE SOFTWARE. --
-------------------------------------------------------------------------------
with Ada.Streams;
with System;
with Ada.Finalization;
with Ada.Text_IO;
package ZMQ.Utilities.Memory_Streams is
use Ada;
-- Memory_Streams implements stream functionality to be mapped to any
-- memory location sample of use
-- declare
-- Real_Buffer : String (1 .. 1024) := (others => '#');
-- S : aliased Memory_Stream;
-- begin
-- S.Set_Address (Real_Buffer'Address);
-- S.Set_Length (Real_Buffer'Length);
--
-- String'Write (S'Access, "bulle");
-- Integer'Write (S'Access, 123);
--
-- Memory_Stream'Write(Some_UDP_Stream, S);
-- -- Write the whole serialized buffer in one transaction.
-- end;
type Memory_Stream_Interface is limited interface;
type Any_Memory_Stream_Interface is access
all Memory_Stream_Interface'Class;
--
procedure Read
(This : in out Memory_Stream_Interface;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset) is abstract;
procedure Write
(This : in out Memory_Stream_Interface;
Item : in Ada.Streams.Stream_Element_Array) is abstract;
function Get_Address
(This : in Memory_Stream_Interface) return System.Address is abstract;
-- Returns the Address to the real buffer
procedure Set_Address
(This : in out Memory_Stream_Interface;
To : in System.Address) is abstract;
-- Sets the address to the real buffer.
function Get_Length
(This : in Memory_Stream_Interface)
return Ada.Streams.Stream_Element_Count is abstract;
-- Returns the full length of the buffer.
procedure Set_Length
(This : in out Memory_Stream_Interface;
To : in Ada.Streams.Stream_Element_Count) is abstract;
-- Sets the full length of the buffer.
procedure Reset (This : in out Memory_Stream_Interface) is abstract;
-- moves the stream position to the first element in the stream.
procedure Seek (This : in out Memory_Stream_Interface;
Pos : in Ada.Streams.Stream_Element_Offset) is abstract;
-- Moves the stream position forward or backward in the message stream.
-- Sample:
-- move to the 10 element in the message.
-- Msg.Reset;
-- Msg.Seek(10);
function Pos (This : in Memory_Stream_Interface)
return Ada.Streams.Stream_Element_Offset is abstract;
-- Returns the current cursor in the buffer
function Eof (This : in Memory_Stream_Interface) return Boolean is abstract;
procedure Dump
(This : in Memory_Stream_Interface;
Full_Buffer : in Boolean := False;
Outf : in Ada.Text_IO.File_Access := Text_IO.Standard_Output)
is null;
-- Dumps the contents of the buffer from the first element
-- to the cursor.
type Memory_Stream is limited new Ada.Streams.Root_Stream_Type
and Memory_Stream_Interface
with private;
type Any_Memory_Stream is access all Memory_Stream'Class;
overriding
procedure Set_Address
(This : in out Memory_Stream; To : in System.Address);
-- Sets the address to the real buffer.
overriding
function Get_Address
(This : in Memory_Stream) return System.Address;
overriding
function Get_Length (This : in Memory_Stream)
return Ada.Streams.Stream_Element_Count;
-- Returns the full length of the buffer.
overriding
procedure Set_Length (This : in out Memory_Stream;
To : in Ada.Streams.Stream_Element_Count);
-- Sets the full length of the buffer.
overriding
procedure Reset (This : in out Memory_Stream);
-- moves the stream position to the first element in the stream.
overriding
procedure Seek (This : in out Memory_Stream;
Pos : in Ada.Streams.Stream_Element_Offset);
-- Moves the stream position forward or backward in the message stream.
-- Sample:
-- move to the 10 element in the message.
-- Msg.Reset;
-- Msg.Seek(10);
overriding
function Pos (This : in Memory_Stream)
return Ada.Streams.Stream_Element_Offset;
-- Returns the current cursor in the buffer
overriding
function Eof (This : in Memory_Stream) return Boolean;
overriding
procedure Dump
(This : in Memory_Stream;
Full_Buffer : in Boolean := False;
Outf : in Ada.Text_IO.File_Access := Ada.Text_IO.Standard_Output);
-- Dumps the contents of the buffer from the first element
-- to the cursor.
overriding procedure Read
(This : in out Memory_Stream;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
overriding procedure Write
(This : in out Memory_Stream;
Item : in Ada.Streams.Stream_Element_Array);
type Expand_Strategy is (As_Needed,
Multiply_By_Two,
Add_Initial_Size);
type Dynamic_Memory_Stream
(Initial_Size : Ada.Streams.Stream_Element_Offset;
Strategy : Expand_Strategy) is new Memory_Stream with private;
overriding procedure Write
(This : in out Dynamic_Memory_Stream;
Item : in Ada.Streams.Stream_Element_Array);
private
subtype Large_Buffer is
Streams.Stream_Element_Array (1 .. Streams.Stream_Element_Offset'Last);
type Large_Buffer_Access is access Large_Buffer;
for Large_Buffer_Access'Storage_Size use 0;
type Large_Buffer_Union (Ref : Boolean := False) is record
case Ref is
when True =>
As_Address : System.Address;
when False =>
As_Pointer : Large_Buffer_Access;
end case;
end record;
pragma Unchecked_Union (Large_Buffer_Union);
type Memory_Stream is limited new Streams.Root_Stream_Type
and Memory_Stream_Interface
with record
Buffer : Large_Buffer_Union;
Buffer_Length : Streams.Stream_Element_Count := 0;
Cursor : Streams.Stream_Element_Offset := 0;
end record;
procedure Read
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : out Memory_Stream);
for Memory_Stream'Read use Read;
procedure Write
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Memory_Stream);
for Memory_Stream'Write use Write;
type Controler (Controled : not null access Dynamic_Memory_Stream)
is new Ada.Finalization.Limited_Controlled with null record;
procedure Initialize (This : in out Controler);
procedure Finalize (This : in out Controler);
type Dynamic_Memory_Stream
(Initial_Size : Streams.Stream_Element_Offset;
Strategy : Expand_Strategy) is new Memory_Stream with
record
C : Controler (Dynamic_Memory_Stream'Access);
end record;
procedure Initialize (This : in out Dynamic_Memory_Stream);
procedure Finalize (This : in out Dynamic_Memory_Stream);
procedure Read
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : out Dynamic_Memory_Stream);
for Dynamic_Memory_Stream'Read use Read;
procedure Write
(This : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Dynamic_Memory_Stream);
for Dynamic_Memory_Stream'Write use Write;
procedure Expand
(This : in out Dynamic_Memory_Stream;
To_Size : Ada.Streams.Stream_Element_Offset);
end ZMQ.Utilities.Memory_Streams;
|