|
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: 7168 (0x1c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Binary_Tree, seg_02fbdb
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
package body Binary_Tree is
procedure Clear_Out (The_Tree : in out Object) is
begin
The_Tree := Empty_Tree;
end Clear_Out;
procedure Build (The_Element : in Element; In_The_Tree : in out Object) is
begin
In_The_Tree := new Node'(Value => The_Element,
Under_Left_Tree => Empty_Tree,
Under_Right_Tree => Empty_Tree);
exception
when Storage_Error =>
raise Overflow;
end Build;
procedure Insert (The_Element : in Element; In_The_Tree : in out Object) is
begin
if Is_Empty (In_The_Tree) then
Build (The_Element, In_The_Tree);
else
if "<" (The_Element, In_The_Tree.Value) then
Insert (The_Element, In_The_Tree.Under_Left_Tree);
else
Insert (The_Element, In_The_Tree.Under_Right_Tree);
end if;
end if;
end Insert;
procedure Duplicate (The_Source_Tree : in Object;
The_Destination_Tree : in out Object) is
begin
if Is_Empty (The_Source_Tree) then
The_Destination_Tree := Empty_Tree;
else
The_Destination_Tree := new Node'(Value => The_Source_Tree.Value,
Under_Left_Tree => Empty_Tree,
Under_Right_Tree => Empty_Tree);
Duplicate (The_Source_Tree.Under_Left_Tree,
The_Destination_Tree.Under_Left_Tree);
Duplicate (The_Source_Tree.Under_Right_Tree,
The_Destination_Tree.Under_Right_Tree);
end if;
exception
when Storage_Error =>
raise Overflow;
end Duplicate;
procedure Get_Under_Left_Tree (Of_The_Tree : in Object;
In_The_Tree : in out Object) is
begin
In_The_Tree := Of_The_Tree.Under_Left_Tree;
end Get_Under_Left_Tree;
procedure Get_Under_Right_Tree (Of_The_Tree : in Object;
In_The_Tree : in out Object) is
begin
In_The_Tree := Of_The_Tree.Under_Right_Tree;
end Get_Under_Right_Tree;
procedure Visit_Lrr (The_Tree : in Object) is
begin
if not Is_Empty (The_Tree) then
Visit_Lrr (The_Tree.Under_Left_Tree);
Handle (The_Tree.Value);
Visit_Lrr (The_Tree.Under_Right_Tree);
end if;
end Visit_Lrr;
function Is_Empty (The_Tree : Object) return Boolean is
begin
return The_Tree = Empty_Tree;
end Is_Empty;
function Find (The_Element : Element; In_The_Tree : Object)
return Boolean is
begin
if Is_Empty (In_The_Tree) then
return False;
end if;
if The_Element = In_The_Tree.Value then
return True;
else
if "<" (The_Element, In_The_Tree.Value) then
return Find (The_Element, In_The_Tree.Under_Left_Tree);
else
return Find (The_Element, In_The_Tree.Under_Left_Tree);
end if;
end if;
end Find;
procedure Get_Value (Of_The_Tree : in Object;
In_The_Element : in out Element) is
begin
In_The_Element := Of_The_Tree.Value;
exception
when Constraint_Error =>
raise Tree_Is_Empty;
end Get_Value;
end Binary_Tree;
nblk1=6
nid=4
hdr6=8
[0x00] rec0=1f rec1=00 rec2=01 rec3=000
[0x01] rec0=17 rec1=00 rec2=06 rec3=028
[0x02] rec0=20 rec1=00 rec2=02 rec3=030
[0x03] rec0=14 rec1=00 rec2=03 rec3=000
[0x04] rec0=07 rec1=00 rec2=04 rec3=000
[0x05] rec0=42 rec1=45 rec2=2f rec3=651
tail 0x21728c54484936c03ecde 0x42a00088462060003
Free Block Chain:
0x4: 0000 00 05 00 95 80 0e 68 65 5f 54 72 65 65 2e 56 61 ┆ he_Tree.Va┆
0x5: 0000 00 00 00 a3 80 33 20 20 20 70 72 6f 63 65 64 75 ┆ 3 procedu┆