"attempt to tamper with cursors (container is busy)";
end if;
- Tree.First := 0;
- Tree.Last := 0;
- Tree.Root := 0;
+ -- The lock status (which monitors "element tampering") always implies
+ -- that the busy status (which monitors "cursor tampering") is set too;
+ -- this is a representation invariant. Thus if the busy bit is not set,
+ -- then the lock bit must not be set either.
+
+ pragma Assert (Tree.Lock = 0);
+
+ Tree.First := 0;
+ Tree.Last := 0;
+ Tree.Root := 0;
Tree.Length := 0;
- -- Tree.Busy
- -- Tree.Lock
- Tree.Free := -1;
+ Tree.Free := -1;
end Clear_Tree;
------------------
(Tree : in out Tree_Type'Class;
Node : Count_Type)
is
-
- -- CLR p274
+ -- CLR p. 274
X : Count_Type;
W : Count_Type;
end if;
if (Left (N (W)) = 0 or else Color (N (Left (N (W)))) = Black)
- and then
+ and then
(Right (N (W)) = 0 or else Color (N (Right (N (W)))) = Black)
then
Set_Color (N (W), Red);
(Tree : in out Tree_Type'Class;
Node : Count_Type)
is
- -- CLR p273
+ -- CLR p. 273
X, Y : Count_Type;
end if;
pragma Assert (Tree.Length > 0);
- pragma Assert (Tree.Root /= 0);
+ pragma Assert (Tree.Root /= 0);
pragma Assert (Tree.First /= 0);
- pragma Assert (Tree.Last /= 0);
+ pragma Assert (Tree.Last /= 0);
pragma Assert (Parent (N (Tree.Root)) = 0);
pragma Assert ((Tree.Length > 1)
Set_Right (N (Parent (N (Z))), Y);
end if;
- Set_Left (N (Y), Left (N (Z)));
+ Set_Left (N (Y), Left (N (Z)));
Set_Parent (N (Left (N (Y))), Y);
- Set_Right (N (Y), Z);
+ Set_Right (N (Y), Z);
+
Set_Parent (N (Z), Y);
- Set_Left (N (Z), 0);
- Set_Right (N (Z), 0);
+ Set_Left (N (Z), 0);
+ Set_Right (N (Z), 0);
declare
Y_Color : constant Color_Type := Color (N (Y));
pragma Assert (Parent (N (Y)) /= Z);
Y_Parent : constant Count_Type := Parent (N (Y));
- Y_Color : constant Color_Type := Color (N (Y));
+ Y_Color : constant Color_Type := Color (N (Y));
begin
Set_Parent (N (Y), Parent (N (Z)));
- Set_Left (N (Y), Left (N (Z)));
- Set_Right (N (Y), Right (N (Z)));
- Set_Color (N (Y), Color (N (Z)));
+ Set_Left (N (Y), Left (N (Z)));
+ Set_Right (N (Y), Right (N (Z)));
+ Set_Color (N (Y), Color (N (Z)));
if Tree.Root = Z then
Tree.Root := Y;
end if;
Set_Parent (N (Z), Y_Parent);
- Set_Color (N (Z), Y_Color);
- Set_Left (N (Z), 0);
- Set_Right (N (Z), 0);
+ Set_Color (N (Z), Y_Color);
+ Set_Left (N (Z), 0);
+ Set_Right (N (Z), 0);
end Delete_Swap;
----------
-- node onto the head of the free store.
-- ???
- -- See the comments above for an optimization opportunity. If
- -- the next link for a node on the free store is negative, then
- -- this means the remaining nodes on the free store are
- -- physically contiguous, starting as the absolute value of
- -- that index value.
+ -- See the comments above for an optimization opportunity. If the
+ -- next link for a node on the free store is negative, then this
+ -- means the remaining nodes on the free store are physically
+ -- contiguous, starting as the absolute value of that index value.
Tree.Free := abs Tree.Free;
Tree.Free := Tree.Free - 1;
end if;
+ -- When a node is allocated from the free store, its pointer components
+ -- (the links to other nodes in the tree) must also be initialized (to
+ -- 0, the equivalent of null). This simplifies the post-allocation
+ -- handling of nodes inserted into terminal positions.
+
Set_Parent (N (Node), Parent => 0);
- Set_Left (N (Node), Left => 0);
- Set_Right (N (Node), Right => 0);
+ Set_Left (N (Node), Left => 0);
+ Set_Right (N (Node), Right => 0);
end Generic_Allocate;
-------------------
Set_Color (N (Node), Black);
- Tree.Root := Node;
- Tree.First := Node;
- Tree.Last := Node;
+ Tree.Root := Node;
+ Tree.First := Node;
+ Tree.Last := Node;
Tree.Length := 1;
for J in Count_Type range 2 .. Len loop
procedure Process (Node : Count_Type);
pragma Inline (Process);
- procedure Iterate is
- new Generic_Iteration (Process);
+ procedure Iterate is new Generic_Iteration (Process);
-------------
-- Process --
-----------------
procedure Left_Rotate (Tree : in out Tree_Type'Class; X : Count_Type) is
- -- CLR p266
+ -- CLR p. 266
N : Nodes_Type renames Tree.Nodes;
Set_Right (N (Parent (N (X))), Y);
end if;
- Set_Left (N (Y), X);
+ Set_Left (N (Y), X);
Set_Parent (N (X), Y);
end Left_Rotate;
(Tree : Tree_Type'Class;
Node : Count_Type) return Count_Type
is
- -- CLR p248
+ -- CLR p. 248
X : Count_Type := Node;
Y : Count_Type;
(Tree : Tree_Type'Class;
Node : Count_Type) return Count_Type
is
- -- CLR p248
+ -- CLR p. 248
X : Count_Type := Node;
Y : Count_Type;
Node : Count_Type) return Count_Type
is
begin
- -- CLR p249
+ -- CLR p. 249
if Node = 0 then
return 0;
(Tree : in out Tree_Type'Class;
Node : Count_Type)
is
- -- CLR p.268
+ -- CLR p. 268
N : Nodes_Type renames Tree.Nodes;
Set_Right (N (Parent (N (Y))), X);
end if;
- Set_Right (N (X), Y);
+ Set_Right (N (X), Y);
Set_Parent (N (Y), X);
end Right_Rotate;
OSDN Git Service
