adayaml_0.3.0_ab19e387/Parser_Tools/src/implementation/text-builder.adb

  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
--  part of ParserTools, (c) 2017 Felix Krause
--  released under the terms of the MIT license, see the file "copying.txt"

package body Text.Builder is
   H_Size : constant System.Storage_Elements.Storage_Offset :=
     System.Storage_Elements.Storage_Offset (Header_Size);

   procedure Init (Object : in out Reference; Pool : Text.Pool.Reference;
                   Initial_Size : Positive := 255) is
      Base : constant Text.Reference := Pool.With_Length (Initial_Size);
      H : constant not null access Header := Header_Of (Base.Data);
   begin
      H.Refcount := H.Refcount + 1;
      H.Last := Round_To_Header_Size (H.Last + 1) - 1;
      Object.Next := 1;
      Object.Buffer := Base.Data;
      Object.Pool := Pool;
   end Init;

   function Create (Pool : Text.Pool.Reference;
                    Initial_Size : Positive := 255) return Reference is
   begin
      return Ret : Reference do
         Init (Ret, Pool, Initial_Size);
      end return;
   end Create;

   function Initialized (Object : Reference) return Boolean is
     (Object.Buffer /= null);

   procedure Grow (Object : in out Reference;
                   Size : System.Storage_Elements.Storage_Offset) is
      H : constant not null access Header := Header_Of (Object.Buffer);
      Old : constant Text.Reference := (Ada.Finalization.Controlled with
                                        Data => Object.Buffer);
      New_Buffer : constant Text.Reference :=
        Object.Pool.With_Length
          (Positive (((Object.Next + Size + H.Last) /
           (H.Last + 1)) * (H.Last + 1) - 1));
      New_H : constant not null access Header := Header_Of (New_Buffer.Data);
   begin
      New_H.Refcount := New_H.Refcount + 1;
      New_Buffer.Data (1 .. Natural (Object.Next - 1)) :=
        Old.Data (1 .. Natural (Object.Next - 1));
      Object.Buffer := New_Buffer.Data;
   end Grow;

   procedure Append (Object : in out Reference; Value : String) is
   begin
      if Object.Next + Value'Length - 1 >
        System.Storage_Elements.Storage_Offset (Object.Buffer.all'Last) then
         Grow (Object, Value'Length);
      end if;
      Object.Buffer (Positive (Object.Next) .. Natural (Object.Next +
                     Value'Length - 1)) := Value;
      Object.Next := Object.Next + Value'Length;
   end Append;

   procedure Append (Object : in out Reference; Value : Character) is
      H : Header with Import;
      for H'Address use Object.Buffer.all'Address - H_Size;
   begin
      if Object.Next > H.Last then
         Grow (Object, 1);
      end if;
      Object.Buffer (Positive (Object.Next)) := Value;
      Object.Next := Object.Next + 1;
   end Append;

   procedure Append (Object : in out Reference; Value : Text.Reference) is
   begin
      Object.Append (Value.Data.all);
   end Append;

   function Lock (Object : in out Reference) return Text.Reference is
      H : constant not null access Header := Header_Of (Object.Buffer);
      Null_Terminator : Character with Import;
      for Null_Terminator'Address use
        Object.Buffer.all'Address + Object.Next;
   begin
      Null_Terminator := Character'Val (0);
      if Round_To_Header_Size (Object.Next) /= H.Last + 1 then
         declare
            Next : Header with Import;
            for Next'Address use Object.Buffer.all'Address +
              Round_To_Header_Size (Object.Next);
         begin
            Next.Refcount := 0;
            Next.Last := H.Last + 1 - Round_To_Header_Size (Object.Next) - Header_Size;
         end;
      end if;
      H.Last := Object.Next - 1;
      return Ret : constant Text.Reference :=
        (Ada.Finalization.Controlled with Data => Object.Buffer) do
         Object.Buffer := null;
      end return;
   end Lock;

   function Length (Object : Reference) return Natural is
     (Natural (Object.Next) - 1);

   procedure Adjust (Object : in out Reference) is
   begin
      if Object.Buffer /= null then
         declare
            H : Header with Import;
            for H'Address use Object.Buffer.all'Address - H_Size;
         begin
            H.Refcount := H.Refcount + 1;
         end;
      end if;
   end Adjust;

   procedure Finalize (Object : in out Reference) is
   begin
      if Object.Buffer /= null then
         declare
            H : constant not null access Header := Header_Of (Object.Buffer);
         begin
            H.Refcount := H.Refcount - 1;
            if H.Refcount = 0 then
               H.Last := Round_To_Header_Size (H.Last + 1);
               Decrease_Usage (H.Pool, H.Chunk_Index);
            end if;
         end;
      end if;
   end Finalize;
end Text.Builder;