diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index a1d829bfc28..5079ddbdacc 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -624,12 +624,35 @@ static Res cbsSplayNodeDescribe(Tree node, mps_lib_FILE *stream)
  * See <design/cbs/#function.cbs.iterate>.
  */
 
+typedef struct CBSIterateClosure {
+  CBS cbs;
+  CBSIterateMethod iterate;
+  void *closureP;
+  Size closureS;
+} CBSIterateClosure;
+
+static Bool CBSIterateVisit(Tree tree, void *closureP, Size closureS)
+{
+  CBSIterateClosure *closure = closureP;
+  RangeStruct range;
+  CBSBlock cbsBlock;
+  CBS cbs = closure->cbs;
+
+  UNUSED(closureS);
+
+  cbsBlock = cbsBlockOfNode(tree);
+  RangeInit(&range, CBSBlockBase(cbsBlock), CBSBlockLimit(cbsBlock));
+  if (!closure->iterate(cbs, &range, closure->closureP, closure->closureS))
+    return FALSE;
+  METER_ACC(cbs->treeSearch, cbs->treeSize);
+  return TRUE;
+}
+
 void CBSIterate(CBS cbs, CBSIterateMethod iterate,
                 void *closureP, Size closureS)
 {
-  Tree node;
   SplayTree tree;
-  CBSBlock cbsBlock;
+  CBSIterateClosure closure;
 
   AVERT(CBS, cbs);
   cbsEnter(cbs);
@@ -639,16 +662,13 @@ void CBSIterate(CBS cbs, CBSIterateMethod iterate,
   /* .splay-iterate.slow: We assume that splay tree iteration does */
   /* searches and meter it. */
   METER_ACC(cbs->treeSearch, cbs->treeSize);
-  node = SplayTreeFirst(tree);
-  while(node != NULL) {
-    RangeStruct range;
-    cbsBlock = cbsBlockOfNode(node);
-    RangeInit(&range, CBSBlockBase(cbsBlock), CBSBlockLimit(cbsBlock));
-    if (!(*iterate)(cbs, &range, closureP, closureS))
-      break;
-    METER_ACC(cbs->treeSearch, cbs->treeSize);
-    node = SplayTreeNext(tree, keyOfCBSBlock(cbsBlock));
-  }
+
+  closure.cbs = cbs;
+  closure.iterate = iterate;
+  closure.closureP = closureP;
+  closure.closureS = closureS;
+  TreeTraverse(SplayTreeRoot(tree), tree->compare, tree->nodeKey,
+               CBSIterateVisit, &closure, 0);
 
   cbsLeave(cbs);
   return;
diff --git a/mps/code/tree.c b/mps/code/tree.c
index 03b05cf3be1..277dbaf3772 100644
--- a/mps/code/tree.c
+++ b/mps/code/tree.c
@@ -155,7 +155,7 @@ Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
  * <http://en.wikipedia.org/wiki/Tree_traversal#Morris_in-order_traversal_using_threading>
  *
  * The tree may not be modified during the traversal, and the traversal
- * must complete.
+ * must complete.  TODO: Is there a way to abort early?
  */
 
 void TreeTraverseMorris(Tree tree, TreeVisitor visit,
@@ -170,7 +170,7 @@ void TreeTraverseMorris(Tree tree, TreeVisitor visit,
   node = tree;
   while (node != TreeEMPTY) {
     if (node->left == TreeEMPTY) {
-      visit(node, closureP, closureS);
+      (void)visit(node, closureP, closureS);
       node = node->right;
     } else {
       Tree pre = node->left;
@@ -182,7 +182,7 @@ void TreeTraverseMorris(Tree tree, TreeVisitor visit,
         }
         if (pre->right == node) {
           pre->right = TreeEMPTY;
-          visit(node, closureP, closureS);
+          (void)visit(node, closureP, closureS);
           node = node->right;
           break;
         }
@@ -193,6 +193,101 @@ void TreeTraverseMorris(Tree tree, TreeVisitor visit,
 }
 
 
+/* TreeTraverse -- traverse tree using pointer reversal */
+
+static Tree stepDownLeft(Tree node, Tree *parentIO)
+{
+  Tree parent = *parentIO;
+  Tree child = TreeLeft(node);
+  TreeSetLeft(node, parent);
+  *parentIO = node;
+  return child;
+}
+
+static Tree stepDownRight(Tree node, Tree *parentIO)
+{
+  Tree parent = *parentIO;
+  Tree child = TreeRight(node);
+  TreeSetRight(node, parent);
+  *parentIO = node;
+  return child;
+}
+
+static Tree stepUpRight(Tree node, Tree *parentIO)
+{
+  Tree parent = *parentIO;
+  Tree grandparent = TreeLeft(parent);
+  TreeSetLeft(parent, node);
+  *parentIO = grandparent;
+  return parent;
+}
+
+static Tree stepUpLeft(Tree node, Tree *parentIO)
+{
+  Tree parent = *parentIO;
+  Tree grandparent = TreeRight(parent);
+  TreeSetRight(parent, node);
+  *parentIO = grandparent;
+  return parent;
+}
+
+void TreeTraverse(Tree tree,
+                  TreeCompare compare,
+                  TreeKeyMethod key,
+                  TreeVisitor visit, void *closureP, Size closureS)
+{
+  Tree parent, node;
+  
+  AVER(TreeCheck(tree));
+  AVER(FUNCHECK(visit));
+  /* closureP, closureS arbitrary */
+
+  parent = TreeEMPTY;
+  node = tree;
+  
+  if (node == TreeEMPTY)
+    return;
+
+down:
+  if (TreeHasLeft(node)) {
+    node = stepDownLeft(node, &parent);
+    AVER(compare(parent, key(node)) == CompareLESS);
+    goto down;
+  }
+  if (!visit(node, closureP, closureS))
+    goto abort;
+  if (TreeHasRight(node)) {
+    node = stepDownRight(node, &parent);
+    AVER(compare(parent, key(node)) != CompareLESS);
+    goto down;
+  }
+
+up:
+  if (parent == TreeEMPTY)
+    return;
+  if (compare(parent, key(node)) != CompareLESS) {
+    node = stepUpLeft(node, &parent);
+    goto up;
+  }
+  node = stepUpRight(node, &parent);
+  if (!visit(node, closureP, closureS))
+    goto abort;
+  if (!TreeHasRight(node))
+    goto up;
+  node = stepDownRight(node, &parent);
+  goto down;
+
+abort:
+  if (parent == TreeEMPTY)
+    return;
+  if (compare(parent, key(node)) != CompareLESS)
+    node = stepUpLeft(node, &parent);
+  else
+    node = stepUpRight(node, &parent);
+  goto abort;
+}
+
+
 /* TreeRotateLeft -- Rotate right child edge of node
  *
  * Rotates node, right child of node, and left child of right
@@ -292,6 +387,57 @@ Tree TreeReverseRightSpine(Tree tree)
 }
 
 
+/* TreeToVine -- unbalance a tree into a single right spine */
+
+Count TreeToVine(Tree *link)
+{
+  Count count = 0;
+  
+  AVER(link != NULL);
+  AVERT(Tree, *link);
+
+  while (*link != TreeEMPTY) {
+    while (TreeHasLeft(*link))
+      TreeRotateRight(link);
+    link = &((*link)->right);
+    ++count;
+  }
+  
+  return count;
+}
+
+
+/* TreeBalance -- rebalance a tree
+ *
+ * Linear time, constant space rebalance.
+ *
+ * Quentin F. Stout and Bette L. Warren,
+ * "Tree Rebalancing in Optimal Time and Space",
+ * Communications of the ACM, Vol. 29, No. 9 (September 1986), p. 902-908
+ */
+
+void TreeBalance(Tree *treeIO)
+{
+  Count depth;
+
+  AVER(treeIO != NULL);
+  AVERT(Tree, *treeIO);
+
+  depth = TreeToVine(treeIO);
+
+  if (depth > 2) {
+    Count n = depth - 1;
+    do {
+      Count m = n / 2, i;
+      Tree *link = treeIO;
+      for (i = 0; i < m; ++i) {
+        TreeRotateLeft(link);
+        link = &((*link)->right);
+      }
+      n = n - m - 1;
+    } while (n > 1);
+  }
+}
 
 
 /* C. COPYRIGHT AND LICENSE
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 847174c9243..eaa917dca67 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -76,7 +76,11 @@ extern Compare TreeFind(Tree *treeReturn, Tree root,
 extern Bool TreeInsert(Tree *treeReturn, Tree root, Tree node,
                        TreeKey key, TreeCompare compare);
 
-typedef void TreeVisitor(Tree tree, void *closureP, Size closureS);
+typedef Bool TreeVisitor(Tree tree, void *closureP, Size closureS);
+extern void TreeTraverse(Tree tree,
+                         TreeCompare compare,
+                         TreeKeyMethod key,
+                         TreeVisitor visit, void *closureP, Size closureS);
 extern void TreeTraverseMorris(Tree tree, TreeVisitor visit,
                                void *closureP, Size closureS);
 
@@ -84,6 +88,8 @@ extern void TreeRotateLeft(Tree *nodeIO);
 extern void TreeRotateRight(Tree *nodeIO);
 extern Tree TreeReverseLeftSpine(Tree tree);
 extern Tree TreeReverseRightSpine(Tree tree);
+extern Count TreeToVine(Tree *treeIO);
+extern void TreeBalance(Tree *treeIO);
 
 
 #endif /* tree_h */