reference counting experiment in h3
This commit is contained in:
		| @ -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); | ||||
| 				Tmp.Slot := Str.Buffer.Slot; | ||||
| 				Tmp.Last := Str.Buffer.Last; | ||||
| 				Tmp.Refs := 1;	--Ref_Buffer (Tmp); | ||||
| 				Deref_Buffer (Str.Buffer); | ||||
| 				Str.Buffer := Tmp; | ||||
| 				-- The code like this doesn't work correctly in terms of finalization. | ||||
| 				-- The buffer pointer held inside a finalization controlled record must be  | ||||
| 				-- manipluated through the record itself. otherwise, the Adjust and Finalize | ||||
| 				-- calls goes incompatible with the reference counting implementation. | ||||
| 				-- It is because finalization is set on the record rather than the buffer pointer. | ||||
| 				--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 | ||||
| 		Tmp: Buffer_Pointer; | ||||
| 	-- prepare the buffer for writing  | ||||
| 	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 | ||||
| 			if Is_Shared(Str) then | ||||
| 				-- ReqCapa must be greater than Str.Buffer.Slot'Length | ||||
| 				Tmp := new Buffer_Record(ReqCapa); | ||||
| 				Tmp.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last + 1) := Str.Buffer.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last + 1); | ||||
| 				Tmp.Last := Str.Buffer.Last; | ||||
| 				Tmp.Refs := 1; --Ref_Buffer (Tmp); | ||||
| 				Deref_Buffer (Str.Buffer); | ||||
| 				Str.Buffer := Tmp; | ||||
| 		First := Get_First_Index(Str); | ||||
| 		Last := Get_Last_Index(Str); | ||||
|  | ||||
| 		if Str.Buffer /= Empty_Buffer'Access and then Is_Shared(Str) then | ||||
| 			if Req_Hard_Capa < Get_Hard_Capacity(Str) then | ||||
| 				Hard_Capa := Get_Hard_Capacity(Str); | ||||
| 			else | ||||
| 				Hard_Capa := Req_Hard_Capa; | ||||
| 			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 | ||||
| 			ReqCapa := H3.Align(Str.Buffer.Last + 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; | ||||
|  | ||||
| 		if V'Length > 0 then	 | ||||
| 			Prepare_Buffer (Str, H3.Align(Get_Length(Str) + V'Length + 1, BUFFER_ALIGN)); | ||||
| 			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"); | ||||
| 		Deref_Buffer (Str.Buffer); | ||||
| 		Unref_Buffer (Str.Buffer); | ||||
| 	end Finalize; | ||||
| end H3.Strings; | ||||
|  | ||||
| @ -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(Size: System_Size) is limited record | ||||
| 		Refs: System_Size := 0; | ||||
| 		Slot: Character_Array(1 .. Size); | ||||
| 	type Buffer_Record(Capa: System_Size) is limited record | ||||
| 		Refs: System_Size := 1; | ||||
| 		Slot: Character_Array(1 .. Capa); | ||||
| 		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; | ||||
|  | ||||
| @ -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); | ||||
|  | ||||
| 		S.Append(Str, "donkey"); | ||||
| 		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, "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 | ||||
|  | ||||
		Reference in New Issue
	
	Block a user