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

renamed Str to Obj

Browse Source
This commit is contained in:
hyung-hwan 2021-10-06 08:05:21 +00:00
parent 962d9e8757
commit 5c3c78ccf6
6 changed files with 157 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

244
lib2/h3-arrays.adb
View File

@ -3,48 +3,48 @@ with Ada.Unchecked_Deallocation;
package body H3.Arrays is package body H3.Arrays is
BUFFER_ALIGN: constant := 128; -- TODO: change it to a reasonably large value. BUFFER_ALIGN: constant := 128; -- TODO: change it to a reasonably large value.
function To_Item_Array (Str: in Elastic_Array) return Item_Array is function To_Item_Array (Obj: in Elastic_Array) return Item_Array is
begin begin
return Str.Buffer.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last); return Obj.Buffer.Slot(Obj.Buffer.Slot'First .. Obj.Buffer.Last);
end To_Item_Array; end To_Item_Array;
-- return the buffer capacity excluding the terminator -- return the buffer capacity excluding the terminator
function Get_Capacity (Str: in Elastic_Array) return System_Size is function Get_Capacity (Obj: in Elastic_Array) return System_Size is
begin begin
return Str.Buffer.Slot'Length - Terminator_Length; return Obj.Buffer.Slot'Length - Terminator_Length;
end Get_Capacity; end Get_Capacity;
-- private. return the buffer capacity including the terminator -- private. return the buffer capacity including the terminator
function Get_Hard_Capacity (Str: in Elastic_Array) return System_Size is function Get_Hard_Capacity (Obj: in Elastic_Array) return System_Size is
begin begin
return Str.Buffer.Slot'Length; return Obj.Buffer.Slot'Length;
end Get_Hard_Capacity; end Get_Hard_Capacity;
pragma Inline (Get_Hard_Capacity); pragma Inline (Get_Hard_Capacity);
function Get_Length (Str: in Elastic_Array) return System_Size is function Get_Length (Obj: in Elastic_Array) return System_Size is
begin begin
return 1 + Str.Buffer.Last - Str.Buffer.Slot'First; return 1 + Obj.Buffer.Last - Obj.Buffer.Slot'First;
end Get_Length; end Get_Length;
function Get_First_Index (Str: in Elastic_Array) return System_Size is function Get_First_Index (Obj: in Elastic_Array) return System_Size is
begin begin
return Str.Buffer.Slot'First; return Obj.Buffer.Slot'First;
end Get_First_Index; end Get_First_Index;
function Get_Last_Index (Str: in Elastic_Array) return System_Size is function Get_Last_Index (Obj: in Elastic_Array) return System_Size is
begin begin
return Str.Buffer.Last; return Obj.Buffer.Last;
end Get_Last_Index; end Get_Last_Index;
function Get_Item (Str: in Elastic_Array; Pos: in System_Index) return Item_Type is function Get_Item (Obj: in Elastic_Array; Pos: in System_Index) return Item_Type is
begin begin
return Str.Buffer.Slot(Pos); return Obj.Buffer.Slot(Pos);
end Get_Item; end Get_Item;
-- unsafe as it exposes the internal buffer which can go away. -- unsafe as it exposes the internal buffer which can go away.
-- assume the system address is equal to the thin pointer in size. -- assume the system address is equal to the thin pointer in size.
function Get_Slot_Pointer (Str: in Elastic_Array) return Thin_Item_Array_Pointer is function Get_Slot_Pointer (Obj: in Elastic_Array) return Thin_Item_Array_Pointer is
A: System.Address := Str.Buffer.Slot(Str.Buffer.Slot'First)'Address; A: System.Address := Obj.Buffer.Slot(Obj.Buffer.Slot'First)'Address;
P: Thin_Item_Array_Pointer; P: Thin_Item_Array_Pointer;
for P'Address use A'Address; for P'Address use A'Address;
pragma Import (Ada, P); pragma Import (Ada, P);
@ -52,22 +52,11 @@ package body H3.Arrays is
return P; return P;
end Get_Slot_Pointer; end Get_Slot_Pointer;
function Is_Shared(Str: in Elastic_Array) return Standard.Boolean is function Is_Shared(Obj: in Elastic_Array) return Standard.Boolean is
begin begin
return Str.Buffer /= Empty_Buffer'Access and then Str.Buffer.Refs > 1; return Obj.Buffer /= Empty_Buffer'Access and then Obj.Buffer.Refs > 1;
end Is_Shared; end Is_Shared;
procedure Free_Buffer (Str: in out Elastic_Array) is
begin
if Str.Buffer /= Empty_Buffer'Access then
declare
procedure Free is new Ada.Unchecked_Deallocation(Buffer_Record, Buffer_Pointer);
begin
Free (Str.Buffer);
end;
end if;
end Free_Buffer;
procedure Ref_Buffer (Buf: in out Buffer_Pointer) is procedure Ref_Buffer (Buf: in out Buffer_Pointer) is
begin begin
if Buf /= Empty_Buffer'Access then if Buf /= Empty_Buffer'Access then
@ -100,57 +89,57 @@ package body H3.Arrays is
end New_Buffer_Container; end New_Buffer_Container;
-- prepare the buffer for writing -- prepare the buffer for writing
procedure Prepare_Buffer (Str: in out Elastic_Array) is procedure Prepare_Buffer (Obj: in out Elastic_Array) is
Tmp: Elastic_Array; Tmp: Elastic_Array;
begin begin
if Str.Buffer /= Empty_Buffer'Access then if Obj.Buffer /= Empty_Buffer'Access then
if Is_Shared(Str) then if Is_Shared(Obj) then
-- The code like this doesn't work correctly in terms of finalization. -- The code like this doesn't work correctly in terms of finalization.
-- The buffer pointer held inside a finalization controlled record must be -- The buffer pointer held inside a finalization controlled record must be
-- manipluated through the record itself. otherwise, the Adjust and Finalize -- manipluated through the record itself. otherwise, the Adjust and Finalize
-- calls goes incompatible with the reference counting implementation. -- calls goes incompatible with the reference counting implementation.
-- It is because finalization is set on the record rather than the buffer pointer. -- It is because finalization is set on the record rather than the buffer pointer.
--Tmp: Buffer_Pointer; --Tmp: Buffer_Pointer;
--Tmp := new Buffer_Record(Get_Hard_Capacity(Str)); --Tmp := new Buffer_Record(Get_Hard_Capacity(Obj));
--Tmp.Slot := Str.Buffer.Slot; --Tmp.Slot := Obj.Buffer.Slot;
--Tmp.Last := Str.Buffer.Last; --Tmp.Last := Obj.Buffer.Last;
--Tmp.Refs := 1; --Tmp.Refs := 1;
--Unref_Buffer (Str.Buffer); --Unref_Buffer (Obj.Buffer);
--Str.Buffer := Tmp; --Obj.Buffer := Tmp;
Tmp := Str; Tmp := Obj;
Str := New_Buffer_Container(Get_Hard_Capacity(Str)); Obj := New_Buffer_Container(Get_Hard_Capacity(Obj));
Str.Buffer.Slot := Tmp.Buffer.Slot; Obj.Buffer.Slot := Tmp.Buffer.Slot;
Str.Buffer.Last := Tmp.Buffer.Last; Obj.Buffer.Last := Tmp.Buffer.Last;
end if; end if;
end if; end if;
end Prepare_Buffer; end Prepare_Buffer;
-- prepare the buffer for writing -- prepare the buffer for writing
procedure Prepare_Buffer (Str: in out Elastic_Array; Req_Hard_Capa: in System_Size; Shift_Pos: in System_Size := 0; Shift_Size: in System_Size := 0; Shift_Dir: in Direction := DIRECTION_FORWARD) is procedure Prepare_Buffer (Obj: in out Elastic_Array; Req_Hard_Capa: in System_Size; Shift_Pos: in System_Size := 0; Shift_Size: in System_Size := 0; Shift_Dir: in Direction := DIRECTION_FORWARD) is
Tmp: Elastic_Array; Tmp: Elastic_Array;
First, Last: System_Size; First, Last: System_Size;
Hard_Capa: System_Size; Hard_Capa: System_Size;
begin begin
First := Get_First_Index(Str); First := Get_First_Index(Obj);
Last := Get_Last_Index(Str); Last := Get_Last_Index(Obj);
if Str.Buffer /= Empty_Buffer'Access and then Is_Shared(Str) then if Obj.Buffer /= Empty_Buffer'Access and then Is_Shared(Obj) then
if Req_Hard_Capa < Get_Hard_Capacity(Str) then if Req_Hard_Capa < Get_Hard_Capacity(Obj) then
Hard_Capa := Get_Hard_Capacity(Str); Hard_Capa := Get_Hard_Capacity(Obj);
else else
Hard_Capa := Req_Hard_Capa; Hard_Capa := Req_Hard_Capa;
end if; end if;
Tmp := Str; Tmp := Obj;
Str := New_Buffer_Container(Hard_Capa); Obj := New_Buffer_Container(Hard_Capa);
goto COPY_OVER; goto COPY_OVER;
else else
if Req_Hard_Capa > Get_Hard_Capacity(Str) then if Req_Hard_Capa > Get_Hard_Capacity(Obj) then
Tmp := Str; Tmp := Obj;
Str := New_Buffer_Container(Req_Hard_Capa); Obj := New_Buffer_Container(Req_Hard_Capa);
goto COPY_OVER; goto COPY_OVER;
elsif Shift_Pos > 0 then elsif Shift_Pos > 0 then
Tmp := Str; Tmp := Obj;
goto COPY_OVER_WITH_SHIFT; goto COPY_OVER_WITH_SHIFT;
else else
-- no shift, no change in the buffer -- no shift, no change in the buffer
@ -163,8 +152,8 @@ package body H3.Arrays is
<<COPY_OVER>> <<COPY_OVER>>
if Shift_Pos <= 0 then if Shift_Pos <= 0 then
-- no shift is required. copy the entire Array including th -- no shift is required. copy the entire Array including th
Str.Buffer.Slot(First .. Last + Terminator_Length) := Tmp.Buffer.Slot(First .. Last + Terminator_Length); Obj.Buffer.Slot(First .. Last + Terminator_Length) := Tmp.Buffer.Slot(First .. Last + Terminator_Length);
Str.Buffer.Last := Last; Obj.Buffer.Last := Last;
return; return;
end if; end if;
<<COPY_OVER_WITH_SHIFT>> <<COPY_OVER_WITH_SHIFT>>
@ -175,152 +164,155 @@ package body H3.Arrays is
declare declare
Mid: System_Size := Shift_Pos - Shift_Size; Mid: System_Size := Shift_Pos - Shift_Size;
begin begin
Str.Buffer.Slot(First .. Mid) := Tmp.Buffer.Slot(First .. Mid); Obj.Buffer.Slot(First .. Mid) := Tmp.Buffer.Slot(First .. Mid);
Str.Buffer.Slot(Mid + 1 .. Last - Shift_Size + Terminator_Length) := Tmp.Buffer.Slot(Shift_Pos + 1 .. Last + Terminator_Length); Obj.Buffer.Slot(Mid + 1 .. Last - Shift_Size + Terminator_Length) := Tmp.Buffer.Slot(Shift_Pos + 1 .. Last + Terminator_Length);
Str.Buffer.Last := Last - Shift_Size; Obj.Buffer.Last := Last - Shift_Size;
end; end;
else else
Str.Buffer.Slot(First .. Shift_Pos - 1) := Tmp.Buffer.Slot(First .. Shift_Pos - 1); Obj.Buffer.Slot(First .. Shift_Pos - 1) := Tmp.Buffer.Slot(First .. Shift_Pos - 1);
Str.Buffer.Slot(Shift_Pos + Shift_Size .. Last + Shift_Size + Terminator_Length) := Tmp.Buffer.Slot(Shift_Pos .. Last + Terminator_Length); Obj.Buffer.Slot(Shift_Pos + Shift_Size .. Last + Shift_Size + Terminator_Length) := Tmp.Buffer.Slot(Shift_Pos .. Last + Terminator_Length);
Str.Buffer.Last := Last + Shift_Size; Obj.Buffer.Last := Last + Shift_Size;
end if; end if;
end Prepare_Buffer; end Prepare_Buffer;
procedure Clear (Str: in out Elastic_Array) is procedure Clear (Obj: in out Elastic_Array) is
begin begin
Prepare_Buffer (Elastic_Array(Str)); Prepare_Buffer (Elastic_Array(Obj));
Str.Buffer.Last := Get_First_Index(Str) - 1; Obj.Buffer.Last := Get_First_Index(Obj) - 1;
Str.Buffer.Slot(Get_First_Index(Str) .. Get_First_Index(Str) + Terminator_Length - 1) := (others => Terminator_Value); Obj.Buffer.Slot(Get_First_Index(Obj) .. Get_First_Index(Obj) + Terminator_Length - 1) := (others => Terminator_Value);
end Clear; end Clear;
procedure Purge (Str: in out Elastic_Array) is procedure Purge (Obj: in out Elastic_Array) is
begin begin
Unref_Buffer (Str.Buffer); Unref_Buffer (Obj.Buffer);
Str.Buffer := Empty_Buffer'Access; Obj.Buffer := Empty_Buffer'Access;
end Purge; end Purge;
function Calc_Inc_Capa (Str: in Elastic_Array; Inc: in System_Size) return System_Size is function Calc_Inc_Capa (Obj: in Elastic_Array; Inc: in System_Size) return System_Size is
begin begin
return H3.Align(Get_Length(Str) + Inc + Terminator_Length, BUFFER_ALIGN); return H3.Align(Get_Length(Obj) + Inc + Terminator_Length, BUFFER_ALIGN);
end Calc_Inc_Capa; end Calc_Inc_Capa;
procedure Insert (Str: in out Elastic_Array; Pos: in System_Index; V: in Item_Type; Repeat: in System_Size := 1) is procedure Insert (Obj: in out Elastic_Array; Pos: in System_Index; V: in Item_Type; Repeat: in System_Size := 1) is
Act_Pos: System_Index := Pos; Act_Pos: System_Index := Pos;
Act_Inc: System_Size := Repeat; Act_Inc: System_Size := Repeat;
begin begin
if Act_Pos > Str.Buffer.Last then if Act_Pos > Obj.Buffer.Last then
Act_Pos := Str.Buffer.Last + 1; Act_Pos := Obj.Buffer.Last + 1;
end if; end if;
Prepare_Buffer (Elastic_Array(Str), Calc_Inc_Capa(Str, Act_Inc), Act_Pos, Act_Inc); Prepare_Buffer (Elastic_Array(Obj), Calc_Inc_Capa(Obj, Act_Inc), Act_Pos, Act_Inc);
Str.Buffer.Slot(Act_Pos .. Act_Pos + Act_Inc - 1) := (others => V); Obj.Buffer.Slot(Act_Pos .. Act_Pos + Act_Inc - 1) := (others => V);
end Insert; end Insert;
procedure Insert (Str: in out Elastic_Array; Pos: in System_Index; V: in Item_Array) is procedure Insert (Obj: in out Elastic_Array; Pos: in System_Index; V: in Item_Array) is
Act_Pos: System_Index := Pos; Act_Pos: System_Index := Pos;
begin begin
if Act_Pos > Str.Buffer.Last then if Act_Pos > Obj.Buffer.Last then
Act_Pos := Str.Buffer.Last + 1; Act_Pos := Obj.Buffer.Last + 1;
end if; end if;
Prepare_Buffer (Elastic_Array(Str), Calc_Inc_Capa(Str, V'Length), Act_Pos, V'Length); Prepare_Buffer (Elastic_Array(Obj), Calc_Inc_Capa(Obj, V'Length), Act_Pos, V'Length);
Str.Buffer.Slot(Act_Pos .. Act_Pos + V'Length - 1) := V; Obj.Buffer.Slot(Act_Pos .. Act_Pos + V'Length - 1) := V;
end Insert; end Insert;
-- TODO: operator "&" that returns a new Elastic_Array -- TODO: operator "&" that returns a new Elastic_Array
procedure Append (Str: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1) is procedure Append (Obj: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1) is
begin begin
Insert (Str, Get_Last_Index(Str) + 1, V, Repeat); Insert (Obj, Get_Last_Index(Obj) + 1, V, Repeat);
end Append; end Append;
procedure Append (Str: in out Elastic_Array; V: in Item_Array) is procedure Append (Obj: in out Elastic_Array; V: in Item_Array) is
begin begin
Insert (Str, Get_Last_Index(Str) + 1, V); Insert (Obj, Get_Last_Index(Obj) + 1, V);
end Append; end Append;
procedure Prepend (Str: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1) is procedure Prepend (Obj: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1) is
begin begin
Insert (Str, Get_First_Index(Str), V, Repeat); Insert (Obj, Get_First_Index(Obj), V, Repeat);
end Prepend; end Prepend;
procedure Prepend (Str: in out Elastic_Array; V: in Item_Array) is procedure Prepend (Obj: in out Elastic_Array; V: in Item_Array) is
begin begin
Insert (Str, Get_First_Index(Str), V); Insert (Obj, Get_First_Index(Obj), V);
end Prepend; end Prepend;
procedure Replace (Str: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Type; Repeat: in System_Size := 1) is procedure Replace (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Type; Repeat: in System_Size := 1) is
Act_To_Pos, Repl_Len: System_Size; Act_To_Pos, Repl_Len: System_Size;
begin begin
if From_Pos <= To_Pos and then From_Pos <= Str.Buffer.Last then if From_Pos <= To_Pos and then From_Pos <= Obj.Buffer.Last then
Act_To_Pos := To_Pos; Act_To_Pos := To_Pos;
if Act_To_Pos > Str.Buffer.Last then if Act_To_Pos > Obj.Buffer.Last then
Act_To_Pos := Str.Buffer.Last; Act_To_Pos := Obj.Buffer.Last;
end if; end if;
Repl_Len := Act_To_Pos - From_Pos + 1; Repl_Len := Act_To_Pos - From_Pos + 1;
if Repeat < Repl_Len then if Repeat < Repl_Len then
Prepare_Buffer (Elastic_Array(Str), Get_Hard_Capacity(Str), Act_To_Pos, Repl_Len - Repeat, DIRECTION_BACKWARD); Prepare_Buffer (Elastic_Array(Obj), Get_Hard_Capacity(Obj), Act_To_Pos, Repl_Len - Repeat, DIRECTION_BACKWARD);
Act_To_Pos := From_Pos + Repeat - 1; Act_To_Pos := From_Pos + Repeat - 1;
elsif Repeat > Repl_Len then elsif Repeat > Repl_Len then
Prepare_Buffer (Elastic_Array(Str), Calc_Inc_Capa(Str, Repeat - Repl_Len), From_Pos, Repeat - Repl_Len, DIRECTION_FORWARD); Prepare_Buffer (Elastic_Array(Obj), Calc_Inc_Capa(Obj, Repeat - Repl_Len), From_Pos, Repeat - Repl_Len, DIRECTION_FORWARD);
Act_To_Pos := From_Pos + Repeat - 1; Act_To_Pos := From_Pos + Repeat - 1;
else else
Prepare_Buffer (Elastic_Array(Str)); Prepare_Buffer (Elastic_Array(Obj));
end if; end if;
Str.Buffer.Slot(From_Pos .. Act_To_Pos) := (others => V); Obj.Buffer.Slot(From_Pos .. Act_To_Pos) := (others => V);
end if; end if;
end Replace; end Replace;
procedure Replace (Str: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Array) is procedure Replace (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Array) is
Act_To_Pos, Repl_Len: System_Size; Act_To_Pos, Repl_Len: System_Size;
begin begin
if From_Pos <= To_Pos and then From_Pos <= Str.Buffer.Last then if From_Pos <= To_Pos and then From_Pos <= Obj.Buffer.Last then
Act_To_Pos := To_Pos; Act_To_Pos := To_Pos;
if Act_To_Pos > Str.Buffer.Last then if Act_To_Pos > Obj.Buffer.Last then
Act_To_Pos := Str.Buffer.Last; Act_To_Pos := Obj.Buffer.Last;
end if; end if;
Repl_Len := Act_To_Pos - From_Pos + 1; Repl_Len := Act_To_Pos - From_Pos + 1;
if V'Length < Repl_Len then if V'Length < Repl_Len then
Prepare_Buffer (Elastic_Array(Str), Get_Hard_Capacity(Str), Act_To_Pos, Repl_Len - V'Length, DIRECTION_BACKWARD); Prepare_Buffer (Elastic_Array(Obj), Get_Hard_Capacity(Obj), Act_To_Pos, Repl_Len - V'Length, DIRECTION_BACKWARD);
Act_To_Pos := From_Pos + V'Length - 1; Act_To_Pos := From_Pos + V'Length - 1;
elsif V'Length > Repl_Len then elsif V'Length > Repl_Len then
Prepare_Buffer (Elastic_Array(Str), Calc_Inc_Capa(Str, V'Length - Repl_Len), From_Pos, V'Length - Repl_Len, DIRECTION_FORWARD); Prepare_Buffer (Elastic_Array(Obj), Calc_Inc_Capa(Obj, V'Length - Repl_Len), From_Pos, V'Length - Repl_Len, DIRECTION_FORWARD);
Act_To_Pos := From_Pos + V'Length - 1; Act_To_Pos := From_Pos + V'Length - 1;
else else
Prepare_Buffer (Elastic_Array(Str)); Prepare_Buffer (Elastic_Array(Obj));
end if; end if;
Str.Buffer.Slot(From_Pos .. Act_To_Pos) := V; Obj.Buffer.Slot(From_Pos .. Act_To_Pos) := V;
end if; end if;
end Replace; end Replace;
procedure Delete (Str: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size) is procedure Delete (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size) is
Act_To_Pos: System_Size; Act_To_Pos: System_Size;
begin begin
if From_Pos <= To_Pos and then From_Pos <= Str.Buffer.Last then if From_Pos <= To_Pos and then From_Pos <= Obj.Buffer.Last then
Act_To_Pos := To_Pos; Act_To_Pos := To_Pos;
if Act_To_Pos > Str.Buffer.Last then if Act_To_Pos > Obj.Buffer.Last then
Act_To_Pos := Str.Buffer.Last; Act_To_Pos := Obj.Buffer.Last;
end if; end if;
Prepare_Buffer (Elastic_Array(Str), Get_Hard_Capacity(Str), Act_To_Pos, Act_To_Pos - From_Pos + 1, DIRECTION_BACKWARD); Prepare_Buffer (Elastic_Array(Obj), Get_Hard_Capacity(Obj), Act_To_Pos, Act_To_Pos - From_Pos + 1, DIRECTION_BACKWARD);
end if; end if;
end Delete; end Delete;
function Find (Str: in Elastic_Array; V: In Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size is function Find (Obj: in Elastic_Array; V: In Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size is
Act_Start_Pos: System_Index := Start_Pos; Act_Start_Pos: System_Index := Start_Pos;
begin begin
if Find_Dir = DIRECTION_FORWARD then if Find_Dir = DIRECTION_FORWARD then
for i in Act_Start_Pos .. Get_Last_Index(Str) loop if Act_Start_Pos < Get_First_Index(Obj) then
if Get_Item(Str, i) = V then Act_Start_Pos := Get_First_Index(Obj);
end if;
for i in Act_Start_Pos .. Get_Last_Index(Obj) loop
if Get_Item(Obj, i) = V then
return i; return i;
end if; end if;
end loop; end loop;
else else
if Act_Start_Pos > Get_Last_Index(Str) then if Act_Start_Pos > Get_Last_Index(Obj) then
Act_Start_Pos := Get_Last_Index(Str); Act_Start_Pos := Get_Last_Index(Obj);
end if; end if;
for i in reverse Get_First_Index(Str) .. Act_Start_Pos loop for i in reverse Get_First_Index(Obj) .. Act_Start_Pos loop
if Get_Item(Str, i) = V then if Get_Item(Obj, i) = V then
return i; return i;
end if; end if;
end loop; end loop;
@ -328,37 +320,37 @@ package body H3.Arrays is
return System_Size'First; return System_Size'First;
end Find; end Find;
--function Find (Str: in Elastic_Array; V: In Item_Array; From_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD); --function Find (Obj: in Elastic_Array; V: In Item_Array; From_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD);
function "=" (Str: in Elastic_Array; Str2: in Elastic_Array) return Standard.Boolean is function "=" (Obj: in Elastic_Array; Obj2: in Elastic_Array) return Standard.Boolean is
begin begin
return Str.Buffer = Str2.Buffer or else Str.Buffer.Slot(Get_First_Index(Str) .. Get_Last_Index(Str)) = Str2.Buffer.Slot(Get_First_Index(Str2) .. Get_Last_Index(Str2)); return Obj.Buffer = Obj2.Buffer or else Obj.Buffer.Slot(Get_First_Index(Obj) .. Get_Last_Index(Obj)) = Obj2.Buffer.Slot(Get_First_Index(Obj2) .. Get_Last_Index(Obj2));
end "="; end "=";
function "=" (Str: in Elastic_Array; Str2: in Item_Array) return Standard.Boolean is function "=" (Obj: in Elastic_Array; Obj2: in Item_Array) return Standard.Boolean is
begin begin
return Str.Buffer.Slot(Get_First_Index(Str) .. Get_Last_Index(Str)) = Str2; return Obj.Buffer.Slot(Get_First_Index(Obj) .. Get_Last_Index(Obj)) = Obj2;
end "="; end "=";
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Controlled Management -- Controlled Management
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
procedure Initialize (Str: in out Elastic_Array) is procedure Initialize (Obj: in out Elastic_Array) is
begin begin
-- the Array is initialized to the empty buffer all the time. -- the Array is initialized to the empty buffer all the time.
-- there is no need to reference the buffer. -- there is no need to reference the buffer.
null; null;
end Initialize; end Initialize;
procedure Adjust (Str: in out Elastic_Array) is procedure Adjust (Obj: in out Elastic_Array) is
begin begin
Ref_Buffer (Str.Buffer); Ref_Buffer (Obj.Buffer);
end Adjust; end Adjust;
procedure Finalize (Str: in out Elastic_Array) is procedure Finalize (Obj: in out Elastic_Array) is
begin begin
Unref_Buffer (Str.Buffer); Unref_Buffer (Obj.Buffer);
end Finalize; end Finalize;
end H3.Arrays; end H3.Arrays;

52
lib2/h3-arrays.ads
View File

@ -19,55 +19,55 @@ package H3.Arrays is
subtype Thin_Item_Array is Item_Array(System_Index'Range); subtype Thin_Item_Array is Item_Array(System_Index'Range);
type Thin_Item_Array_Pointer is access Thin_Item_Array; type Thin_Item_Array_Pointer is access Thin_Item_Array;
function To_Item_Array (Str: in Elastic_Array) return Item_Array; function To_Item_Array (Obj: in Elastic_Array) return Item_Array;
function Get_Capacity (Str: in Elastic_Array) return System_Size; function Get_Capacity (Obj: in Elastic_Array) return System_Size;
pragma Inline (Get_Capacity); pragma Inline (Get_Capacity);
function Get_Length (Str: in Elastic_Array) return System_Size; function Get_Length (Obj: in Elastic_Array) return System_Size;
pragma Inline (Get_Length); pragma Inline (Get_Length);
-- the return type is System_Size for consistency with Get_Last_Index. -- the return type is System_Size for consistency with Get_Last_Index.
function Get_First_Index (Str: in Elastic_Array) return System_Size; function Get_First_Index (Obj: in Elastic_Array) return System_Size;
pragma Inline (Get_First_Index); pragma Inline (Get_First_Index);
-- the return type is System_Size because the Last index is -1 off the System_Index'First for an empty array -- the return type is System_Size because the Last index is -1 off the System_Index'First for an empty array
function Get_Last_Index (Str: in Elastic_Array) return System_Size; function Get_Last_Index (Obj: in Elastic_Array) return System_Size;
pragma Inline (Get_Last_index); pragma Inline (Get_Last_index);
function Get_Item (Str: in Elastic_Array; Pos: in System_Index) return Item_Type; function Get_Item (Obj: in Elastic_Array; Pos: in System_Index) return Item_Type;
pragma Inline (Get_Item); pragma Inline (Get_Item);
-- unsafe -- unsafe
function Get_Slot_Pointer (Str: in Elastic_Array) return Thin_Item_Array_Pointer; function Get_Slot_Pointer (Obj: in Elastic_Array) return Thin_Item_Array_Pointer;
pragma Inline (Get_Slot_Pointer); pragma Inline (Get_Slot_Pointer);
function Is_Shared(Str: in Elastic_Array) return Standard.Boolean; function Is_Shared(Obj: in Elastic_Array) return Standard.Boolean;
pragma Inline (Is_Shared); pragma Inline (Is_Shared);
procedure Clear (Str: in out Elastic_Array); procedure Clear (Obj: in out Elastic_Array);
procedure Purge (Str: in out Elastic_Array); -- clear and reset the buffer to Empty_Buffer. procedure Purge (Obj: in out Elastic_Array); -- clear and reset the buffer to Empty_Buffer.
procedure Insert (Str: in out Elastic_Array; Pos: in System_Index; V: in Item_Type; Repeat: in System_Size := 1); procedure Insert (Obj: in out Elastic_Array; Pos: in System_Index; V: in Item_Type; Repeat: in System_Size := 1);
procedure Insert (Str: in out Elastic_Array; Pos: in System_Index; V: in Item_Array); procedure Insert (Obj: in out Elastic_Array; Pos: in System_Index; V: in Item_Array);
procedure Append (Str: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1); procedure Append (Obj: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1);
procedure Append (Str: in out Elastic_Array; V: in Item_Array); procedure Append (Obj: in out Elastic_Array; V: in Item_Array);
procedure Prepend (Str: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1); procedure Prepend (Obj: in out Elastic_Array; V: in Item_Type; Repeat: in System_Size := 1);
procedure Prepend (Str: in out Elastic_Array; V: in Item_Array); procedure Prepend (Obj: in out Elastic_Array; V: in Item_Array);
procedure Replace (Str: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Type; Repeat: in System_Size := 1); procedure Replace (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Type; Repeat: in System_Size := 1);
procedure Replace (Str: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Array); procedure Replace (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Array);
procedure Delete (Str: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size); procedure Delete (Obj: in out Elastic_Array; From_Pos: in System_Index; To_Pos: in System_Size);
function Find (Str: in Elastic_Array; V: In Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size; function Find (Obj: in Elastic_Array; V: In Item_Type; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD) return System_Size;
--function Find (Str: in Elastic_Array; V: In Item_Array; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD); --function Find (Obj: in Elastic_Array; V: In Item_Array; Start_Pos: in System_Index; Find_Dir: in Direction := DIRECTION_FORWARD);
function "=" (Str: in Elastic_Array; Str2: in Elastic_Array) return Standard.Boolean; function "=" (Obj: in Elastic_Array; Obj2: in Elastic_Array) return Standard.Boolean;
function "=" (Str: in Elastic_Array; Str2: in Item_Array) return Standard.Boolean; function "=" (Obj: in Elastic_Array; Obj2: in Item_Array) return Standard.Boolean;
private private
type Buffer_Record(Capa: System_Size) is limited record type Buffer_Record(Capa: System_Size) is limited record
@ -86,8 +86,8 @@ private
Buffer: Buffer_Pointer := Empty_Buffer'Access; Buffer: Buffer_Pointer := Empty_Buffer'Access;
end record; end record;
overriding procedure Initialize (Str: in out Elastic_Array); overriding procedure Initialize (Obj: in out Elastic_Array);
overriding procedure Adjust (Str: in out Elastic_Array); overriding procedure Adjust (Obj: in out Elastic_Array);
overriding procedure Finalize (Str: in out Elastic_Array); overriding procedure Finalize (Obj: in out Elastic_Array);
end H3.Arrays; end H3.Arrays;

14
lib2/h3-mm.adb
View File

@ -5,7 +5,7 @@ package body H3.MM is
begin begin
Finalize (R); Finalize (R);
R.Data := new Ref_Counted_Record; R.Data := new Ref_Counted_Record;
R.Data.Ref_Count := 1; R.Data.Refs := 1;
--System.Atomic_Counters.Initialize (R.Data.Ref_Count); -- initialize to 1 --System.Atomic_Counters.Initialize (R.Data.Ref_Count); -- initialize to 1
end Create; end Create;
@ -26,8 +26,8 @@ package body H3.MM is
function Is_Shared (R: in Ref_Counted) return Standard.Boolean is function Is_Shared (R: in Ref_Counted) return Standard.Boolean is
begin begin
--return R.Data /= null and then not System.Atomic_Counters.Is_One(R.Data.Ref_Count); --return R.Data /= null and then not System.Atomic_Counters.Is_One(R.Data.Refs);
return R.Data /= null and then R.Data.Ref_Count > 1; return R.Data /= null and then R.Data.Refs > 1;
end Is_Shared; end Is_Shared;
procedure Initialize (R: in out Ref_Counted) is procedure Initialize (R: in out Ref_Counted) is
@ -38,8 +38,8 @@ package body H3.MM is
procedure Adjust (R: in out Ref_Counted) is procedure Adjust (R: in out Ref_Counted) is
begin begin
if R.Data /= null then if R.Data /= null then
R.Data.Ref_Count := R.Data.Ref_Count + 1; R.Data.Refs := R.Data.Refs + 1;
--System.Atomic_Counters.Increment (R.Data.Ref_Count); --System.Atomic_Counters.Increment (R.Data.Refs);
end if; end if;
end Adjust; end Adjust;
@ -52,10 +52,10 @@ package body H3.MM is
-- Dealloc (R.Data); -- Dealloc (R.Data);
-- -- R.DAta must be null here -- -- R.DAta must be null here
--end if; --end if;
if R.Data.Ref_Count = 1 then if R.Data.Refs = 1 then
Dealloc (R.Data); Dealloc (R.Data);
else else
R.Data.Ref_Count := R.Data.Ref_Count - 1; R.Data.Refs := R.Data.Refs - 1;
end if; end if;
end if; end if;
end Finalize; end Finalize;

6
lib2/h3-mm.ads
View File

@ -7,8 +7,8 @@ package H3.MM is
type Item_Pointer is access all Item_Type; type Item_Pointer is access all Item_Type;
type Ref_Counted_Record is record type Ref_Counted_Record is record
--Ref_Count: System.Atomic_Counters.Atomic_Counter; --Refs: System.Atomic_Counters.Atomic_Counter;
Ref_Count: System_Size; Refs: System_Size;
Item: aliased Item_Type; Item: aliased Item_Type;
end record; end record;
@ -27,10 +27,8 @@ package H3.MM is
function Is_Shared (R: in Ref_Counted) return Standard.Boolean; function Is_Shared (R: in Ref_Counted) return Standard.Boolean;
pragma Inline(Is_Shared); pragma Inline(Is_Shared);
overriding procedure Initialize (R: in out Ref_Counted); overriding procedure Initialize (R: in out Ref_Counted);
overriding procedure Adjust (R: in out Ref_Counted); overriding procedure Adjust (R: in out Ref_Counted);
overriding procedure Finalize (R: in out Ref_Counted); overriding procedure Finalize (R: in out Ref_Counted);
end H3.MM; end H3.MM;

4
lib2/h3-strings.adb
View File

@ -1,8 +1,8 @@
package body H3.Strings is package body H3.Strings is
procedure Append (Str: in out Elastic_String; V: in Character_Array) is procedure Append (Obj: in out Elastic_String; V: in Character_Array) is
begin begin
P.Append (P.Elastic_Array(Str), V); P.Append (P.Elastic_Array(Obj), V);
end; end;
end H3.Strings; end H3.Strings;

2
lib2/h3-strings.ads
View File

@ -18,6 +18,6 @@ package H3.Strings is
null; null;
end record; end record;
overriding procedure Append (Str: in out Elastic_String; V: in Character_Array); overriding procedure Append (Obj: in out Elastic_String; V: in Character_Array);
end H3.Strings; end H3.Strings;