GC: use simple balanced tree instead of AVL tree

7 files changed, 409 insertions, 240 deletions

diff --git a/doc/lib.txt b/doc/lib.txt
index 46c403ed5..8e18ae095 100755
--- a/doc/lib.txt
+++ b/doc/lib.txt
@@ -63,6 +63,9 @@ Collections and algorithms
   Implementation of a queue. The underlying implementation uses a ``seq``.
 * `intsets <intsets.html>`_
   Efficient implementation of a set of ints as a sparse bit set.
+* `critbits <critbits.html>`_
+  This module implements a *crit bit tree* which is an efficient
+  container for a set or a mapping of strings.
 * `sequtils <sequtils.html>`_
   This module implements operations for the built-in seq type
   which were inspired by functional programming languages.
diff --git a/lib/pure/collections/critbits.nim b/lib/pure/collections/critbits.nim
new file mode 100644
index 000000000..a18c42e58
--- /dev/null
+++ b/lib/pure/collections/critbits.nim
@@ -0,0 +1,302 @@
+#
+#
+#            Nimrod's Runtime Library
+#        (c) Copyright 2011 Andreas Rumpf
+#
+#    See the file "copying.txt", included in this
+#    distribution, for details about the copyright.
+#
+
+## This module implements a `crit bit tree`:idx: which is an efficient
+## container for a set or a mapping of strings. Based on the excellent paper
+## by Adam Langley.
+
+type
+  TNode[T] = object {.pure, final, acyclic.}
+    byte: int ## byte index of the difference
+    otherbits: char
+    case isLeaf: bool
+    of false: child: array[0..1, ref TNode[T]]
+    of true: 
+      key: string
+      when T isnot void:
+        val: T
+    
+  PNode[T] = ref TNode[T]
+  TCritBitTree*[T] = object {.
+      pure, final.} ## The crit bit tree can either be used
+                    ## as a mapping from strings to
+                    ## some type ``T`` or as a set of
+                    ## strings if ``T`` is void.
+    root: PNode[T]
+    count: int
+    
+proc len*[T](c: TCritBitTree[T]): int =
+  ## returns the number of elements in `c` in O(1).
+  result = c.count
+
+proc rawGet[T](c: TCritBitTree[T], key: string): PNode[T] =
+  var it = c.root
+  while it != nil:
+    if not it.isLeaf:
+      let ch = if it.byte < key.len: key[it.byte] else: '\0'
+      let dir = (1 + (ch.ord or it.otherBits.ord)) shr 8
+      it = it.child[dir]
+    else:
+      return if it.key == key: it else: nil
+
+proc contains*[T](c: TCritBitTree[T], key: string): bool {.inline.} =
+  ## returns true iff `c` contains the given `key`.
+  result = rawGet(c, key) != nil
+
+proc hasKey*[T](c: TCritBitTree[T], key: string): bool {.inline.} =
+  ## alias for `contains`.
+  result = rawGet(c, key) != nil
+
+proc rawInsert[T](c: var TCritBitTree[T], key: string): PNode[T] =
+  if c.root == nil:
+    new c.root
+    c.root.isleaf = true
+    c.root.key = key
+    result = c.root
+  else:
+    var it = c.root
+    while not it.isLeaf:
+      let ch = if it.byte < key.len: key[it.byte] else: '\0'
+      let dir = (1 + (ch.ord or it.otherBits.ord)) shr 8
+      it = it.child[dir]
+    
+    var newOtherBits = 0
+    var newByte = 0
+    block blockX:
+      while newbyte < key.len:
+        if it.key[newbyte] != key[newbyte]:
+          newotherbits = it.key[newbyte].ord xor key[newbyte].ord
+          break blockX
+        inc newbyte
+      if it.key[newbyte] != '\0':
+        newotherbits = it.key[newbyte].ord
+      else:
+        return it
+    while (newOtherBits and (newOtherBits-1)) != 0:
+      newOtherBits = newOtherBits and (newOtherBits-1)
+    newOtherBits = newOtherBits xor 255
+    let ch = it.key[newByte]
+    let dir = (1 + (ord(ch) or newOtherBits)) shr 8
+    
+    var inner: PNode[T]
+    new inner
+    new result
+    result.isLeaf = true
+    result.key = key
+    inner.otherBits = chr(newOtherBits)
+    inner.byte = newByte
+    inner.child[1 - dir] = result
+    
+    var wherep = addr(c.root)
+    while true:
+      var p = wherep[]
+      if p.isLeaf: break
+      if p.byte > newByte: break
+      if p.byte == newByte and p.otherBits.ord > newOtherBits: break
+      let ch = if p.byte < key.len: key[p.byte] else: '\0'
+      let dir = (1 + (ch.ord or p.otherBits.ord)) shr 8
+      wherep = addr(p.child[dir])
+    inner.child[dir] = wherep[]
+    wherep[] = inner
+  inc c.count
+
+proc containsOrIncl*[T](c: var TCritBitTree[T], key: string, val: T): bool =
+  ## returns true iff `c` contains the given `key`. If the key does not exist
+  ## ``c[key] = val`` is performed.
+  let oldCount = c.count
+  var n = rawInsert(c, key)
+  result = c.count == oldCount
+  when T isnot void:
+    if not result: n.val = val
+
+proc containsOrIncl*(c: var TCritBitTree[void], key: string): bool =
+  ## returns true iff `c` contains the given `key`. If the key does not exist
+  ## it is inserted into `c`.
+  let oldCount = c.count
+  var n = rawInsert(c, key)
+  result = c.count == oldCount
+
+proc incl*(c: var TCritBitTree[void], key: string) =
+  ## includes `key` in `c`.
+  discard rawInsert(c, key)
+
+proc `[]=`*[T](c: var TCritBitTree[T], key: string, val: T) =
+  ## puts a (key, value)-pair into `t`.
+  var n = rawInsert(c, key)
+  n.val = val
+
+proc `[]`*[T](c: var TCritBitTree[T], key: string): T {.inline.} =
+  ## retrieves the value at ``c[key]``. If `key` is not in `t`,
+  ## default empty value for the type `B` is returned
+  ## and no exception is raised. One can check with ``hasKey`` whether the key
+  ## exists.
+  let n = rawGet(c, key)
+  if n != nil: result = n.val
+
+proc mget*[T](c: var TCritBitTree[T], key: string): var T {.inline.} =
+  ## retrieves the value at ``c[key]``. The value can be modified.
+  ## If `key` is not in `t`, the ``EInvalidKey`` exception is raised.
+  let n = rawGet(c, key)
+  if n != nil: result = n.val
+  else: raise newException(EInvalidKey, "key not found: " & $key)
+
+proc excl*[T](c: var TCritBitTree[T], key: string) =
+  ## removes `key` (and its associated value) from the set `c`.
+  ## If the `key` does not exist, nothing happens.
+  var p = c.root
+  var wherep = addr(c.root)
+  var whereq: ptr PNode = nil
+  if p == nil: return
+  var dir = 0
+  var q: PNode
+  while not p.isLeaf:
+    whereq = wherep
+    q = p
+    let ch = if p.byte < key.len: key[p.byte] else: '\0'
+    dir = (1 + (ch.ord or p.otherBits.ord)) shr 8
+    wherep = addr(p.child[dir])
+    p = wherep[]
+  if p.key == key:
+    # else: not in tree at all
+    if whereq == nil:
+      c.root = nil
+    else:
+      whereq[] = q.child[1 - dir]
+    dec c.count
+
+iterator leaves[T](n: PNode[T]): PNode[T] =
+  if n != nil:
+    # XXX actually we could compute the necessary stack size in advance:
+    # it's rougly log2(c.count).
+    var stack = @[n]
+    while stack.len > 0: 
+      var it = stack.pop
+      while not it.isLeaf:
+        stack.add(it.child[1])
+        it = it.child[0]
+        assert(it != nil)
+      yield it
+
+iterator keys*[T](c: TCritBitTree[T]): string =
+  ## yields all keys in lexicographical order.
+  for x in leaves(c.root): yield x.key
+
+iterator values*[T](c: TCritBitTree[T]): T =
+  ## yields all values of `c` in the lexicographical order of the
+  ## corresponding keys.
+  for x in leaves(c.root): yield x.val
+
+iterator mvalues*[T](c: var TCritBitTree[T]): var T =
+  ## yields all values of `c` in the lexicographical order of the
+  ## corresponding keys. The values can be modified.
+  for x in leaves(c.root): yield x.val
+
+iterator items*[T](c: TCritBitTree[T]): string =
+  ## yields all keys in lexicographical order.
+  for x in leaves(c.root): yield x.key
+
+iterator pairs*[T](c: TCritBitTree[T]): tuple[key: string, val: T] =
+  ## yields all (key, value)-pairs of `c`.
+  for x in leaves(c.root): yield (x.key, x.val)
+  
+iterator mpairs*[T](c: var TCritBitTree[T]): tuple[key: string, val: var T] =
+  ## yields all (key, value)-pairs of `c`. The yielded values can be modified.
+  for x in leaves(c.root): yield (x.key, x.val)
+
+proc allprefixedAux[T](c: TCritBitTree[T], key: string): PNode[T] =
+  var p = c.root
+  var top = p
+  if p != nil:
+    while not p.isLeaf:
+      var q = p
+      let ch = if p.byte < key.len: key[p.byte] else: '\0'
+      let dir = (1 + (ch.ord or p.otherBits.ord)) shr 8
+      p = p.child[dir]
+      if q.byte < key.len: top = p
+    for i in 0 .. <key.len:
+      if p.key[i] != key[i]: return
+    result = top
+
+iterator itemsWithPrefix*[T](c: TCritBitTree[T], prefix: string): string =
+  ## yields all keys starting with `prefix`.
+  let top = allprefixedAux(c, prefix)
+  for x in leaves(top): yield x.key
+
+iterator keysWithPrefix*[T](c: TCritBitTree[T], prefix: string): string =
+  ## yields all keys starting with `prefix`.
+  let top = allprefixedAux(c, prefix)
+  for x in leaves(top): yield x.key
+
+iterator valuesWithPrefix*[T](c: TCritBitTree[T], prefix: string): T =
+  ## yields all values of `c` starting with `prefix` of the
+  ## corresponding keys.
+  let top = allprefixedAux(c, prefix)
+  for x in leaves(top): yield x.val
+
+iterator mvaluesWithPrefix*[T](c: var TCritBitTree[T], prefix: string): var T =
+  ## yields all values of `c` starting with `prefix` of the
+  ## corresponding keys. The values can be modified.
+  let top = allprefixedAux(c, prefix)
+  for x in leaves(top): yield x.val
+
+iterator pairsWithPrefix*[T](c: TCritBitTree[T],
+                             prefix: string): tuple[key: string, val: T] =
+  ## yields all (key, value)-pairs of `c` starting with `prefix`.
+  let top = allprefixedAux(c, prefix)
+  for x in leaves(top): yield (x.key, x.val)
+  
+iterator mpairsWithPrefix*[T](c: var TCritBitTree[T],
+                              prefix: string): tuple[key: string, val: var T] =
+  ## yields all (key, value)-pairs of `c` starting with `prefix`.
+  ## The yielded values can be modified.
+  let top = allprefixedAux(c, prefix)
+  for x in leaves(top): yield (x.key, x.val)
+
+proc `$`*[T](c: TCritBitTree[T]): string =
+  ## turns `c` into a string representation. Example outputs:
+  ## ``{keyA: value, keyB: value}``, ``{:}``
+  ## If `T` is void the outputs look like:
+  ## ``{keyA, keyB}``, ``{}``.
+  if c.len == 0:
+    when T is void:
+      result = "{}"
+    else:
+      result = "{:}"
+  else:
+    # an educated guess is better than nothing:
+    when T is void:
+      const avgItemLen = 8
+    else:
+      const avgItemLen = 16
+    result = newStringOfCap(c.count * avgItemLen)
+    result.add("{")
+    for key, val in pairs(c):
+      if result.len > 1: result.add(", ")
+      result.add($key)
+      when T isnot void:
+        result.add(": ")
+        result.add($val)
+    result.add("}")
+
+when isMainModule:
+  var r: TCritBitTree[void]
+  r.incl "abc"
+  r.incl "xyz"
+  r.incl "def"
+  r.incl "definition"
+  r.incl "prefix"
+  doAssert r.contains"def"
+  #r.del "def"
+
+  for w in r.items:
+    echo w
+    
+  for w in r.allPrefixed("de"):
+    echo w
+
diff --git a/lib/system.nim b/lib/system.nim
index 8a99781cc..f8bfe3e77 100755
--- a/lib/system.nim
+++ b/lib/system.nim
@@ -1557,6 +1557,8 @@ when not defined(EcmaScript) and not defined(NimrodVM):
   {.push stack_trace: off.}
 
   proc initGC()
+  when not defined(boehmgc):
+    proc initAllocator() {.inline.}
 
   proc initStackBottom() {.inline.} = 
     # WARNING: This is very fragile! An array size of 8 does not work on my
@@ -1792,7 +1794,9 @@ when not defined(EcmaScript) and not defined(NimrodVM):
       prev: PSafePoint # points to next safe point ON THE STACK
       status: int
       context: C_JmpBuf
-
+  
+  when defined(initAllocator):
+    initAllocator()
   when hasThreadSupport:
     include "system/syslocks"
     include "system/threads"
diff --git a/lib/system/alloc.nim b/lib/system/alloc.nim
index 9007f4844..bc8124aca 100755
--- a/lib/system/alloc.nim
+++ b/lib/system/alloc.nim
@@ -156,7 +156,7 @@ type
   TAvlNode {.pure, final.} = object 
     link: array[0..1, PAvlNode] # Left (0) and right (1) links 
     key, upperBound: int
-    balance: int            # Balance factor 
+    level: int
     
   TMemRegion {.final, pure.} = object
     minLargeObj, maxLargeObj: int
@@ -166,8 +166,18 @@ type
     lastSize: int # needed for the case that OS gives us pages linearly 
     freeChunksList: PBigChunk # XXX make this a datastructure with O(1) access
     chunkStarts: TIntSet
-    root, freeAvlNodes: PAvlNode
+    root, deleted, last, freeAvlNodes: PAvlNode
   
+# shared:
+var
+  bottomData: TAvlNode
+  bottom: PAvlNode
+
+proc initAllocator() =
+  bottom = addr(bottomData)
+  bottom.link[0] = bottom
+  bottom.link[1] = bottom
+
 proc incCurrMem(a: var TMemRegion, bytes: int) {.inline.} = 
   inc(a.currMem, bytes)
 
@@ -204,13 +214,13 @@ proc allocAvlNode(a: var TMemRegion, key, upperBound: int): PAvlNode =
   if a.freeAvlNodes != nil:
     result = a.freeAvlNodes
     a.freeAvlNodes = a.freeAvlNodes.link[0]
-    result.link[0] = nil
-    result.link[1] = nil
-    result.balance = 0
   else:
     result = cast[PAvlNode](llAlloc(a, sizeof(TAvlNode)))
   result.key = key
   result.upperBound = upperBound
+  result.link[0] = bottom
+  result.link[1] = bottom
+  result.level = 0
 
 proc deallocAvlNode(a: var TMemRegion, n: PAvlNode) {.inline.} =
   n.link[0] = a.freeAvlNodes
@@ -523,7 +533,8 @@ proc rawAlloc(a: var TMemRegion, requestedSize: int): pointer =
     sysAssert c.size == size, "rawAlloc 12"
     result = addr(c.data)
     sysAssert((cast[TAddress](result) and (MemAlign-1)) == 0, "rawAlloc 13")
-    add(a, cast[TAddress](result), cast[TAddress](result)+%size)
+    if a.root == nil: a.root = bottom
+    add(a, a.root, cast[TAddress](result), cast[TAddress](result)+%size)
   sysAssert(isAccessible(a, result), "rawAlloc 14")
 
 proc rawAlloc0(a: var TMemRegion, requestedSize: int): pointer =
@@ -562,7 +573,8 @@ proc rawDealloc(a: var TMemRegion, p: pointer) =
     when overwriteFree: c_memset(p, -1'i32, c.size -% bigChunkOverhead())
     # free big chunk
     var c = cast[PBigChunk](c)
-    del(a, cast[int](addr(c.data)))
+    a.deleted = bottom
+    del(a, a.root, cast[int](addr(c.data)))
     freeBigChunk(a, c)
 
 proc isAllocatedPtr(a: TMemRegion, p: pointer): bool = 
@@ -592,13 +604,19 @@ proc interiorAllocatedPtr(a: TMemRegion, p: pointer): pointer =
         var offset = (cast[TAddress](p) and (PageSize-1)) -% 
                      smallChunkOverhead()
         if c.acc >% offset:
+          sysAssert(cast[TAddress](addr(c.data)) +% offset ==
+                    cast[TAddress](p), "offset is not what you think it is")
           var d = cast[ptr TFreeCell](cast[TAddress](addr(c.data)) +% 
                     offset -% (offset %% c.size))
-          if d.zeroField >% 1: result = d
+          if d.zeroField >% 1:
+            result = d
+            sysAssert isAllocatedPtr(a, result), " result wrong pointer!"
       else:
         var c = cast[PBigChunk](c)
         var d = addr(c.data)
-        if p >= d and cast[ptr TFreeCell](d).zeroField >% 1: result = d
+        if p >= d and cast[ptr TFreeCell](d).zeroField >% 1:
+          result = d
+          sysAssert isAllocatedPtr(a, result), " result wrong pointer!"
   else:
     var q = cast[int](p)
     if q >=% a.minLargeObj and q <=% a.maxLargeObj:
@@ -611,6 +629,7 @@ proc interiorAllocatedPtr(a: TMemRegion, p: pointer): pointer =
         sysAssert(addr(c.data) == k, " k is not the same as addr(c.data)!")
         if cast[ptr TFreeCell](k).zeroField >% 1:
           result = k
+          sysAssert isAllocatedPtr(a, result), " result wrong pointer!"
 
 proc ptrSize(p: pointer): int =
   var x = cast[pointer](cast[TAddress](p) -% sizeof(TFreeCell))
diff --git a/lib/system/avltree.nim b/lib/system/avltree.nim
index a7f9208ca..9bc2687f4 100644
--- a/lib/system/avltree.nim
+++ b/lib/system/avltree.nim
@@ -7,245 +7,85 @@
 #    distribution, for details about the copyright.
 #
 
+## not really an AVL tree anymore, but still balanced ...
 
-## AVL balanced tree based on a C implementation by Julienne Walker
-
-const 
-  HeightLimit = 128        # Tallest allowable tree
-  
-# Two way single rotation 
-
-template singleRot(root, dir: expr): stmt =
-  block:
-    var save = root.link[1-dir]
-    root.link[1-dir] = save.link[dir]
-    save.link[dir] = root
-    root = save
-
-# Two way double rotation 
-
-template doubleRot(root, dir: expr): stmt =
-  block:
-    var save = root.link[1-dir].link[dir]
-    root.link[1-dir].link[dir] = save.link[1-dir]
-    save.link[1-dir] = root.link[1-dir]
-    root.link[1-dir] = save
-    save = root.link[1-dir]
-    root.link[1-dir] = save.link[dir]
-    save.link[dir] = root
-    root = save
-
-# Adjust balance before double rotation 
-
-template adjustBalance(root, dir, bal: expr): stmt = 
-  block:
-    var n = root.link[dir]
-    var nn = n.link[1-dir]
-    if nn.balance == 0:
-      root.balance = 0
-      n.balance = 0
-    elif nn.balance == bal:
-      root.balance = -bal
-      n.balance = 0
-    else:
-      # nn->balance == -bal 
-      root.balance = 0
-      n.balance = bal
-    nn.balance = 0
-
-# Rebalance after insertion 
-
-template insertBalance(root, dir: expr): stmt = 
-  block:
-    var n = root.link[dir]
-    var bal = if dir == 0: -1 else: +1
-    if n.balance == bal:
-      root.balance = 0
-      n.balance = 0
-      singleRot(root, 1-dir)
-    else: 
-      # n->balance == -bal 
-      adjustBalance(root, dir, bal)
-      doubleRot(root, 1-dir)
-
-# Rebalance after deletion 
-
-template removeBalance(root, dir, done: expr): stmt =
-  block:
-    var n = root.link[1-dir]
-    var bal = if dir == 0: -1 else: + 1
-    if n.balance == - bal: 
-      root.balance = 0
-      n.balance = 0
-      singleRot(root, dir)
-    elif n.balance == bal: 
-      adjustBalance(root, 1-dir, - bal)
-      doubleRot(root, dir)
-    else: 
-      # n->balance == 0 
-      root.balance = -bal
-      n.balance = bal
-      singleRot(root, dir)
-      done = true
-
-proc find(root: PAvlNode, key: int): PAvlNode = 
-  var it = root
-  while it != nil:
-    if it.key == key: return it
-    it = it.link[ord(it.key <% key)]
-
-proc inRange(root: PAvlNode, key: int): PAvlNode =
-  var it = root
-  while it != nil:
-    if it.key <=% key and key <=% it.upperBound: return it
-    it = it.link[ord(it.key <% key)]
-
-proc contains(root: PAvlNode, key: int): bool {.inline.} =
-  result = find(root, key) != nil
-
-proc maxheight(n: PAvlNode): int =
-  if n != nil:
-    result = max(maxheight(n.link[0]), maxheight(n.link[1])) + 1
-
-proc minheight(n: PAvlNode): int =
-  if n != nil:
-    result = min(minheight(n.link[0]), minheight(n.link[1])) + 1
+template IsBottom(n: PAvlNode): bool = n == bottom
 
 proc lowGauge(n: PAvlNode): int =
   var it = n
-  while it != nil:
+  while not IsBottom(it):
     result = it.key
     it = it.link[0]
   
 proc highGauge(n: PAvlNode): int =
   result = -1
   var it = n
-  while it != nil:
+  while not IsBottom(it):
     result = it.upperBound
     it = it.link[1]
 
-proc add(a: var TMemRegion, key, upperBound: int) = 
-  # Empty tree case
-  if a.root == nil:
-    a.root = allocAvlNode(a, key, upperBound)
-  else:
-    var head: TAvlNode # Temporary tree root
-    var s, t, p, q: PAvlNode
-    # Iterator and save pointer 
-    var dir: int
-    # Set up false root to ease maintenance:
-    t = addr(head)
-    t.link[1] = a.root
-    # Search down the tree, saving rebalance points
-    s = t.link[1]
-    p = s
-    while true:
-      dir = ord(p.key <% key)
-      q = p.link[dir]
-      if q == nil: break 
-      if q.balance != 0:
-        t = p
-        s = q
-      p = q
-    q = allocAvlNode(a, key, upperBound)
-    p.link[dir] = q
-    # Update balance factors
-    p = s
-    while p != q:
-      dir = ord(p.key <% key)
-      if dir == 0: dec p.balance
-      else: inc p.balance
-      p = p.link[dir]
-    q = s
-    # Save rebalance point for parent fix 
-    # Rebalance if necessary 
-    if abs(s.balance) > 1:
-      dir = ord(s.key <% key)
-      insertBalance(s, dir)
-    # Fix parent
-    if q == head.link[1]: a.root = s
-    else: t.link[ord(q == t.link[1])] = s
-
-proc del(a: var TMemRegion, key: int) =
-  if a.root == nil: return
-  var
-    upd: array[0..HeightLimit-1, int]
-    up: array[0..HeightLimit-1, PAvlNode]
-  var top = 0
-  var it = a.root
-  # Search down tree and save path
-  while true:
-    if it == nil: return
-    elif it.key == key: break 
-    # Push direction and node onto stack 
-    upd[top] = ord(it.key <% key)
-    up[top] = it
-    it = it.link[upd[top]]
-    inc top
-  # Remove the node 
-  if it.link[0] == nil or it.link[1] == nil: 
-    # Which child is not null? 
-    var dir = ord(it.link[0] == nil)
-    # Fix parent 
-    if top != 0: up[top - 1].link[upd[top - 1]] = it.link[dir]
-    else: a.root = it.link[dir]
-    deallocAvlNode(a, it)
-  else:
-    # Find the inorder successor 
-    var heir = it.link[1]
-    # Save this path too 
-    upd[top] = 1
-    up[top] = it
-    inc top
-    while heir.link[0] != nil: 
-      upd[top] = 0
-      up[top] = heir
-      inc top
-      heir = heir.link[0]
-    swap(it.key, heir.key)
-    swap(it.upperBound, heir.upperBound)
-    
-    # Unlink successor and fix parent 
-    up[top - 1].link[ord(up[top - 1] == it)] = heir.link[1]
-    deallocAvlNode(a, heir)
-  # Walk back up the search path
-  dec top
-  var done = false
-  while top >= 0 and not done:
-    # Update balance factors
-    if upd[top] != 0: dec up[top].balance
-    else: inc up[top].balance
-    # Terminate or rebalance as necessary 
-    if abs(up[top].balance) == 1: 
-      break
-    elif abs(up[top].balance) > 1: 
-      removeBalance(up[top], upd[top], done)
-      # Fix parent
-      if top != 0: up[top-1].link[upd[top-1]] = up[top]
-      else: a.root = up[0]
-    dec top
+proc find(root: PAvlNode, key: int): PAvlNode = 
+  var it = root
+  while not IsBottom(it):
+    if it.key == key: return it
+    it = it.link[ord(it.key <% key)]
 
-when isMainModule:
-  import math
-  var
-    r: PAvlNode
-    s: seq[int]
-  const N = 1000_000
-  newSeq s, N
+proc inRange(root: PAvlNode, key: int): PAvlNode =
+  var it = root
+  while not IsBottom(it):
+    if it.key <=% key and key <% it.upperBound: return it
+    it = it.link[ord(it.key <% key)]
 
-  for i in 0..N-1:
-    var key = i #random(10_000)
-    s[i] = key
-    r.add(key, 12_000_000)
-  for i in 0..N-1:
-    var key = s[i]
-    doAssert inRange(r, key+1000) != nil
-    doAssert key in r
-  echo "Min-Height: ", minheight(r), " max-height: ", maxheight(r)
-  for i in 0..N-1:
-    var key = s[i]
-    del r, key
-    doAssert key notin r
-    
-  doAssert r == nil
+proc skew(t: var PAvlNode) =
+  if t.link[0].level == t.level:
+    var temp = t
+    t = t.link[0]
+    temp.link[0] = t.link[1]
+    t.link[1] = temp
+
+proc split(t: var PAvlNode) =
+  if t.link[1].link[1].level == t.level:
+    var temp = t
+    t = t.link[1]
+    temp.link[1] = t.link[0]
+    t.link[0] = temp
+    inc t.level
+
+proc add(a: var TMemRegion, t: var PAvlNode, key, upperBound: int) =
+  if t == bottom:
+    t = allocAvlNode(a, key, upperBound)
+  else:
+    if key <% t.key:
+      add(a, t.link[0], key, upperBound)
+    elif key >% t.key:
+      add(a, t.link[1], key, upperBound)
+    else:
+      sysAssert false, "key already exists"
+    skew(t)
+    split(t)
+
+proc del(a: var TMemRegion, t: var PAvlNode, x: int) =
+  if t == bottom: return
+  a.last = t
+  if x <% t.key:
+    del(a, t.link[0], x)
+  else:
+    a.deleted = t
+    del(a, t.link[1], x)
+  if t == a.last and a.deleted != bottom and x == a.deleted.key:
+    a.deleted.key = t.key
+    a.deleted.upperBound = t.upperBound
+    a.deleted = bottom
+    t = t.link[1]
+    deallocAvlNode(a, a.last)
+  elif t.link[0].level < t.level-1 or
+       t.link[1].level < t.level-1:
+    dec t.level
+    if t.link[1].level > t.level:
+      t.link[1].level = t.level
+    skew(t)
+    skew(t.link[1])
+    skew(t.link[1].link[1])
+    split(t)
+    split(t.link[1])
 
diff --git a/web/news.txt b/web/news.txt
index a60281598..2b7b8fca6 100755
--- a/web/news.txt
+++ b/web/news.txt
@@ -18,8 +18,8 @@ Bugfixes
 - Bugfix c2nim, c2pas: the ``--out`` option has never worked properly.
 - Bugfix: forwarding of generic procs never worked.
 - Some more bugfixes for macros and compile-time evaluation.
-- The compiler now generates code that tries to keep the C compiler from
-  optimizing stack allocated GC roots away.
+- The GC now takes into account interior pointers on the stack which may be
+  introduced by aggressive C optimizers.
 
 
 Changes affecting backwards compatibility
@@ -114,7 +114,7 @@ Compiler Additions
 - Added ``--import:file`` and ``--include:file`` configuration options
   for specifying modules that will be automatically imported/incluced.
 - ``nimrod i`` can now optionally be given a module to execute.
-- The compiler now performs a simple aliases analysis to generate better code.
+- The compiler now performs a simple alias analysis to generate better code.
 
 
 Library Additions
@@ -141,6 +141,7 @@ Library Additions
 - Added ``ftpclient`` module.
 - Added ``memfiles`` module.
 - Added ``subexes`` module.
+- Added ``critbits`` module.
 - Added ``osproc.startCmd``, ``osproc.execCmdEx``.
 - The ``osproc`` module now uses ``posix_spawn`` instead of ``fork`` 
   and ``exec`` on Posix systems. Define the symbol ``useFork`` to revert to
diff --git a/web/nimrod.ini b/web/nimrod.ini
index 53ac668a6..be8bcb509 100755
--- a/web/nimrod.ini
+++ b/web/nimrod.ini
@@ -42,7 +42,7 @@ srcdoc: "impure/rdstdin;wrappers/zmq;wrappers/sphinx"
 srcdoc: "pure/collections/tables;pure/collections/sets;pure/collections/lists"
 srcdoc: "pure/collections/intsets;pure/collections/queues;pure/encodings"
 srcdoc: "pure/events;pure/collections/sequtils;pure/irc;ecmas/dom"
-srcdoc: "pure/ftpclient;pure/memfiles;pure/subexes"
+srcdoc: "pure/ftpclient;pure/memfiles;pure/subexes;pure/collections/critbits"
 
 webdoc: "wrappers/libcurl;pure/md5;wrappers/mysql;wrappers/iup"
 webdoc: "wrappers/sqlite3;wrappers/postgres;wrappers/tinyc"