hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

reference counting experiment in h3

Browse Source
This commit is contained in:
hyung-hwan 2021-08-24 07:17:32 +00:00
parent e07312b402
commit 3cfbd32055
3 changed files with 149 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
lib2/h3-strings.adb
View File

@ -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;

31
lib2/h3-strings.ads
View File

@ -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;

59
lib2/hello.adb
View File

@ -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