diff --git a/lib2/h3-limited_pool.ads b/lib2/h3-limited_pool.ads index 7fea0e3..41b6f67 100644 --- a/lib2/h3-limited_pool.ads +++ b/lib2/h3-limited_pool.ads @@ -1,8 +1,9 @@ -------------------------------------------------------------------- -- Instantantiate this package before using. To allocate integers, -- +-- P1: aliased System.Pool_Global.Unbounded_No_Reclaim_Pool; -- type Integer_Pointer is access Integer_Pointer; --- package Integer_Pool is new Pool(Integer, Integer_Pointer, Storage_Pool'Unchecked_Access); +-- package Integer_Pool is new Pool(Integer, Integer_Pointer, P1'Unchecked_Access); -- x: Integer_Pointer; -- -- x := Integer_Pool.Allocate(10); diff --git a/lib2/h3-strings.adb b/lib2/h3-strings.adb index 28f802f..2ea3626 100644 --- a/lib2/h3-strings.adb +++ b/lib2/h3-strings.adb @@ -187,9 +187,32 @@ package body H3.Strings is procedure Delete (Str: in out Elastic_String; Pos: in System_Index; Length: in System_Size) is begin - null; + if Pos <= Str.Buffer.Last then + Prepare_Buffer (Str); + else + raise Standard.Constraint_Error; + end if; end Delete; + procedure Insert (Str: in out Elastic_String; Pos: in System_Index; Char: in Character_Type) is + begin + if Pos <= Str.Buffer.Last then + Prepare_Buffer (Str, H3.Align(Get_Length(Str) + V'Length + 1, BUFFER_ALIGN)); + Str.Buffer.Slot(Pos) := New_Char; + end if; + end Insert; + + procedure Replace (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type) is + begin + if Pos <= Str.Buffer.Last then + Prepare_Buffer (Str); + Str.Buffer.Slot(Pos) := New_Char; + else + -- raise Index_Error; + raise Standard.Constraint_Error; + end if; + end Replace; + -- --------------------------------------------------------------------- -- Controlled Management -- --------------------------------------------------------------------- diff --git a/lib2/h3-strings.ads b/lib2/h3-strings.ads index d441265..d023ad8 100644 --- a/lib2/h3-strings.ads +++ b/lib2/h3-strings.ads @@ -21,11 +21,11 @@ package H3.Strings is function Get_Length (Str: in Elastic_String) return System_Size; pragma Inline (Get_Length); - -- the return type is System_Size for consistency with Get_FIrst_Index. + -- the return type is System_Size for consistency with Get_Last_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. + -- the return type is System_Size because the Last index is -1 off the System_Index'First for an empty string function Get_Last_Index (Str: in Elastic_String) return System_Size; pragma Inline (Get_Last_index); @@ -45,6 +45,8 @@ package H3.Strings is procedure Append (Str: in out Elastic_String; V: in Character_Array); procedure Append (Str: in out Elastic_String; V: in Character_Type); + procedure Replace (Str: in out Elastic_String; Pos: in System_Index; New_Char: in Character_Type); + private type Buffer_Record(Capa: System_Size) is limited record Refs: System_Size := 1; diff --git a/lib2/h3.adb b/lib2/h3.adb index 93bdedb..a31d814 100644 --- a/lib2/h3.adb +++ b/lib2/h3.adb @@ -6,38 +6,4 @@ package body H3 is return ((X + Y - 1) / Y) * Y; end Align; - - --- procedure Set (R: in out Ref; Data: in Ref_Counted_Pointer) is --- begin --- if R.Data /= null then --- Finalize (R); --- end if; --- --- R.Data := Data; --- Adjust (R); --- end Set; - --- function Get (R: in Ref) return Ref_Counted_Pointer is --- begin --- return R.Data; --- end Get; - --- procedure Adjust (R: in out Ref) is --- begin --- if R.Data /= null then --- R.Data.Ref_Count := R.Data.Ref_Count + 1; --- end if; --- end Adjust; - --- procedure Finalize (R: in out Ref) is --- begin --- if R.Data /= null then --- R.Data.Ref_Count := R.Data.Ref_Count - 1; --- if R.Data.Ref_Count = 0 then --- null; --- end if; --- R.Data := null; --- end if; --- end Finalize; -end H3; \ No newline at end of file +end H3; diff --git a/lib2/h3.ads b/lib2/h3.ads index 938b1a9..1731721 100644 --- a/lib2/h3.ads +++ b/lib2/h3.ads @@ -12,6 +12,7 @@ package H3 is for System_Byte'Size use System_Byte_Bits; type System_Word is mod 2 ** System_Word_Bits; + --type System_Word is range 0 .. (2 ** System_Word_Bits) - 1; for System_Word'Size use System_Word_Bits; type System_Signed_Word is range -(2 ** (System_Word_Bits - 1)) .. @@ -22,7 +23,7 @@ package H3 is subtype System_Size is System_Word range 0 .. (2 ** System_Word_Bits) - 1; --subtype System_Index is System_Size range 0 .. (System_Size'Last - 1); - subtype System_Index is System_Size range 1 .. System_Size'Last; + subtype System_Index is System_Size range (System_Size'First + 1) .. System_Size'Last; type Storage_Pool_Pointer is access all System.Storage_Pools.Root_Storage_Pool'Class; @@ -34,4 +35,5 @@ package H3 is function Align (X: in System_Size; Y: in System_Size) return System_Size; pragma Inline(Align); + Index_Error: exception; end H3; diff --git a/lib2/hello.adb b/lib2/hello.adb index 1880d8f..f50cab6 100644 --- a/lib2/hello.adb +++ b/lib2/hello.adb @@ -11,6 +11,7 @@ with Ada.Text_IO; with Ada.Wide_Text_IO; with Ada.Assertions; +use type H3.System_Size; procedure hello is package S is new H3.Strings(Wide_Character, Wide_Character'Val(0)); @@ -47,7 +48,23 @@ procedure hello is y: L_Pointer; SS: S.Elastic_String; + begin + declare + TTT: H3.System_Size := H3.System_Size'Last; + --NNN: Standard.Natural := Standard.Natural'Last; + begin + TTT := TTT + 1; + ada.text_io.put_line ("-----------------"); + ada.text_io.put_line (TTT'Img); + ada.text_io.put_line ("-----------------"); + + --NNN := NNN + 1; + --ada.text_io.put_line ("-----------------"); + --ada.text_io.put_line (NNN'Img); + --ada.text_io.put_line ("-----------------"); + end; + x := TP.Allocate((A => 900, B => 800, C => 1.1)); i := IP.Allocate(200); @@ -128,6 +145,10 @@ begin Ada.Wide_Text_IO.Put (arr(i)); end loop; Ada.Wide_Text_IO.Put_Line ("]"); + + Ada.Wide_Text_IO.Put ("PRINTING AGAIN ["); + Ada.Wide_Text_IO.Put (Standard.Wide_String(arr)); + Ada.Wide_Text_IO.Put_Line ("]"); end; -- unsafe way to access the internal buffer. @@ -139,6 +160,8 @@ begin S.Append (Str2, "EXTRA"); S.Append (Str2, " THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR H3"); + S.Replace (Str2, 1, 'Q'); + --S.Replace (Str2, 10000, 'Q'); -- constraint error declare arr: constant S.Thin_Character_Array_Pointer := S.Get_Slot_Pointer(Str); @@ -154,8 +177,8 @@ begin 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 S.Get_First_Index(Str) .. S.Get_Last_Index(Str) + 1 loop + Ada.Wide_Text_IO.Put ("STR(By-Pointer) ["); + for i in S.Get_First_Index(Str) .. S.Get_Last_Index(Str) + 1 loop -- this must loop to the terminating null. Ada.Wide_Text_IO.Put (arr.all(i)); end loop; Ada.Wide_Text_IO.Put_Line ("]"); @@ -166,7 +189,7 @@ begin 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 ("["); + Ada.Wide_Text_IO.Put ("Str2(By-Pointer) ["); -- this must loop to the terminating null. 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;