reference counting experiment in h3

lib2/h3-strings.adb

@@ -1,5 +1,6 @@
 with Ada.Unchecked_Deallocation;
 
+with system.address_image;	
 with ada.text_io;
 
 package body H3.Strings is
@@ -10,16 +11,34 @@ package body H3.Strings is
 		return Str.Buffer.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last);
 	end To_Character_Array;
 
+	-- return the buffer capacity excluding the terminator
 	function Get_Capacity (Str: in Elastic_String) return System_Size is
 	begin
 		return Str.Buffer.Slot'Length - 1;
 	end Get_Capacity;
 
+	-- return the buffer capacity including the terminator
+	function Get_Hard_Capacity (Str: in Elastic_String) return System_Size is
+	begin
+		return Str.Buffer.Slot'Length;
+	end Get_Hard_Capacity;
+	pragma inline (Get_Hard_Capacity);
+
 	function Get_Length (Str: in Elastic_String) return System_Size is
 	begin
-		return Str.Buffer.Last - Str.Buffer.Slot'First + 1;
+		return 1 + Str.Buffer.Last - Str.Buffer.Slot'First;
 	end Get_Length;
 
+	function Get_First_Index (Str: in Elastic_String) return System_Size is
+	begin
+		return Str.Buffer.Slot'First;
+	end Get_First_Index;
+
+	function Get_Last_Index (Str: in Elastic_String) return System_Size is
+	begin
+		return Str.Buffer.Last;
+	end Get_Last_Index;
+
 	function Get_Item (Str: in Elastic_String; Pos: in System_Index) return Character_Type is
 	begin
 		return Str.Buffer.Slot(Pos);
@@ -55,54 +74,86 @@ package body H3.Strings is
 	procedure Ref_Buffer (Buf: in out Buffer_Pointer) is
 	begin
 		if Buf /= Empty_Buffer'Access then
-ada.text_io.put_line ("ref_buffer -> " & Buf.Refs'Img);
 			Buf.Refs := Buf.Refs + 1;
 		end if;
 	end Ref_Buffer;
 
-	procedure Deref_Buffer (Buf: in out Buffer_Pointer) is
+	procedure Unref_Buffer (Buf: in out Buffer_Pointer) is
 	begin
 		if Buf /= Empty_Buffer'Access then
-ada.text_io.put_line ("deref_buffer -> " & Buf.Refs'Img);
 			if Buf.Refs = 1 then
 				declare
 					procedure Free is new Ada.Unchecked_Deallocation(Buffer_Record, Buffer_Pointer);
 				begin
 					Free (Buf);
 				end;
+				Buf := Empty_Buffer'Access;
 			else
 				Buf.Refs := Buf.Refs - 1;
 			end if;
 		end if;
-	end Deref_Buffer;
+	end Unref_Buffer;
+
+	function New_Buffer_Container (Hard_Capa: in System_Size) return Elastic_String is
+		Tmp: Elastic_String;
+	begin
+		Tmp.Buffer := new Buffer_Record(Hard_Capa);
+		Tmp.Buffer.Refs := 1;
+		return Tmp;
+	end New_Buffer_Container;
 
 	procedure Prepare_Buffer (Str: in out Elastic_String) is
-		Tmp: Buffer_Pointer;
+		Tmp: Elastic_String;
 	begin
 		if Str.Buffer /= Empty_Buffer'Access then
 			if Is_Shared(Str) then
-				Tmp := new Buffer_Record(Str.Buffer.Slot'Length);
+				-- The code like this doesn't work correctly in terms of finalization.
-				Tmp.Slot := Str.Buffer.Slot;
+				-- The buffer pointer held inside a finalization controlled record must be 
-				Tmp.Last := Str.Buffer.Last;
+				-- manipluated through the record itself. otherwise, the Adjust and Finalize
-				Tmp.Refs := 1;	--Ref_Buffer (Tmp);
+				-- calls goes incompatible with the reference counting implementation.
-				Deref_Buffer (Str.Buffer);
+				-- It is because finalization is set on the record rather than the buffer pointer.
-				Str.Buffer := Tmp;
+				--Tmp: Buffer_Pointer;
+				--Tmp := new Buffer_Record(Get_Hard_Capacity(Str));
+				--Tmp.Slot := Str.Buffer.Slot;
+				--Tmp.Last := Str.Buffer.Last;
+				--Tmp.Refs := 1;
+				--Unref_Buffer (Str.Buffer);
+				--Str.Buffer := Tmp;
+				Tmp := Str;
+				Str := New_Buffer_Container(Get_Hard_Capacity(Str));
+				Str.Buffer.Slot := Tmp.Buffer.Slot;
+				Str.Buffer.Last := Tmp.Buffer.Last;
 			end if;
 		end if;
 	end Prepare_Buffer;
 
-	procedure Prepare_Buffer (Str: in out Elastic_String; ReqCapa: in System_Size) is
+	-- prepare the buffer for writing 
-		Tmp: Buffer_Pointer;
+	procedure Prepare_Buffer (Str: in out Elastic_String; Req_Hard_Capa: in System_Size) is
+		Tmp: Elastic_String;
+		First, Last: System_Size;
+		Hard_Capa: System_Size;
 	begin
-		if Str.Buffer /= Empty_Buffer'Access then
+		First := Get_First_Index(Str);
-			if Is_Shared(Str) then
+		Last := Get_Last_Index(Str);
-				-- ReqCapa must be greater than Str.Buffer.Slot'Length
+
-				Tmp := new Buffer_Record(ReqCapa);
+		if Str.Buffer /= Empty_Buffer'Access and then Is_Shared(Str) then
-				Tmp.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last + 1) := Str.Buffer.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last + 1);
+			if Req_Hard_Capa < Get_Hard_Capacity(Str) then
-				Tmp.Last := Str.Buffer.Last;
+				Hard_Capa := Get_Hard_Capacity(Str);
-				Tmp.Refs := 1; --Ref_Buffer (Tmp);
+			else
-				Deref_Buffer (Str.Buffer);
+				Hard_Capa := Req_Hard_Capa;
-				Str.Buffer := Tmp;
+			end if;
+
+			Tmp := New_Buffer_Container(Hard_Capa);
+			Tmp.Buffer.Slot(First .. Last + 1) := Str.Buffer.Slot(First .. Last + 1);
+			Tmp.Buffer.Last := Last;
+
+			Str := Tmp;
+		else
+			if Req_Hard_Capa > Get_Hard_Capacity(Str) then
+				Tmp := Str;
+				Str := New_Buffer_Container(Req_Hard_Capa);
+				Str.Buffer.Slot(First .. Last + 1) := Tmp.Buffer.Slot(First .. Last + 1);
+				Str.Buffer.Last := Last;
 			end if;
 		end if;
 	end Prepare_Buffer;
@@ -110,32 +161,20 @@ ada.text_io.put_line ("deref_buffer -> " & Buf.Refs'Img);
 	procedure Clear (Str: in out Elastic_String) is
 	begin
 		Prepare_Buffer (Str);
-		Str.Buffer.Last := Str.Buffer.Slot'First - 1;
+		Str.Buffer.Last := Get_First_Index(Str) - 1;
 	end Clear;
 
 	procedure Purge (Str: in out Elastic_String) is
 	begin 
-		Deref_Buffer (Str.Buffer);
+		Unref_Buffer (Str.Buffer);
 		Str.Buffer := Empty_Buffer'Access;
 	end Purge;
 
 -- TODO: operator "&"
 	procedure Append (Str: in out Elastic_String; V: in Character_Array) is
-		ReqCapa: System_Size;
-		Tmp: Buffer_Pointer;
 	begin
-		if V'Length > 0 then
+		if V'Length > 0 then	
-			ReqCapa := H3.Align(Str.Buffer.Last + V'Length + 1, BUFFER_ALIGN);
+			Prepare_Buffer (Str, H3.Align(Get_Length(Str) + V'Length + 1, BUFFER_ALIGN));
-			Prepare_Buffer (Str, ReqCapa);
-
-			if ReqCapa > Get_Capacity(Str) then
-				Tmp := new Buffer_Record(ReqCapa);
-				Tmp.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last) := Str.Buffer.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last);
-				Tmp.Last := Str.Buffer.Last;
-				Free_Buffer (Str);
-				Str.Buffer := Tmp;
-			end if;
-
 			Str.Buffer.Slot(Str.Buffer.Last + 1 .. Str.Buffer.Last + V'Length) := V;
 			Str.Buffer.Last := Str.Buffer.Last + V'Length;
 			Str.Buffer.Slot(Str.Buffer.Last + 1) := Null_Character;
@@ -153,26 +192,21 @@ ada.text_io.put_line ("deref_buffer -> " & Buf.Refs'Img);
 		null;
 	end Delete;
 
-
-
 	-- ---------------------------------------------------------------------
 	-- Controlled Management
 	-- ---------------------------------------------------------------------
 	procedure Initialize (Str: in out Elastic_String) is
 	begin
-ada.text_io.put_line("ES Initialize");
 		null;
 	end Initialize;
 
 	procedure Adjust (Str: in out Elastic_String) is
 	begin
-ada.text_io.put_line("ES Adhust");
 		Ref_Buffer (Str.Buffer);
 	end Adjust;
 
 	procedure Finalize (Str: in out Elastic_String) is
 	begin
-ada.text_io.put_line("ES Finalize");
+		Unref_Buffer (Str.Buffer);
-		Deref_Buffer (Str.Buffer);
 	end Finalize;
 end H3.Strings;

lib2/h3-strings.ads

@@ -16,37 +16,46 @@ package H3.Strings is
 	function To_Character_Array (Str: in Elastic_String) return Character_Array;
 
 	function Get_Capacity (Str: in Elastic_String) return System_Size;
-	pragma Inline (Get_Capacity);
+	pragma inline (Get_Capacity);
 
 	function Get_Length (Str: in Elastic_String) return System_Size;
-	pragma Inline (Get_Length);
+	pragma inline (Get_Length);
+
+	-- the return type is System_Size for consistency with Get_FIrst_Index.
+	function Get_First_Index (Str: in Elastic_String) return System_Size;
+	pragma inline (Get_First_Index);
+
+	-- the return type is System_Size because the Last index can be -1 off the System_Index'First.
+	function Get_Last_Index (Str: in Elastic_String) return System_Size;
+	pragma inline (Get_Last_index);
 
 	function Get_Item (Str: in Elastic_String; Pos: in System_Index) return Character_Type;
-	pragma Inline (Get_Item);
+	pragma inline (Get_Item);
 
+	-- unsafe
 	function Get_Slot_Pointer (Str: in Elastic_String) return Thin_Character_Array_Pointer;
-	pragma Inline (Get_Slot_Pointer);
+	pragma inline (Get_Slot_Pointer);
 
 	function Is_Shared(Str: in Elastic_String) return Standard.Boolean;
+	pragma inline (Is_Shared);
 
-	procedure Clear (Str: in out Elastic_String);
 	procedure Purge (Str: in out Elastic_String);
+	procedure Clear (Str: in out Elastic_String);
 
 	procedure Append (Str: in out Elastic_String; V: in Character_Array);
 	procedure Append (Str: in out Elastic_String; V: in Character_Type);
 
 private
-	
+	type Buffer_Record(Capa: System_Size) is limited record
-	type Buffer_Record(Size: System_Size) is limited record
+		Refs: System_Size := 1;
-		Refs: System_Size := 0;
+		Slot: Character_Array(1 .. Capa);
-		Slot: Character_Array(1 .. Size);
 		Last: System_Size := 0;
 	end record;
 
 	type Buffer_Pointer is access all Buffer_Record;
 
 	--Empty_Buffer: aliased Buffer_Record(1);
-	Empty_Buffer: aliased Buffer_Record := (Size => 1, Refs => 0, Slot => (1 => Null_Character), Last => 0);
+	Empty_Buffer: aliased Buffer_Record := (Capa => 1, Refs => 0, Slot => (1 => Null_Character), Last => 0);
 
 	type Elastic_String is new Ada.Finalization.Controlled with record
 		Buffer: Buffer_Pointer := Empty_Buffer'Access;
@@ -56,6 +65,4 @@ private
 	overriding procedure Adjust     (Str: in out Elastic_String);
 	overriding procedure Finalize   (Str: in out Elastic_String);
 
-
-
 end H3.Strings;

lib2/hello.adb

@@ -9,6 +9,7 @@ with System.Pool_Global;
 with Ada.Unchecked_Deallocation;
 with Ada.Text_IO;
 with Ada.Wide_Text_IO;
+with Ada.Assertions;
 
 procedure hello is
 	package S is new H3.Strings(Wide_Character, Wide_Character'Val(0));
@@ -84,28 +85,40 @@ begin
 	
 	declare
 		str: S.Elastic_String;
+		str2: S.Elastic_String;
 		len: H3.System_Size;
 		capa: H3.System_Size;
+		first: H3.System_Size;
+		last: H3.System_Size;
 	begin
 		len := S.Get_Length(Str);
 		capa := S.Get_Capacity(Str);
-		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img);
+		first := S.Get_First_Index(Str);
+		last := S.Get_Last_Index(Str);
+		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
 
 		S.Append(Str, "Hello, world");
 		len := S.Get_Length(Str);
 		capa := S.Get_Capacity(Str);
-		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img);
+		first := S.Get_First_Index(Str);
+		last := S.Get_Last_Index(Str);
+		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
+		
 
 		S.Append(Str, "");
 		len := S.Get_Length(Str);
 		capa := S.Get_Capacity(Str);
-		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img);
+		first := S.Get_First_Index(Str);
-
+		last := S.Get_Last_Index(Str);
-		S.Append(Str, "donkey");
+		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
+		
+--		S.Append(Str, "donkey");
 		len := S.Get_Length(Str);
 		capa := S.Get_Capacity(Str);
-		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img);
+		first := S.Get_First_Index(Str);
-
+		last := S.Get_Last_Index(Str);
+		Ada.Text_IO.Put_Line ("length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
+		
 		
 		declare
 			arr: constant S.Character_Array := S.To_Character_Array(str);
@@ -119,15 +132,45 @@ begin
 		
 		-- unsafe way to access the internal buffer.
 		S.Append (Str, 'X');
+		S.Append(Str, "donkeyX");
+		S.Append(Str, "ABCDE");
+
+		Str2 := Str;
+		S.Append (Str2, "EXTRA");
+		S.Append (Str2, " THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR H3");
+	
+
 		declare
 			arr: constant S.Thin_Character_Array_Pointer := S.Get_Slot_Pointer(Str);
+			arr2: constant S.Thin_Character_Array_Pointer := S.Get_Slot_Pointer(Str2);
 			use type H3.System_Word;
 		begin
+			Ada.Assertions.Assert (S.Get_Length(Str) = 25, "invalid string length");
+			Ada.Assertions.Assert (S.Get_Length(Str2) = 78, "invalid string length");
+
+			len := S.Get_Length(Str);
+			capa := S.Get_Capacity(Str);
+			first := S.Get_First_Index(Str);
+			last := S.Get_Last_Index(Str);
+			Ada.Text_IO.Put_Line ("STR length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
+			
 			Ada.Wide_Text_IO.Put ("[");	
-			for i in 1 .. S.Get_Length(Str) + 1 loop
+			for i in S.Get_First_Index(Str) .. S.Get_Last_Index(Str) + 1 loop
 				Ada.Wide_Text_IO.Put (arr.all(i));
 			end loop;
 			Ada.Wide_Text_IO.Put_Line ("]");	
+
+			len := S.Get_Length(Str2);
+			capa := S.Get_Capacity(Str2);
+			first := S.Get_First_Index(Str2);
+			last := S.Get_Last_Index(Str2);
+			Ada.Text_IO.Put_Line ("STR2 length=>" & len'Img & " Capacity=>" & capa'Img & " First=>" & first'img & " Last=>" & last'img);
+		
+			Ada.Wide_Text_IO.Put ("[");	
+			for i in S.Get_First_Index(Str2) .. S.Get_Last_Index(Str2) + 1 loop
+				Ada.Wide_Text_IO.Put (arr2.all(i));
+			end loop;
+			Ada.Wide_Text_IO.Put_Line ("]");	
 		end;
 
 		--declare