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
|
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- A D A . S T R E A M S . S T O R A G E . U N B O U N D E D --
-- --
-- B o d y --
-- --
-- Copyright (C) 2020-2023, Free Software Foundation, Inc. --
-- --
-- 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 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
package body Ada.Streams.Storage.Unbounded is
procedure Free is new Ada.Unchecked_Deallocation
(Elements_Type, Elements_Access);
--------------
-- Finalize --
--------------
overriding procedure Finalize (X : in out Controlled_Elements_Access) is
begin
if X.A /= Empty_Elements'Access then
Free (X.A);
end if;
end Finalize;
----------
-- Read --
----------
overriding procedure Read
(Stream : in out Stream_Type; Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
EA : Stream_Element_Array renames
Stream.Elements.A.EA (1 .. Element_Count (Stream));
begin
if Item'Length = 0 then
Last := Item'First - 1;
-- If the entire content of the stream fits in Item, then copy it and
-- clear the stream. This is likely the usual case.
elsif Element_Count (Stream) <= Item'Length then
Last := Item'First + Element_Count (Stream) - 1;
Item (Item'First .. Last) := EA;
Clear (Stream);
-- Otherwise, copy as much into Item as will fit. Then slide the
-- remaining part of the stream down, and compute the new Count.
-- We expect this to be the unusual case, so the cost of copying
-- the remaining part probably doesn't matter.
else
Last := Item'Last;
declare
New_Count : constant Stream_Element_Count :=
Element_Count (Stream) - Item'Length;
begin
Item := EA (1 .. Item'Length);
EA (1 .. New_Count) :=
EA (Element_Count (Stream) - New_Count + 1 ..
Element_Count (Stream));
Stream.Count := New_Count;
end;
end if;
end Read;
-----------
-- Write --
-----------
overriding procedure Write
(Stream : in out Stream_Type; Item : Stream_Element_Array)
is
New_Count : constant Stream_Element_Count :=
Element_Count (Stream) + Item'Length;
begin
-- Check whether we need to grow the array. If so, then if the Stream is
-- empty, allocate a goodly amount. Otherwise double the length, for
-- amortized efficiency. In any case, we need to make sure it's at least
-- big enough for New_Count.
if New_Count > Stream.Elements.A.Last then
declare
New_Last : Stream_Element_Index :=
(if Stream.Elements.A.Last = 0 then 2**10 -- goodly amount
else Stream.Elements.A.Last * 2);
Old_Elements : Elements_Access := Stream.Elements.A;
begin
if New_Last < New_Count then
New_Last := New_Count;
end if;
Stream.Elements.A := new Elements_Type (Last => New_Last);
if Old_Elements /= Empty_Elements'Access then
Stream.Elements.A.EA (Old_Elements.EA'Range) := Old_Elements.EA;
Free (Old_Elements);
end if;
end;
end if;
Stream.Elements.A.EA (Element_Count (Stream) + 1 .. New_Count) := Item;
Stream.Count := New_Count;
end Write;
-------------------
-- Element_Count --
-------------------
overriding function Element_Count
(Stream : Stream_Type) return Stream_Element_Count
is
begin
return Stream.Count;
end Element_Count;
-----------
-- Clear --
-----------
overriding procedure Clear (Stream : in out Stream_Type) is
begin
Stream.Count := 0;
-- We don't free Stream.Elements here, because we want to reuse it if
-- there are more Write calls.
end Clear;
end Ada.Streams.Storage.Unbounded;
|
