|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 7168 (0x1c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body String_Table, seg_01b4cc
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with String_Utilities;
with Unchecked_Conversion;
package body String_Table is
function Item_To_Integer is new Unchecked_Conversion (Item, Integer);
package Util renames String_Utilities;
type Sym_Rec is
record
Value : Item;
Next : Sym_Pointer;
end record;
type Table_Storage is array (Element_Index range <>) of Sym_Pointer;
function Nil return Item is
begin
return null;
end Nil;
function Hash_Code (S : String; Hash_Size : Positive)
return Element_Index is
begin
return Element_Index (abs (Util.Hash_String (S) mod Hash_Size));
end Hash_Code;
pragma Inline (Hash_Code);
function New_Table (Minimum_Table_Size : Natural := 127) return Table is
begin
return new Table_Storage (0 .. Minimum_Table_Size);
end New_Table;
function Unique (Source : String;
In_Table : Table;
Ignore_Case : Boolean := True) return Item is
Bucket : Sym_Pointer renames In_Table
(Hash_Code (Source, In_Table'Length));
Chain : Sym_Pointer := Bucket;
begin
if Source'Length = 0 then
return null;
end if;
if Ignore_Case then
declare
S : constant String := Util.Upper_Case (Source);
begin
while Chain /= null loop
if Util.Upper_Case (Chain.Value.all) = S then
return Chain.Value;
end if;
Chain := Chain.Next;
end loop;
end;
else
while Chain /= null loop
if Chain.Value.all = Source then
return Chain.Value;
end if;
Chain := Chain.Next;
end loop;
end if;
Chain := new Sym_Rec;
Chain.Value := new String'(Source);
Chain.Next := Bucket;
Bucket := Chain;
return Chain.Value;
end Unique;
function Find (Source : String;
In_Table : Table;
Ignore_Case : Boolean := True) return Item is
Chain : Sym_Pointer := In_Table (Hash_Code (Source, In_Table'Length));
begin
if Source'Length = 0 then
return null;
end if;
if Ignore_Case then
declare
S : constant String := Util.Upper_Case (Source);
begin
while Chain /= null loop
if Util.Upper_Case (Chain.Value.all) = S then
return Chain.Value;
end if;
Chain := Chain.Next;
end loop;
end;
else
while Chain /= null loop
if Chain.Value.all = Source then
return Chain.Value;
end if;
Chain := Chain.Next;
end loop;
end if;
return null;
end Find;
function Allocate (Source : String; In_Table : Table) return Item is
begin
if Source'Length > 0 then
return new String'(Source);
else
return Nil;
end if;
end Allocate;
function Equal (L, R : Item) return Boolean is
begin
return L = R or else
((L /= Nil and then R /= Nil) and then L.all = R.all);
end Equal;
function Unique_Index (U : Item) return Integer is
begin
return Item_To_Integer (U);
end Unique_Index;
function Char_At (Source : Item; At_Pos : Natural) return Character is
begin
return Source (At_Pos - 1 + Source'First);
end Char_At;
function Image (Source : Item) return String is
begin
if Source = Nil then
return "";
else
return Source.all;
end if;
end Image;
function Length (Source : Item) return Natural is
begin
if Source = Nil then
return 0;
else
return Source.all'Length;
end if;
end Length;
function Is_Nil (Source : Item) return Boolean is
begin
return Source = Nil;
end Is_Nil;
procedure Incr (Iter : in out Iterator) is
begin
loop
Iter.Member := Long_Sym_Pointer (Iter.The_Table (Iter.Bucket));
exit when Iter.Member /= null or else
Iter.Bucket = Iter.The_Table'Last;
Iter.Bucket := Iter.Bucket + 1;
end loop;
end Incr;
procedure Init (Iter : out Iterator; The_Table : Table) is
The_Iter : Iterator;
begin
The_Iter.The_Table := The_Table;
The_Iter.Bucket := 0;
Incr (The_Iter);
Iter := The_Iter;
end Init;
procedure Next (Iter : in out Iterator) is
begin
Iter.Member := Long_Sym_Pointer (Iter.Member.Next);
if Iter.Member = null and then Iter.Bucket /= Iter.The_Table'Last then
Iter.Bucket := Iter.Bucket + 1;
Incr (Iter);
end if;
end Next;
function Value (Iter : Iterator) return Item is
begin
return Iter.Member.Value;
end Value;
function Done (Iter : Iterator) return Boolean is
begin
return Iter.Member = null;
end Done;
end String_Table;
nblk1=6
nid=0
hdr6=c
[0x00] rec0=26 rec1=00 rec2=01 rec3=040
[0x01] rec0=1d rec1=00 rec2=02 rec3=006
[0x02] rec0=1c rec1=00 rec2=03 rec3=058
[0x03] rec0=26 rec1=00 rec2=04 rec3=016
[0x04] rec0=24 rec1=00 rec2=05 rec3=01a
[0x05] rec0=18 rec1=00 rec2=06 rec3=000
tail 0x21718b944836386b2abe8 0x42a00088462060003