/* vi: set ts=2 shiftwidth=2 expandtab:
 *
 * Copyright (C) 2003-2008  Simon Baldwin and Mark J. Tilford
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of version 2 of the GNU General Public License
 * as published by the Free Software Foundation.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
 * USA
 */

/*
 * Module notes:
 *
 * o ...
 */

#include <assert.h>
#include <stdlib.h>
#include <string.h>

#include "scare.h"
#include "scprotos.h"


/* Assorted definitions and constants. */
static const sc_uint PROP_MAGIC = 0x7927b2e0;
enum
{ PROP_GROW_INCREMENT = 32,
  MAX_INTEGER_KEY = 65535,
  NODE_POOL_CAPACITY = 512
};
static const sc_char NUL = '\0';

/* Properties trace flag. */
static sc_bool prop_trace = FALSE;


/*
 * Property tree node definition, uses a child list representation for
 * fast lookup on indexed nodes.  Name is a variable type, as is property,
 * which is also overloaded to contain the child count for internal nodes.
 */
typedef struct sc_prop_node_s
{
  sc_vartype_t name;
  sc_vartype_t property;

  struct sc_prop_node_s **child_list;
} sc_prop_node_t;
typedef sc_prop_node_t *sc_prop_noderef_t;

/*
 * Properties set structure.  This is a set of properties, on which the
 * properties functions operate (a properties "object").  Node string
 * names are held in a dictionary to help save space.  To avoid excessive
 * malloc'ing of nodes, new nodes are preallocated in pools.
 */
typedef struct sc_prop_set_s
{
  sc_uint magic;
  sc_int dictionary_length;
  sc_char **dictionary;
  sc_int node_pools_length;
  sc_prop_noderef_t *node_pools;
  sc_int node_count;
  sc_int orphans_length;
  void **orphans;
  sc_bool is_readonly;
  sc_prop_noderef_t root_node;
  sc_tafref_t taf;
} sc_prop_set_t;


/*
 * prop_is_valid()
 *
 * Return TRUE if pointer is a valid properties set, FALSE otherwise.
 */
static sc_bool
prop_is_valid (sc_prop_setref_t bundle)
{
  return bundle && bundle->magic == PROP_MAGIC;
}


/*
 * prop_round_up()
 *
 * Round up a count of elements to the next block of grow increments.
 */
static sc_int
prop_round_up (sc_int elements)
{
  sc_int extended;

  extended = elements + PROP_GROW_INCREMENT - 1;
  return (extended / PROP_GROW_INCREMENT) * PROP_GROW_INCREMENT;
}


/*
 * prop_ensure_capacity()
 *
 * Ensure that capacity exists in a growable array for a given number of
 * elements, growing if necessary.
 *
 * Some libc's allocate generously on realloc(), and some not.  Those that
 * don't will thrash badly if we realloc() on each grow, so here we try to
 * realloc() in blocks of elements, and thus need to realloc() much less
 * frequently.
 */
static void *
prop_ensure_capacity (void *array,
                      sc_int old_size, sc_int new_size, sc_int element_size)
{
  sc_int current, required;

  /*
   * See if there's any resize necessary, that is, does the new size round up
   * to a larger number of elements than the old size.
   */
  current = prop_round_up (old_size);
  required = prop_round_up (new_size);
  if (required > current)
    {
      sc_byte *new_array, *start_clearing;

      /* Grow array to the required size, and zero new elements. */
      new_array = sc_realloc (array, required * element_size);
      start_clearing = new_array + current * element_size;
      memset (start_clearing, 0, (required - current) * element_size);

      return new_array;
    }

  /* No resize necessary. */
  return array;
}


/*
 * prop_trim_capacity()
 *
 * Trim an array allocation back to the bare minimum required.  This will
 * "unblock" the allocations of prop_ensure_capacity().  Once trimmed,
 * the array cannot ever be grown safely again.
 */
static void *
prop_trim_capacity (void *array, sc_int size, sc_int element_size)
{
  if (prop_round_up (size) > size)
    return sc_realloc (array, size * element_size);
  else
    return array;
}


/*
 * prop_compare()
 *
 * String comparison routine for sorting and searching dictionary strings.
 * The function has return type "int" to match the libc implementations of
 * bsearch() and qsort().
 */
static int
prop_compare (const void *string1, const void *string2)
{
  return strcmp (*(sc_char *const *) string1, *(sc_char *const *) string2);
}


/*
 * prop_dictionary_lookup()
 *
 * Find a string in the dictionary.  If the string is not present, the
 * function will add it.  The function returns the string's address, if
 * either added or already present.  Any new dictionary entry will
 * contain a malloced copy of the string passed in.
 */
static const sc_char *
prop_dictionary_lookup (sc_prop_setref_t bundle, const sc_char *string)
{
  sc_char *dict_string;

  /*
   * Search the existing dictionary for the string.  Although not GNU libc,
   * some libc's loop or crash when given a list of zero length, so we need to
   * trap that here.
   */
  if (bundle->dictionary_length > 0)
    {
      const sc_char *const *dict_search;

      dict_search = bsearch (&string, bundle->dictionary,
                             bundle->dictionary_length,
                             sizeof (bundle->dictionary[0]), prop_compare);
      if (dict_search)
        return *dict_search;
    }

  /* Not found, so copy the string for dictionary insertion. */
  dict_string = sc_malloc (strlen (string) + 1);
  strcpy (dict_string, string);

  /* Extend the dictionary if necessary. */
  bundle->dictionary = prop_ensure_capacity (bundle->dictionary,
                                             bundle->dictionary_length,
                                             bundle->dictionary_length + 1,
                                             sizeof (bundle->dictionary[0]));

  /* Add the new entry to the end of the dictionary array, and sort. */
  bundle->dictionary[bundle->dictionary_length++] = dict_string;
  qsort (bundle->dictionary,
         bundle->dictionary_length,
         sizeof (bundle->dictionary[0]), prop_compare);

  /* Return the address of the new string. */
  return dict_string;
}


/*
 * prop_new_node()
 *
 * Return the address of the next free properties node from the node pool.
 * Using a pool gives a performance boost; the number of properties nodes
 * for even a small game is large, and preallocating pools avoids excessive
 * malloc's of small individual nodes.
 */
static sc_prop_noderef_t
prop_new_node (sc_prop_setref_t bundle)
{
  sc_int node_index;
  sc_prop_noderef_t node;

  /* See if we need to create a new node pool. */
  node_index = bundle->node_count % NODE_POOL_CAPACITY;
  if (node_index == 0)
    {
      sc_int required;

      /* Extend the node pools array if necessary. */
      bundle->node_pools = prop_ensure_capacity (bundle->node_pools,
                                                 bundle->node_pools_length,
                                                 bundle->node_pools_length + 1,
                                                 sizeof (bundle->
                                                         node_pools[0]));

      /* Create a new node pool, and increment the length. */
      required = NODE_POOL_CAPACITY * sizeof (*bundle->node_pools[0]);
      bundle->node_pools[bundle->node_pools_length] = sc_malloc (required);
      bundle->node_pools_length++;
    }

  /* Find the next node address, and increment the node counter. */
  node = bundle->node_pools[bundle->node_pools_length - 1] + node_index;
  bundle->node_count++;

  /* Return the new node. */
  return node;
}


/*
 * prop_find_child()
 *
 * Find a child node of the given parent whose name matches that passed in.
 */
static sc_prop_noderef_t
prop_find_child (sc_prop_noderef_t parent, sc_int type, sc_vartype_t name)
{
  /* See if this node has any children. */
  if (parent->child_list)
    {
      sc_int index_;
      sc_prop_noderef_t child;

      /* Do the lookup based on name type. */
      switch (type)
        {
        case PROP_KEY_INTEGER:
          /*
           * As with adding a child below, here we'll range-check an integer
           * key just to make sure nobody has any unreal expectations of us.
           */
          if (name.integer < 0)
            sc_fatal ("prop_find_child: integer key cannot be negative\n");
          else if (name.integer > MAX_INTEGER_KEY)
            sc_fatal ("prop_find_child: integer key is too large\n");

          /*
           * For integer lookups, return the child at the indexed offset
           * directly, provided it exists.
           */
          if (name.integer >= 0 && name.integer < parent->property.integer)
            {
              child = parent->child_list[name.integer];
              return child;
            }
          break;

        case PROP_KEY_STRING:
          /* Scan children for a string name match. */
          for (index_ = 0; index_ < parent->property.integer; index_++)
            {
              child = parent->child_list[index_];
              if (strcmp (child->name.string, name.string) == 0)
                break;
            }

          /* Return child if we found a match. */
          if (index_ < parent->property.integer)
            {
              /*
               * Before returning the child, try to improve future scans by
               * moving the matched entry to index_ 0 -- this gives a key set
               * sorted by recent usage, helpful as the same string key is
               * used repeatedly in loops.
               */
              if (index_ > 0)
                {
                  memmove (parent->child_list + 1,
                           parent->child_list, index_ * sizeof (child));
                  parent->child_list[0] = child;
                }
              return child;
            }
          break;

        default:
          sc_fatal ("prop_find_child: invalid key type\n");
        }
    }

  /* No matching child found. */
  return NULL;
}


/*
 * prop_add_child()
 *
 * Add a new child node to the given parent.  Return its reference.  Set
 * needs to be passed so that string names can be added to the dictionary.
 */
static sc_prop_noderef_t
prop_add_child (sc_prop_noderef_t parent,
                sc_int type, sc_vartype_t name, sc_prop_setref_t bundle)
{
  sc_prop_noderef_t child;

  /* Not possible if growable allocations have been trimmed. */
  if (bundle->is_readonly)
    sc_fatal ("prop_add_child: can't add to readonly properties\n");

  /* Create the new node. */
  child = prop_new_node (bundle);
  switch (type)
    {
    case PROP_KEY_INTEGER:
      child->name.integer = name.integer;
      break;
    case PROP_KEY_STRING:
      child->name.string = prop_dictionary_lookup (bundle, name.string);
      break;

    default:
      sc_fatal ("prop_add_child: invalid key type\n");
    }

  /* Initialize property and child list to visible nulls. */
  child->property.voidp = NULL;
  child->child_list = NULL;

  /* Make a brief check for obvious overwrites. */
  if (!parent->child_list && parent->property.voidp)
    sc_error ("prop_add_child: node overwritten, probable data loss\n");

  /* Add the child to the parent, position dependent on key type. */
  switch (type)
    {
    case PROP_KEY_INTEGER:
      /*
       * Range check on integer keys, must be >= 0 for direct indexing to work,
       * and we'll also apply a reasonableness constraint, to try to catch
       * errors where string pointers are passed in as integers, which would
       * otherwise lead to some extreme malloc() attempts.
       */
      if (name.integer < 0)
        sc_fatal ("prop_add_child: integer key cannot be negative\n");
      else if (name.integer > MAX_INTEGER_KEY)
        sc_fatal ("prop_add_child: integer key is too large\n");

      /* Resize the parent's child list if necessary. */
      parent->child_list = prop_ensure_capacity (parent->child_list,
                                                 parent->property.integer,
                                                 name.integer + 1,
                                                 sizeof (*parent->child_list));

      /* Update the child count if the new node increases it. */
      if (parent->property.integer <= name.integer)
        parent->property.integer = name.integer + 1;

      /* Store the child in its indexed list location. */
      parent->child_list[name.integer] = child;
      break;

    case PROP_KEY_STRING:
      /* Add a single entry to the child list, and resize. */
      parent->child_list = prop_ensure_capacity (parent->child_list,
                                                 parent->property.integer,
                                                 parent->property.integer + 1,
                                                 sizeof (*parent->child_list));

      /* Store the child at the end of the list. */
      parent->child_list[parent->property.integer++] = child;
      break;

    default:
      sc_fatal ("prop_add_child: invalid key type\n");
    }

  return child;
}


/*
 * prop_put()
 *
 * Add a property to a properties set.  Duplicate entries will replace
 * prior ones.
 *
 * Stores a value of variable type as a property.  The value type is one of
 * 'I', 'B', or 'S', for integer, boolean, and string values, held in the
 * first character of format.  The next two characters of format are "->",
 * and are syntactic sugar.  The remainder of format shows the key makeup,
 * with 'i' indicating integer, and 's' string key elements.  Example format:
 * "I->sssis", stores an integer, with a key composed of three strings, an
 * integer, and another string.
 */
void
prop_put (sc_prop_setref_t bundle, const sc_char *format,
          sc_vartype_t vt_value, const sc_vartype_t vt_key[])
{
  sc_prop_noderef_t node;
  sc_int index_;
  assert (prop_is_valid (bundle));

  /* Format check. */
  if (!format || format[0] == NUL
      || format[1] != '-' || format[2] != '>' || format[3] == NUL)
    sc_fatal ("prop_put: format error\n");

  /* Trace property put. */
  if (prop_trace)
    {
      sc_trace ("Property: put ");
      switch (format[0])
        {
        case PROP_STRING:
          sc_trace ("\"%s\"", vt_value.string);
          break;
        case PROP_INTEGER:
          sc_trace ("%ld", vt_value.integer);
          break;
        case PROP_BOOLEAN:
          sc_trace ("%s", vt_value.boolean ? "true" : "false");
          break;

        default:
          sc_trace ("%p [invalid type]", vt_value.voidp);
          break;
        }
      sc_trace (", key \"%s\" : ", format);
      for (index_ = 0; format[index_ + 3] != NUL; index_++)
        {
          sc_trace ("%s", index_ > 0 ? "," : "");
          switch (format[index_ + 3])
            {
            case PROP_KEY_STRING:
              sc_trace ("\"%s\"", vt_key[index_].string);
              break;
            case PROP_KEY_INTEGER:
              sc_trace ("%ld", vt_key[index_].integer);
              break;

            default:
              sc_trace ("%p [invalid type]", vt_key[index_].voidp);
              break;
            }
        }
      sc_trace ("\n");
    }

  /*
   * Iterate keys, finding matching child nodes at each level.  If no matching
   * child is found, insert one and continue.
   */
  node = bundle->root_node;
  for (index_ = 0; format[index_ + 3] != NUL; index_++)
    {
      sc_prop_noderef_t child;
      sc_int type;

      /*
       * Search this level for a name matching the key.  If found, advance
       * to that child node.  Otherwise, add the node to the tree, including
       * the set so that the dictionary can be extended.
       */
      type = format[index_ + 3];
      child = prop_find_child (node, type, vt_key[index_]);
      if (child)
        node = child;
      else
        node = prop_add_child (node, type, vt_key[index_], bundle);
    }

  /*
   * Ensure that we're not about to overwrite an internal node child count.
   */
  if (node->child_list)
    sc_fatal ("prop_put: overwrite of internal node\n");

  /* Set our properties in the final node. */
  switch (format[0])
    {
    case PROP_INTEGER:
      node->property.integer = vt_value.integer;
      break;
    case PROP_BOOLEAN:
      node->property.boolean = vt_value.boolean;
      break;
    case PROP_STRING:
      node->property.string = vt_value.string;
      break;

    default:
      sc_fatal ("prop_put: invalid property type\n");
    }
}


/*
 * prop_get()
 *
 * Retrieve a property from a properties set.  Format stuff as above, except
 * with "->" replaced with "<-".  Returns FALSE if no such property exists.
 */
sc_bool
prop_get (sc_prop_setref_t bundle, const sc_char *format,
          sc_vartype_t *vt_rvalue, const sc_vartype_t vt_key[])
{
  sc_prop_noderef_t node;
  sc_int index_;
  assert (prop_is_valid (bundle));

  /* Format check. */
  if (!format || format[0] == NUL
      || format[1] != '<' || format[2] != '-' || format[3] == NUL)
    sc_fatal ("prop_get: format error\n");

  /* Trace property get. */
  if (prop_trace)
    {
      sc_trace ("Property: get, key \"%s\" : ", format);
      for (index_ = 0; format[index_ + 3] != NUL; index_++)
        {
          sc_trace ("%s", index_ > 0 ? "," : "");
          switch (format[index_ + 3])
            {
            case PROP_KEY_STRING:
              sc_trace ("\"%s\"", vt_key[index_].string);
              break;
            case PROP_KEY_INTEGER:
              sc_trace ("%ld", vt_key[index_].integer);
              break;

            default:
              sc_trace ("%p [invalid type]", vt_key[index_].voidp);
              break;
            }
        }
      sc_trace ("\n");
    }

  /*
   * Iterate keys, finding matching child nodes at each level.  Stop if no
   * matching child is found.
   */
  node = bundle->root_node;
  for (index_ = 0; format[index_ + 3] != NUL; index_++)
    {
      sc_int type;

      /* Move node down to the matching child, NULL if no match. */
      type = format[index_ + 3 ];
      node = prop_find_child (node, type, vt_key[index_]);
      if (!node)
        break;
    }

  /* If key iteration halted because no child was found, return FALSE. */
  if (!node)
    {
      if (prop_trace)
        sc_trace ("Property: ...get FAILED\n");

      return FALSE;
    }

  /*
   * Enforce integer-only queries on internal nodes, since this is the only
   * type of query that makes sense -- any other type is probably a mistake.
   */
  if (node->child_list && format[0] != PROP_INTEGER)
    sc_fatal ("prop_get: only integer gets on internal nodes\n");

  /* Return the properties of the final node. */
  switch (format[0])
    {
    case PROP_INTEGER:
      vt_rvalue->integer = node->property.integer;
      break;
    case PROP_BOOLEAN:
      vt_rvalue->boolean = node->property.boolean;
      break;
    case PROP_STRING:
      vt_rvalue->string = node->property.string;
      break;

    default:
      sc_fatal ("prop_get: invalid property type\n");
    }

  /* Complete tracing property get. */
  if (prop_trace)
    {
      sc_trace ("Property: ...get returned : ");
      switch (format[0])
        {
        case PROP_STRING:
          sc_trace ("\"%s\"", vt_rvalue->string);
          break;
        case PROP_INTEGER:
          sc_trace ("%ld", vt_rvalue->integer);
          break;
        case PROP_BOOLEAN:
          sc_trace ("%s", vt_rvalue->boolean ? "true" : "false");
          break;

        default:
          sc_trace ("%p [invalid type]", vt_rvalue->voidp);
          break;
        }
      sc_trace ("\n");
    }
  return TRUE;
}


/*
 * prop_trim_node()
 * prop_solidify()
 *
 * Trim excess allocation from growable arrays, and fix the properties set
 * so that no further property insertions are allowed.
 */
static void
prop_trim_node (sc_prop_noderef_t node)
{
  /* End recursion on null or childless node. */
  if (node && node->child_list)
    {
      sc_int index_;

      /* Recursively trim allocation on children. */
      for (index_ = 0; index_ < node->property.integer; index_++)
        prop_trim_node (node->child_list[index_]);

      /* Trim allocation on this node. */
      node->child_list = prop_trim_capacity (node->child_list,
                                             node->property.integer,
                                             sizeof (*node->child_list));
    }
}

void
prop_solidify (sc_prop_setref_t bundle)
{
  assert (prop_is_valid (bundle));

  /*
   * Trim back the dictionary, orphans, pools array, and every internal tree
   * node.  The one thing _not_ to trim is the final node pool -- there are
   * references to nodes within it strewn all over the properties tree, and
   * it's a large job to try to find and update them; instead, we just live
   * with a little wasted heap memory.
   */
  bundle->dictionary = prop_trim_capacity (bundle->dictionary,
                                           bundle->dictionary_length,
                                           sizeof (bundle->dictionary[0]));
  bundle->node_pools = prop_trim_capacity (bundle->node_pools,
                                           bundle->node_pools_length,
                                           sizeof (bundle->node_pools[0]));
  bundle->orphans = prop_trim_capacity (bundle->orphans,
                                        bundle->orphans_length,
                                        sizeof (bundle->orphans[0]));
  prop_trim_node (bundle->root_node);

  /* Set the bundle so that no more properties can be added. */
  bundle->is_readonly = TRUE;
}


/*
 * prop_get_integer()
 * prop_get_boolean()
 * prop_get_string()
 *
 * Convenience functions to retrieve a property of a known type directly.
 * It is an error for the property not to exist on retrieval.
 */
sc_int
prop_get_integer (sc_prop_setref_t bundle,
                  const sc_char *format, const sc_vartype_t vt_key[])
{
  sc_vartype_t vt_rvalue;
  assert (format[0] == PROP_INTEGER);

  if (!prop_get (bundle, format, &vt_rvalue, vt_key))
    sc_fatal ("prop_get_integer: can't retrieve property\n");

  return vt_rvalue.integer;
}

sc_bool
prop_get_boolean (sc_prop_setref_t bundle,
                  const sc_char *format, const sc_vartype_t vt_key[])
{
  sc_vartype_t vt_rvalue;
  assert (format[0] == PROP_BOOLEAN);

  if (!prop_get (bundle, format, &vt_rvalue, vt_key))
    sc_fatal ("prop_get_boolean: can't retrieve property\n");

  return vt_rvalue.boolean;
}

const sc_char *
prop_get_string (sc_prop_setref_t bundle,
                 const sc_char *format, const sc_vartype_t vt_key[])
{
  sc_vartype_t vt_rvalue;
  assert (format[0] == PROP_STRING);

  if (!prop_get (bundle, format, &vt_rvalue, vt_key))
    sc_fatal ("prop_get_string: can't retrieve property\n");

  return vt_rvalue.string;
}


/*
 * prop_get_child_count()
 *
 * Convenience function to retrieve a count of child properties available
 * for a given property.  Returns zero if the property does not exist.
 */
sc_int
prop_get_child_count (sc_prop_setref_t bundle,
                      const sc_char *format, const sc_vartype_t vt_key[])
{
  sc_vartype_t vt_rvalue;
  assert (format[0] == PROP_INTEGER);

  if (!prop_get (bundle, format, &vt_rvalue, vt_key))
    return 0;

  /* Return overloaded integer property value, the child count. */
  return vt_rvalue.integer;
}


/*
 * prop_create_empty()
 *
 * Create a new, empty properties set, and return it.
 */
static sc_prop_setref_t
prop_create_empty (void)
{
  sc_prop_setref_t bundle;

  /* Create a new, empty set. */
  bundle = sc_malloc (sizeof (*bundle));
  bundle->magic = PROP_MAGIC;

  /* Begin with an empty strings dictionary. */
  bundle->dictionary_length = 0;
  bundle->dictionary = NULL;

  /* Begin with no allocated node pools. */
  bundle->node_pools_length = 0;
  bundle->node_pools = NULL;
  bundle->node_count = 0;

  /* Begin with no adopted addresses. */
  bundle->orphans_length = 0;
  bundle->orphans = NULL;

  /* Leave open for insertions. */
  bundle->is_readonly = FALSE;

  /*
   * Start the set off with a root node.  This will also kick off node pools,
   * ensuring that every set has at least one node and one allocated pool.
   */
  bundle->root_node = prop_new_node (bundle);
  bundle->root_node->child_list = NULL;
  bundle->root_node->name.string = "ROOT";
  bundle->root_node->property.voidp = NULL;

  /* No taf is yet connected with this set. */
  bundle->taf = NULL;

  return bundle;
}


/*
 * prop_destroy_child_list()
 * prop_destroy()
 *
 * Free set memory, and destroy a properties set structure.
 */
static void
prop_destroy_child_list (sc_prop_noderef_t node)
{
  /* End recursion on null or childless node. */
  if (node && node->child_list)
    {
      sc_int index_;

      /* Recursively destroy the children's child lists. */
      for (index_ = 0; index_ < node->property.integer; index_++)
        prop_destroy_child_list (node->child_list[index_]);

      /* Free our own child list. */
      sc_free (node->child_list);
    }
}

void
prop_destroy (sc_prop_setref_t bundle)
{
  sc_int index_;
  assert (prop_is_valid (bundle));

  /* Destroy the dictionary, and free it. */
  for (index_ = 0; index_ < bundle->dictionary_length; index_++)
    sc_free (bundle->dictionary[index_]);
  bundle->dictionary_length = 0;
  sc_free (bundle->dictionary);
  bundle->dictionary = NULL;

  /* Free adopted addresses. */
  for (index_ = 0; index_ < bundle->orphans_length; index_++)
    sc_free (bundle->orphans[index_]);
  bundle->orphans_length = 0;
  sc_free (bundle->orphans);
  bundle->orphans = NULL;

  /* Walk the tree, destroying the child list for each node found. */
  prop_destroy_child_list (bundle->root_node);
  bundle->root_node = NULL;

  /* Destroy each node pool. */
  for (index_ = 0; index_ < bundle->node_pools_length; index_++)
    sc_free (bundle->node_pools[index_]);
  bundle->node_pools_length = 0;
  sc_free (bundle->node_pools);
  bundle->node_pools = NULL;

  /* Destroy any taf associated with the bundle. */
  if (bundle->taf)
    taf_destroy (bundle->taf);

  /* Poison and free the bundle. */
  memset (bundle, 0xaa, sizeof (*bundle));
  sc_free (bundle);
}


/*
 * prop_create()
 *
 * Create a new properties set based on a taf, and return it.
 */
sc_prop_setref_t
prop_create (const sc_tafref_t taf)
{
  sc_prop_setref_t bundle;

  /* Create a new, empty set. */
  bundle = prop_create_empty ();

  /* Populate it with data parsed from the taf file. */
  if (!parse_game (taf, bundle))
    {
      prop_destroy (bundle);
      return NULL;
    }

  /* Note the taf for destruction later, and return the new set. */
  bundle->taf = taf;
  return bundle;
}


/*
 * prop_adopt()
 *
 * Adopt a memory address for free'ing on destroy.
 */
void
prop_adopt (sc_prop_setref_t bundle, void *addr)
{
  assert (prop_is_valid (bundle));

  /* Extend the orphans array if necessary. */
  bundle->orphans = prop_ensure_capacity (bundle->orphans,
                                          bundle->orphans_length,
                                          bundle->orphans_length + 1,
                                          sizeof (bundle->orphans[0]));

  /* Add the new address to the end of the array. */
  bundle->orphans[bundle->orphans_length++] = addr;
}


/*
 * prop_debug_is_dictionary_string()
 * prop_debug_dump_node()
 * prop_debug_dump()
 *
 * Print out a complete properties set.
 */
static sc_bool
prop_debug_is_dictionary_string (sc_prop_setref_t bundle, const void *pointer)
{
  const sc_char *const pointer_ = pointer;
  sc_int index_;

  /* Compare by pointer directly, not by string value comparisons. */
  for (index_ = 0; index_ < bundle->dictionary_length; index_++)
    {
      if (bundle->dictionary[index_] == pointer_)
        return TRUE;
    }

  return FALSE;
}

static void
prop_debug_dump_node (sc_prop_setref_t bundle,
                      sc_int depth, sc_int child_index, sc_prop_noderef_t node)
{
  sc_int index_;

  /* Write node preamble, indented two spaces for each depth count. */
  for (index_ = 0; index_ < depth; index_++)
    sc_trace ("  ");
  sc_trace ("%ld : %p", child_index, (void *) node);

  /* Write node, or just a newline if none. */
  if (node)
    {
      /* Print out the node's key, as hex and either string or decimal. */
      sc_trace (", name %p", node->name.voidp);
      if (node != bundle->root_node)
        {
          if (prop_debug_is_dictionary_string (bundle, node->name.string))
            sc_trace (" \"%s\"", node->name.string);
          else
            sc_trace (" %ld", node->name.integer);
        }

      if (node->child_list)
        {
          /* Recursively dump children. */
          sc_trace (", child count %ld\n", node->property.integer);
          for (index_ = 0; index_ < node->property.integer; index_++)
            {
              prop_debug_dump_node (bundle, depth + 1,
                                    index_, node->child_list[index_]);
            }
        }
      else
        {
          /* Print out the node's property, again hex and string or decimal. */
          sc_trace (", property %p", node->property.voidp);
          if (taf_debug_is_taf_string (bundle->taf, node->property.string))
            sc_trace (" \"%s\"\n", node->property.string);
          else
            sc_trace (" %ld\n", node->property.integer);
        }
    }
  else
    sc_trace ("\n");
}

void
prop_debug_dump (sc_prop_setref_t bundle)
{
  sc_int index_;
  assert (prop_is_valid (bundle));

  /* Dump complete structure. */
  sc_trace ("Property: debug dump follows...\n");
  sc_trace ("bundle->is_readonly = %s\n",
            bundle->is_readonly ? "true" : "false");
  sc_trace ("bundle->dictionary_length = %ld\n", bundle->dictionary_length);

  sc_trace ("bundle->dictionary =\n");
  for (index_ = 0; index_ < bundle->dictionary_length; index_++)
    {
      sc_trace ("%3ld : %p \"%s\"\n", index_,
                bundle->dictionary[index_], bundle->dictionary[index_]);
    }

  sc_trace ("bundle->node_pools_length = %ld\n", bundle->node_pools_length);

  sc_trace ("bundle->node_pools =\n");
  for (index_ = 0; index_ < bundle->node_pools_length; index_++)
    sc_trace ("%3ld : %p\n", index_, (void *) bundle->node_pools[index_]);

  sc_trace ("bundle->node_count = %ld\n", bundle->node_count);
  sc_trace ("bundle->root_node = {\n");
  prop_debug_dump_node (bundle, 0, 0, bundle->root_node);
  sc_trace ("}\nbundle->taf = %p\n", (void *) bundle->taf);
}


/*
 * prop_debug_trace()
 *
 * Set property tracing on/off.
 */
void
prop_debug_trace (sc_bool flag)
{
  prop_trace = flag;
}
