|
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 - download
Length: 8192 (0x2000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Constant_String, package body Operators, seg_011b50
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
package body Constant_String is
Number_Of_Conflict : Natural := 0;
Max_Size : constant Integer := 517;
type Table_Of_Strings is array (Integer range 1 .. Max_Size) of Object;
Table : Table_Of_Strings;
------------------------------------------------------------
procedure Initialize is
begin
for I in Table'Range loop
Table (I) := Null_Object;
end loop;
end Initialize;
------------------------------------------------------------
function Hash_String (Str : String) return Integer is
S : Integer := 0;
Part : Integer;
Target : Integer;
begin
Part := Str'Length / 3;
Target := Part;
if Part = 0 then
for I in Str'Range loop
S := (S + Character'Pos (Str (I)));
end loop;
else
S := (S + Character'Pos (Str (1)));
for I in 1 .. 3 loop
S := (S + Character'Pos (Str (Target)));
Target := Target + Part;
end loop;
end if;
return S mod Max_Size + 1;
end Hash_String;
------------------------------------------------------------
procedure Insert (Ch : String; Place : Integer) is
A_Access_String : Object;
begin
A_Access_String := new String_Access'(Value => new String'(Ch),
Next => Table (Place));
Table (Place) := A_Access_String;
end Insert;
------------------------------------------------------------
function Is_Equal
(Ch : String; O : Constant_String.Object) return Boolean is
begin
return
Ch = O.Value.all;
end Is_Equal;
------------------------------------------------------------
function Value (S : String) return Constant_String.Object is
Place : Integer;
Finded : Boolean := False;
Object_Pointer : Object;
begin
Place := Hash_String (S);
Object_Pointer := Table (Place);
while not Finded and then Object_Pointer /= Null_Object loop
if S = Object_Pointer.Value.all then
Finded := True;
else
Object_Pointer := Object_Pointer.Next;
end if;
end loop;
if not Finded then
Insert (S, Place);
end if;
return Table (Place);
end Value;
------------------------------------------------------------
function Image (C : Constant_String.Object) return String is
begin
return C.Value.all;
exception
when others =>
raise Access_Error;
end Image;
------------------------------------------------------------
package body Operators is
function "<" (Left, Right : Constant_String.Object) return Boolean is
begin
return Left.Value.all < Right.Value.all;
exception
when others =>
raise Access_Error;
end "<";
function ">" (Left, Right : Constant_String.Object) return Boolean is
begin
return Left.Value.all > Right.Value.all;
exception
when others =>
raise Access_Error;
end ">";
function "<=" (Left, Right : Constant_String.Object) return Boolean is
begin
return Left.Value.all <= Right.Value.all;
exception
when others =>
raise Access_Error;
end "<=";
function ">=" (Left, Right : Constant_String.Object) return Boolean is
begin
return Left.Value.all >= Right.Value.all;
exception
when others =>
raise Access_Error;
end ">=";
end Operators;
------------------------------------------------------------
begin
Initialize;
end Constant_String;
nblk1=7
nid=7
hdr6=a
[0x00] rec0=20 rec1=00 rec2=01 rec3=004
[0x01] rec0=19 rec1=00 rec2=03 rec3=028
[0x02] rec0=1e rec1=00 rec2=06 rec3=006
[0x03] rec0=1f rec1=00 rec2=04 rec3=062
[0x04] rec0=06 rec1=00 rec2=02 rec3=000
[0x05] rec0=11 rec1=00 rec2=02 rec3=000
[0x06] rec0=11 rec1=00 rec2=02 rec3=001
tail 0x2150d0d66823d9011455f 0x42a00088462060003
Free Block Chain:
0x7: 0000 00 05 00 25 80 13 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ┆ % ----------┆
0x5: 0000 00 00 03 fc 80 20 28 53 74 72 20 3a 20 53 74 72 ┆ (Str : Str┆