|
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: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Generic_Conflict_Set, seg_02ad10
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
package body Generic_Conflict_Set is
type Node;
type Access_Node is access Node;
type Node is -- a binary search tree
record
The_Instance : Instance;
Left, Right : Access_Node;
end record;
The_Root : Access_Node;
The_Free_List : Access_Node; -- chained nodes on left link
function New_Node return Access_Node is
Result : Access_Node;
begin
if The_Free_List = null then
return new Node;
else
Result := The_Free_List;
The_Free_List := Result.Left;
return Result;
end if;
end New_Node;
procedure Old_Node (The_Node : in out Access_Node) is
begin
The_Node.Left := The_Free_List;
The_Free_List := The_Node;
The_Node := null;
end Old_Node;
procedure Clear (The_Tree : in out Access_Node) is
begin
if The_Tree /= null then
Clear (The_Tree.Left);
Clear (The_Tree.Right);
Old_Node (The_Tree);
end if;
end Clear;
procedure Clear is
begin
Clear (The_Root);
end Clear;
procedure Add (To : in out Access_Node; The_Instance : Instance) is
begin
if To = null then
To := New_Node;
To.all := Node'(The_Instance, null, null);
elsif The_Instance < To.The_Instance then
Add (To.Left, The_Instance);
elsif The_Instance /= To.The_Instance then
Add (To.Right, The_Instance);
end if;
end Add;
procedure Add (The_Instance : Instance) is
begin
Add (The_Root, The_Instance);
end Add;
procedure Get (From : in out Access_Node; The_Instance : out Instance) is
-- return most right
Old_From : Access_Node := From;
begin
if From = null then
raise Underflow;
elsif From.Right /= null then
Get (From.Right, The_Instance);
else
The_Instance := From.The_Instance;
From := From.Left;
Old_Node (Old_From);
end if;
end Get;
function Get return Instance is
Result : Instance;
begin
Get (From => The_Root, The_Instance => Result);
return Result;
end Get;
procedure Delete (From : in out Access_Node; The_Instance : Instance) is
Old_From : Access_Node := From;
begin
if From /= null then
if The_Instance < From.The_Instance then
Delete (From.Left, The_Instance);
elsif The_Instance /= From.The_Instance then
Delete (From.Right, The_Instance);
elsif (From.Left = null) and (From.Right = null) then
Old_Node (From);
elsif From.Left = null then
From := From.Right;
Old_Node (Old_From);
elsif From.Right = null then
From := From.Left;
Old_Node (Old_From);
else
Get (From.Left, From.The_Instance); -- move most right
end if;
end if;
end Delete;
procedure Delete (The_Instance : Instance) is
begin
Delete (The_Root, The_Instance);
end Delete;
function Is_Empty return Boolean is
begin
return The_Root = null;
end Is_Empty;
procedure Put (At_Index : Positive;
The_Instance : Instance;
Where : Output_Stream.Object) is
use Output_Stream;
begin
if At_Index /= 1 then
Put_Line (',', Where);
end if;
Put (At_Index, Where);
Put (" => ", Where);
Put (The_Instance, Where);
end Put;
procedure Put (The_Tree : Access_Node; Where : Output_Stream.Object) is
Index : Positive := 1;
procedure R_Put (The_Tree : Access_Node;
Where : Output_Stream.Object) is
use Output_Stream;
begin
if The_Tree /= null then
R_Put (The_Tree.Right, Where);
Put (Index, The_Tree.The_Instance, Where);
Index := Index + 1;
R_Put (The_Tree.Left, Where);
end if;
end R_Put;
begin
Output_Stream.Put_Line ("Conflict_set'(", Where);
Output_Stream.Indent (+2, Where);
R_Put (The_Tree, Where);
Output_Stream.Indent (-2, Where);
Output_Stream.Put_Line (")", Where);
end Put;
procedure Put (Where : Output_Stream.Object) is
begin
Put (The_Tree => The_Root, Where => Where);
end Put;
end Generic_Conflict_Set;
nblk1=9
nid=5
hdr6=e
[0x00] rec0=24 rec1=00 rec2=01 rec3=032
[0x01] rec0=01 rec1=00 rec2=08 rec3=010
[0x02] rec0=24 rec1=00 rec2=06 rec3=00c
[0x03] rec0=00 rec1=00 rec2=03 rec3=008
[0x04] rec0=1e rec1=00 rec2=02 rec3=01a
[0x05] rec0=24 rec1=00 rec2=04 rec3=08a
[0x06] rec0=1b rec1=00 rec2=09 rec3=000
[0x07] rec0=01 rec1=00 rec2=05 rec3=000
[0x08] rec0=e3 rec1=a6 rec2=00 rec3=000
tail 0x215230f9683e571a8e492 0x42a00088462063c03
Free Block Chain:
0x5: 0000 00 07 00 22 00 00 00 00 19 65 6e 64 20 47 65 6e ┆ " end Gen┆
0x7: 0000 00 00 00 0f 80 09 6c 69 63 74 5f 53 65 74 3b 09 ┆ lict_Set; ┆