Lilypond, GUILE and Garbage Collection (again)

[Han-Wen Nienhuys <hanwen@cs.uu.nl>]

Dear GUILE hackers,

I have fought with GUILE and its garbage collection again, and lost
again.  What is the case?  After my last try with integrating SMOBS
into Lilypond I decided I have taken the wrong objects to smobbify,
and left the issue at rest.  Instead, I have modified the output
engine of Lilypond to be tweaked by modifying GUILE association lists,
which is useful, because it makes the engine more flexible and it uses
less memory.

Every graphical object (anything that represents printed matter)
carries an SCM variable (called element_property_alist_), where
switches that allow specialized behavior can be stored.  Graphical
elements are created on the heap, and the alist_ uses
scm_[un]protect_object for interacting with GUILEs garbage collection.


PROBLEM:

During one run of Lilypond a lot of those Graphical objects get
created. One of my users regularly needs to process a orchestral score
that results in the creation of approximately 100,000 graphical
objects, and consequently 100,000 calls to scm_protect_object and
100,000 calls to scm_unprotect_object.  We noticed that performance of
Lilypond increased by approximately 100% when we commented out
destructors (that happened to call scm_unprotect_object)


ANALYSIS:

scm_[un]protect_object uses a linear list, with O(1) insertion and
O(n) deletion performance.  After these 100,000 objects are created,
we delete them in order of creation; this causes O(n^2) behavior on
the whole, which gets noticeable when n = 100,000.


SOLUTION (1st try) 

I contemplated some solutions,

1. The most straightforward solution is deleting the graphical
elements in opposite order, which will cause some more paging to disk,
(but that is not a big problem)

2. Writing a better scm_[un]protect_object

3. Using SMOBs to mark the alists using C++ code.


Although 1 is probably the best solution for now, it relies on the
implementation of scm_(un)protect, so I decided to try 2.  I wrote my
own set of protection functions that use binary trees for keeping
track of protected objects (code attached)

The result was quite disappointing: Lilypond became 200% slower when I
used this scheme for all SCMs that live on the heap within my program.

After some research, it turned out that the approach performs poorly,
because the trees are not balanced.  Presumably this is caused because
the to-be-protected cells are generated in a wrong order.  I tried to
fixup for this by garbling the bits of the SCMs around before doing
comparisons, but the result still is 50% slower (at best), so now I
remain a little confused:


QUESTIONS

1.  Would an improved version of scm_[un]protect_object be useful?  Is
there any interest in my code?

2.  If what would be the best approach for solving the problem I
found in my implementation?

  * There might be a stupid bug lurking.  Can you see it?

  * I could do some more byte swapping in the SCMs before determining
the ordering.  What would be an optimal value for SHIFT in my munge()
function?

  * I could use a different data structure (Red - black trees?)

  * I could occasionally call a function to balance my trees.



/**************************************************************************/

/*
  Layout of nodes:

  (key . (left_child . right_child))

  SCM_EOL is the nil-pointer (should use SCM_NIMP() ?)
 */

#define left_child(s) SCM_CADR((s))
#define right_child(s) SCM_CDDR((s))
#define key(s) SCM_CAR((s))

/*
  Garble pointers, to prevent unbalanced tree due to ordered inserts.
 */

unsigned int
munge (SCM s) 
{
  const int SHIFT = 18;
  return (unsigned int)(s << (32-SHIFT) | s >> SHIFT );
}

SCM
ly_new_bintree_node (SCM val)
{
  return gh_cons (val, gh_cons (SCM_EOL, SCM_EOL));
}


/*
  add VAL to TREE. TREE must be non-nil
 */
void
ly_addto_bintree (SCM *tree, SCM val)
{
  while(*tree != SCM_EOL)
    {
      if (munge (val) <= munge (key (*tree)))
	tree = &left_child (*tree);
      else
	tree = &right_child (*tree);
    }

  *tree = ly_new_bintree_node (val);
}


/*
  find the address of a node in the tree represented by *NODE with key VAL
 */
SCM  *
ly_find_in_bintree (SCM *node, SCM val)
{
  while (*node != SCM_EOL)
    {
      if (munge (val) < munge (key(*node) ))
	node = &left_child(*node);
      else if (munge (val) > munge (key (*node)))
	node = &right_child (*node);
      else
	return node;
    }
  return node;
}

void
ly_remove_from_bintree (SCM *node)
{
  SCM r = right_child  (*node);
  SCM l = left_child (*node);
  
  if (r == SCM_EOL)
    {
      *node = l;
    }
  else if (l == SCM_EOL)
    {
      *node = r;
    }
  else
    {
      /*deleting from binary trees.  See Knuth's TAOCP.
       */
      SCM *t = node;
      SCM *left_t = &left_child (*t);

      /*
	INV:  LEFT_T  is the left child of T
       */
      while (*left_t != SCM_EOL)
	{
	  t = left_t;
	  left_t = &left_child (*t);
	}

      /*
	POST: T is the leftmost right child of NODE which has no left child,

	leftchild (LASTT) == T
       */
      key(*node) = key(*t);
      *left_t = right_child (*t);
    }
}


static SCM protect_tree_root;

SCM
ly_protect_scm (SCM s)
{
  ly_addto_bintree (&protect_tree_root, s);
  return s;
}

SCM
ly_unprotect_scm (SCM s)
{
  SCM *to_remove = ly_find_in_bintree (&protect_tree_root, s);

  /*
    this shouldn't happen, according to me. But it does.
   */
  if (*to_remove != SCM_EOL)
    ly_remove_from_bintree (to_remove);
  return s;
}

void
ly_init_protection ()
{
  protect_tree_root = scm_protect_object (ly_new_bintree_node(SCM_EOL));
  key (protect_tree_root) = protect_tree_root;
}


int
ly_count_elements (SCM tree)
{
  if (tree == SCM_EOL)
    return 0;
  else
    return 1 + ly_count_elements (left_child (tree)) + ly_count_elements (right_child( tree));
}

int
ly_tree_depth (SCM tree)
{
  if (tree == SCM_EOL)
    return 0;
  else
    return 1 + (ly_tree_depth (left_child (tree)) >? ly_tree_depth (right_child(tree)));
}

void
ly_print_bintree (SCM node)
{
#ifndef NPRINT
  if (node == SCM_EOL)
    return;
  DOUT << "{val = " << key(node) << " \nleft = ";
  ly_print_bintree (left_child (node));
  DOUT << "\n right =";
  ly_print_bintree (right_child (node));
  DOUT << "}";
#endif
}


struct Imbalance { int imbalance; int total; };

Imbalance
ly_calc_imbalance (SCM node)
{
  Imbalance t;
  if (node == SCM_EOL)
    {
      t.imbalance = 0;
      t.total = 0;
      return t;
    }

  Imbalance l = ly_calc_imbalance (left_child (node));
  Imbalance r = ly_calc_imbalance (right_child (node));

  t.total = l.total + r.total + 1;
  int dif = l.total - r.total;
  if (dif < 0)
     dif = -dif;
  t.imbalance = l.imbalance + r.imbalance + dif;
  return t;
}


-- 

Han-Wen Nienhuys, hanwen@cs.uu.nl ** GNU LilyPond - The Music Typesetter 
      http://www.cs.uu.nl/people/hanwen/lilypond/index.html