1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT LIBRARY COMPONENTS                          --
4--                                                                          --
5--         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        --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--             Copyright (C) 2020-2021, Free Software Foundation, Inc.      --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17--                                                                          --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 3.1, as published by the Free Software Foundation.               --
21--                                                                          --
22-- You should have received a copy of the GNU General Public License and    --
23-- a copy of the GCC Runtime Library Exception along with this program;     --
24-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25-- <http://www.gnu.org/licenses/>.                                          --
26--                                                                          --
27------------------------------------------------------------------------------
28
29with Ada.Unchecked_Deallocation;
30
31package body Ada.Streams.Storage.Unbounded is
32
33   procedure Free is new Ada.Unchecked_Deallocation
34     (Elements_Type, Elements_Access);
35
36   --------------
37   -- Finalize --
38   --------------
39
40   overriding procedure Finalize (X : in out Controlled_Elements_Access) is
41   begin
42      if X.A /= Empty_Elements'Access then
43         Free (X.A);
44      end if;
45   end Finalize;
46
47   ----------
48   -- Read --
49   ----------
50
51   overriding procedure Read
52     (Stream : in out Stream_Type; Item : out Stream_Element_Array;
53      Last   :    out Stream_Element_Offset)
54   is
55      EA : Stream_Element_Array renames
56        Stream.Elements.A.EA (1 .. Element_Count (Stream));
57   begin
58      if Item'Length = 0 then
59         Last := Item'First - 1;
60
61      --  If the entire content of the stream fits in Item, then copy it and
62      --  clear the stream. This is likely the usual case.
63
64      elsif Element_Count (Stream) <= Item'Length then
65         Last := Item'First + Element_Count (Stream) - 1;
66         Item (Item'First .. Last) := EA;
67         Clear (Stream);
68
69      --  Otherwise, copy as much into Item as will fit. Then slide the
70      --  remaining part of the stream down, and compute the new Count.
71      --  We expect this to be the unusual case, so the cost of copying
72      --  the remaining part probably doesn't matter.
73
74      else
75         Last := Item'Last;
76
77         declare
78            New_Count : constant Stream_Element_Count :=
79              Element_Count (Stream) - Item'Length;
80         begin
81            Item := EA (1 .. Item'Length);
82            EA (1 .. New_Count) :=
83              EA (Element_Count (Stream) - New_Count + 1 ..
84                  Element_Count (Stream));
85            Stream.Count := New_Count;
86         end;
87      end if;
88   end Read;
89
90   -----------
91   -- Write --
92   -----------
93
94   overriding procedure Write
95     (Stream : in out Stream_Type; Item : Stream_Element_Array)
96   is
97      New_Count : constant Stream_Element_Count :=
98        Element_Count (Stream) + Item'Length;
99   begin
100      --  Check whether we need to grow the array. If so, then if the Stream is
101      --  empty, allocate a goodly amount. Otherwise double the length, for
102      --  amortized efficiency. In any case, we need to make sure it's at least
103      --  big enough for New_Count.
104
105      if New_Count > Stream.Elements.A.Last then
106         declare
107            New_Last : Stream_Element_Index :=
108              (if Stream.Elements.A.Last = 0 then 2**10 -- goodly amount
109               else Stream.Elements.A.Last * 2);
110            Old_Elements : Elements_Access := Stream.Elements.A;
111         begin
112            if New_Last < New_Count then
113               New_Last := New_Count;
114            end if;
115
116            Stream.Elements.A := new Elements_Type (Last => New_Last);
117
118            if Old_Elements /= Empty_Elements'Access then
119               Stream.Elements.A.EA (Old_Elements.EA'Range) := Old_Elements.EA;
120               Free (Old_Elements);
121            end if;
122         end;
123      end if;
124
125      Stream.Elements.A.EA (Element_Count (Stream) + 1 .. New_Count) := Item;
126      Stream.Count := New_Count;
127   end Write;
128
129   -------------------
130   -- Element_Count --
131   -------------------
132
133   overriding function Element_Count
134     (Stream : Stream_Type) return Stream_Element_Count
135   is
136   begin
137      return Stream.Count;
138   end Element_Count;
139
140   -----------
141   -- Clear --
142   -----------
143
144   overriding procedure Clear (Stream : in out Stream_Type) is
145   begin
146      Stream.Count := 0;
147      --  We don't free Stream.Elements here, because we want to reuse it if
148      --  there are more Write calls.
149   end Clear;
150
151end Ada.Streams.Storage.Unbounded;
152