OS/2 Shareware BBS: 5 Edit/05-Edit.zip/me34src.zip/me3/mc/oman.c

C/C++ Source or Header | 1995-01-14 | 26KB | 1,098 lines

/* oman.c:  object management
 * C Durland  5/91
 */

/* Copyright 1990, 1991, 1992 Craig Durland
 *   Distributed under the terms of the GNU General Public License.
 *   Distributed "as is", without warranties of any kind, but comments,
 *     suggestions and bug reports are welcome.
 */

#if 0
cc -DTEST -g oman.c -o oman -I$HOME/c/util $HOME/c/util/util.a /d2/lsdmem/usr/local/lib/liblsdmemd.a /d2/lsdmem/usr/local/lib/liblsdtrap.a
#endif

static char what[] = "@(#)OMan (Object Manager) v1.0 12/27/91";

#if 0
first_pool -> object_pool_1 -> object_pool_2 -> ... -> NULL

object_pool:  object_1 -> object_2 -> object_3 -> ... -> NULL

Atom objects:  number, unknown
Atom objects with extra storage:  string
other: list

string: dstring
list:  list_header -> list_element_1 -> list_element_2 -> ... -> NULL

#endif

#include <const.h>
#include <dstring.h>
#include "oman.h"

extern char *malloc(), *calloc();

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

/* Object types I know about: */
#define LIST        9
#define STRING        8
#define NUMBER        3
#define UNKNOWN        4

#define MARKED        0x80



ObjectPool *first_pool = NULL;

static void free_objects();

/* ******************************************************************** */
/* ****************** Garbage Collection ****************************** */
/* ******************************************************************** */

static Object *tmp_list;
static ObjectPool *tmp_pool;

static void sweep_objects();

    /* Garbage collect a object pool.
     * Call the pools object marker routine.  That routine calls
     *   OMgc_mark_object() to mark all objects that are dead or to mark
     *   objects that are live.  Then free all dead objects.
     * Pool not collected if there is no marker routine - assumes all
     *   objects are immortal.
     * The marker routine returns:
     *   0 : Don't collect this pool.
     *   1 : All objects marked are alive.
     *   2 : All objects marked are dead.
     * Input:
     *   pool:  Pool to garbage collect
     *   marked:
     *     0:  Pool not marked, do the normal sweep.
     *     1:  Pool has all live objects marked.
     *     2:  Pool has all dead objects marked.
     */
void OMgc_pool(pool,marked) ObjectPool *pool;
{
  int s;

  if (marked != 0) s = marked;
  else
  {
    tmp_list = NULL;
    tmp_pool = pool;

    if (!pool->gc_marker) return;        /* Can't collect this pool! */

    if (0 == (s = (*pool->gc_marker)())) return;  /* Don't collect this pool */
  }

  sweep_objects(pool, (s == 1));
}

    /* Mark an object in preparation for the sweep part of the Garbage
     *   Collection.
     * Input:  pointer to an object in the pool current being garbage
     *   collected.
     */
void OMgc_mark_object(object) Object *object;
{
  if (!object) return;    /* Can happen with (uninitialized) object tables */

  object->type |= MARKED;
}

OMin_pool(pool, object) ObjectPool *pool; Object *object;
{
  Object *ptr;

  for (ptr = pool->first_object; ptr; ptr = ptr->next_object)
    if (ptr == object) return TRUE;

  return FALSE;
}


    /* Coalesce all marked objects in a pool.  Remove and free the dead ones.
     */
static void sweep_objects(pool,marked_objects_are_live) ObjectPool *pool;
{
#if 0
  Object *ptr, *qtr, *last_live, foo, *dead;

  dead = NULL;

  foo.next_object = ptr = pool->first_object;
  last_live = &foo;

  for ( ; ptr; ptr = qtr)
  {
    qtr = ptr->next_object;
    if (ptr->type & MARKED)        /* save this object */
    {
      ptr->type &= ~MARKED;
      last_live = ptr;
    }
    else                /* dead object */
    {
      last_live->next_object = qtr;    /* unlink dead object */
    /* !!! should just call free_object(ptr) */
      ptr->next_object = dead;
      dead = ptr;
    }
  }

  pool->first_object = foo.next_object;
  free_objects(dead);

#else

  Object *ptr, *qtr, *marked_list, *unmarked_list;

  marked_list = unmarked_list = NULL;
  for (ptr = pool->first_object; ptr; ptr = qtr)
  {
    qtr = ptr->next_object;
    if (ptr->type & MARKED)
    {
      ptr->type &= ~MARKED;
      ptr->next_object = marked_list;
      marked_list = ptr;
    }
    else
    {
      ptr->next_object = unmarked_list;
      unmarked_list = ptr;
    }
  }

  if (marked_objects_are_live)
  {
    pool->first_object = marked_list;
    free_objects(unmarked_list);
  }
  else
  {
    pool->first_object = unmarked_list;
    free_objects(marked_list);
  }

#endif
}

    /* Garbage collect all pools */
void OMgc_the_world()
{
  ObjectPool *pool;

  for (pool = first_pool; pool; pool = pool->next_pool) OMgc_pool(pool, 0);
}

/* ******************************************************************** */
/* ********************** Object Pool Management ********************** */
/* ******************************************************************** */

    /* Allocate an object pool.
     * Returns:
     *   Pointer to a pool
     *   NULL if no memory
     */
ObjectPool *OMcreate_object_pool(gc_marker) pfi gc_marker;
{
  ObjectPool *pool;

  if (!(pool = (ObjectPool *)malloc(sizeof(ObjectPool))))
  {
    OMgc_the_world();
    if (!(pool = (ObjectPool *)malloc(sizeof(ObjectPool)))) return NULL;
  }

    /* init the pool */
  pool->next_pool = first_pool;
  first_pool = pool;

  pool->first_object = NULL;
  pool->gc_marker = gc_marker;

  return pool;
}

    /* Free a pool and all its objects.
     * WARNING:  If not a valid pool, infinite loop city!
     */
void OMfree_object_pool(op) void *op;
{
  ObjectPool *pool = op, *ptr, *drag;

  free_objects(pool->first_object);

  for (drag = NULL, ptr = first_pool; ptr; ptr = ptr->next_pool)
  {
    if (ptr == pool) break;
    drag = ptr;
  }
  if (drag == NULL)        /* freeing first pool */
  {
    first_pool = ptr->next_pool;
  }
  else
  {
    drag->next_pool = ptr->next_pool;
  }
  free((char *)pool);
}

/* ******************************************************************** */
/* ************************ Object Management ************************* */
/* ******************************************************************** */

    /* Allocate an object.
     * Input:
     *   object_pool:  Pointer to object pool object is to be allocated in.
     *     If NULL, the allocated object is not part of any pool and thus
     *     can't be garbage collected unless you add it to a list.
     *   object_type:  Type of object to allocate.  If an unknown type, ???
     *   object_size:  Only used if object_type is unknown.  In that case,
     *     pass in sizeof(YourObject).
     * Returns:
     *   ptr  : Pointer to the object
     *   NULL : No memory
     * Notes:
     *   If malloc() fails, all pools are garbage collected and the malloc()
     *     is retried.
     */
Object *OMcreate_object(object_pool, object_type, object_size)
  ObjectPool *object_pool; int object_type, object_size;
{
  int size;
  Object *ptr;

  switch(object_type)
  {
    case NUMBER:  size = sizeof(NumberObject);    break;
    case LIST:    size = sizeof(ListObject);    break;
    case STRING:  size = sizeof(StringObject);    break;
    default:      size = object_size;        break;
  }

  if (!(ptr = (Object *)malloc(size)))
  {
    OMgc_the_world();
    if (!(ptr = (Object *)malloc(size))) return NULL;
  }

  ptr->type = object_type;

  if (object_pool)
  {
    ptr->next_object = object_pool->first_object;
    object_pool->first_object = ptr;
  }
  else ptr->next_object = NULL;        /* no pool, create a loner */


    /* initialize the new object */
  switch (object_type)
  {
    case STRING:
    {
      dString *ds = &((StringObject *)ptr)->string;
      init_dString(ds);
      break;
    }
    case LIST:
      ((ListObject *)ptr)->elements = NULL;
      break;
    case NUMBER:
      ((NumberObject *)ptr)->number = 0;
      break;
    default: /* ??? call unknown initer or let caller take care of it? */
      break;
  }

  return ptr;
}

static void add_object_to_pool(pool, object)
  ObjectPool *pool; Object *object;
{
  if (pool)
  {
    object->next_object = pool->first_object;
    pool->first_object = object;
  }
}

static void free_objects(object) Object *object;
{
  Object *ptr, *qtr;

  for (ptr = object; ptr; ptr = qtr)
  {
    qtr = ptr->next_object;
    switch(ptr->type)
    {
      case LIST:
        free_objects(((ListObject *)ptr)->elements);
    break;
      case STRING:
      {
    dString *ds = &((StringObject *)ptr)->string;
    free_dString(ds);
        break;
      }
    }
    free((char *)ptr);
  }
}

    /*
     * Input:
     *   object_pool:  The pool to duplicate the object in.  If NULL, the
     *       new object is not stuck in a pool.  Be sure you keep track
     *       of it because it can't be GC'd unless you put it into a pool.
     *   object:  the object to be dulicated.
     * Returns:
     *   Pointer to the duplicated object.  Duplicatation is done by
     *     creating copies.
     *   NULL if run out of memory.
     * Notes:
     *   Does not create garbage ie a GC after this routine will not find
     *     anything to reclaim.
     *   I don't put the new object in to the pool until after I copy all
     *     the data into it.  This makes error recovery easier.
     */
Object *OMdup_object(object_pool, object)
  ObjectPool *object_pool;
  Object *object;
{
  Object *new;

  if (!(new = OMcreate_object((ObjectPool *)NULL, object->type, 0)))
    return NULL;

    /* copy object */
  switch (object->type)
  {
    case NUMBER:
      ((NumberObject *)new)->number =
     ((NumberObject *)object)->number;
      break;
    case STRING:
    {
      char *ptr =        ((StringObject *)object)->string.string;
      dString *new_ds = &((StringObject *)new)->string;
      if (!set_dString(new_ds, ptr))
      {
    free_objects(new);
    return NULL;
      }
      break;
    }
    case LIST:
    {
      ListObject *list;
      Object new_list, *element, *new_element, *ptr;

      list = (ListObject *)object;
      ptr = &new_list;
      for (element = list->elements; element; element = element->next_object)
      {
    if (!(new_element = OMdup_object((ObjectPool *)NULL, element)))
    {
      ptr->next_object = NULL; free_objects(new_list.next_object);
      free_objects(new);
      return NULL;
    }
    ptr->next_object = new_element;
    ptr = new_element;
      }
      ptr->next_object = NULL;
      ((ListObject *)new)->elements = new_list.next_object;

      break;
    }
    case UNKNOWN: /* ??? */
      break;
  }

  add_object_to_pool(object_pool, new);

  return new;
}

/* ******************************************************************** */
/* ******************* Object Fiddling ******************************** */
/* ******************************************************************** */

#ifdef __STDC__

#include <stdarg.h>
#define VA_START va_start

#else    /* __STDC__ */

#include <varargs.h>
#define VA_START(a,b) va_start(a)

#endif

#if 0

OMget_object(object) Object *object;
{
  switch(object_type)
  {
    case NUMBER:  return ((NumberObject *)object)->number;
    case UNKNOWN:
    case LIST:
    case STRING:
  }
}
#endif

    /* Copy one object into another.
     * Input:
     * Returns:
     * Notes:
     *   If run out of memory, object is likely cleared ie it loses its
     *     orginal contents.  It is still a valid object.
     *   No garbage is generated.
     */
/* ??? would be nice to have a OSTRING and STRING */
/*VARARGS2*/
#ifdef __STDC__
OMset_object(Object *object, int type, ...)
#else
OMset_object(object, type, va_alist) Object *object; int type; va_dcl
#endif
{
  int s = TRUE;
  va_list varptr;

  VA_START(varptr,type);

  switch(type)
  {
    default:  return FALSE;
    case NUMBER:
      ((NumberObject *)object)->number = va_arg(varptr, long int);
      break;
    case LIST:
    {
      ListObject *list, *new, *data;

      list = (ListObject *)object;
      data = va_arg(varptr, ListObject *);

      free_objects(list->elements);    /* free garbage-to-be */

      new = (ListObject *)OMdup_object((ObjectPool *)NULL, data);
      if (!new) { s = FALSE; break; }

      list->elements = new->elements;

        /* free garbage */
      new->elements = NULL; free_objects(new);

      break;
    }
    case STRING:
    {
      char *ptr;
      dString *ds = &((StringObject *)object)->string;

      ptr = va_arg(varptr, char *);
      s = set_dString(ds,ptr);
      break;
    }
  }

  va_end(varptr);

  return s;
}

/* ******************************************************************** */
/* *********************** List/String Fiddling *********************** */
/* ******************************************************************** */

    /*
     * (length-of foo):  number of objects in foo.
     * (length-of []) => 0.
     * ??? if foo is an atom, return sizeof(foo)????
     */
OMlength_of(object) Object *object;
{
  switch(object->type)
  {
    case LIST:
    {
      int n;
      ListObject *list = (ListObject *)object;
      Object *ptr;

      for (n = 0, ptr = list->elements; ptr; ptr = ptr->next_object) n++;
      return n;
    }
    case STRING:
    {
      StringObject *string = (StringObject *)object;

      return strlen(string->string.string);
    }
  }
  return 0;        /* default */
}


    /* Insert a copy of an object into a list or string.
     * The first element of a list is 0.
     * To prepend, insert after element -1.
     * If n > (length object), append.
     * object_to_add is duplicated and the duplicate is inserted.
     * Input:
     *   object:  list or string.
     *   n:  object_to_add is inserted AFTER the nth element of object.
     *   object_to_add:  the same type as object.
     * Returns:
     *   TRUE:  Everything went as expected.
     *   FALSE: type mismatch or out of memory.
     */
OMinsert_object(object,n,object_to_add) Object *object, *object_to_add;
{
  switch(object->type)
  {
    default: return FALSE;
    case LIST:
    {
      int a;
      ListObject *list;
      Object *ptr, *drag, *new;

      list = (ListObject *)object;

        /* find element n */
      if (n < 0) ptr = NULL;        /* prepend */
      else
      {
    for (a = n, drag = NULL, ptr = list->elements; ptr;
         ptr = ptr->next_object)
    {
      if (a-- <= 0) break;
      drag = ptr;
    }
    if (!ptr) ptr = drag;        /* append to object */
      }

      new = OMdup_object((ObjectPool *)NULL,object_to_add);
      if (!new) return FALSE;

        /* link in new after ptr */
      if (!ptr)
      {
    new->next_object = list->elements;
    list->elements = new;
      }
      else
      {
    new->next_object = ptr->next_object;
    ptr->next_object = new;
      }

      break;
    }
    case STRING:
    {
      char *p, *q, *c1, *c2;
      dString *ds;
      int a,b,c,x;

      if (object_to_add->type != STRING) return FALSE;

      ds = &((StringObject *)object)->string;

      p = ds->string;
      q = ((StringObject *)object_to_add)->string.string;

      a = strlen(p);
      b = strlen(q);
      x = a + b;

      if (!pad_dString(ds,x)) return FALSE;    /* make result big enough */
      p = ds->string;

      n = imax(-1,n);
      n = imin(a-1,n);
    /* open hole at p+n, b chars wide */
      c1 = p + a; c2 = p + a + b; c = a - n;    /* copy the '\0' */
      while (c--) *c2-- = *c1--;
      strncpy(p + n +1, q, b);

      break;
    }
  }
  /* NOTREACHED */
}

    /*
     * Output:
     *   n in [0, len]
     *   z in [0, len]
     * Notes:
     *   !!! This is not very robust!  All kinds of cases don't work as
     *     expected!
     */
void OMnz_magic(len, pn,pz) int len, *pn, *pz;
{
  int n = *pn, z = *pz;

  if (n < 0)   n += len;   if (z < 0)   z += len;
  if (n < 0)   n  = 0;       if (z < 0)   z  = 0;
  if (n > len) n  = len;   if (z > len) z  = len;

  *pn = n; *pz = z;
}

    /*
     * Copy elements from a list and use them to create a new list.
     * Restrictions:
     *   Only works for strings or lists.
     * Input:
     *   pool:  where to put the returned object(s).
     *   object:  list/string to copy elements from.
     *   n: first element to copy (0 is the first element of a list).
     *   z: number of objects to copy.
     * Returns:
     *   Pointer to a object that holds the result.  Returned object is of
     *     the same type as object.
     *   NULL if out of memory or wrong object type.
     * Notes:
     *   If (z <= 0) or (n > (length-of object)) or (foo == []), returns [].
     *   If ask for more elements than can get, return as much as can.
     *   (extract-items "123" 1 1) => "2", (n-items "123" 1 2) => "23"
     *   (extract-items [] n z) => []
     */
Object *OMextract_elements(pool,object,n,z) ObjectPool *pool; Object *object;
{
  int len, type;
  Object *result;

  type = object->type;
  if (type != STRING && type != LIST) return NULL;

  if (!(result = OMcreate_object((ObjectPool *)NULL,type,0))) return NULL;

  OMnz_magic(len = OMlength_of(object), &n,&z);

  switch(object->type)
  {
    case LIST:
    {
      int a;
      ListObject *list;
      Object *ptr;

      list = (ListObject *)object;

      if (n == len) break;    /* list not long enough, return empty list */

        /* find element n */
      for (a = n, ptr = list->elements; a--; ptr = ptr->next_object)  ;

        /* copy and append z elements of object to result */
      a = z;    /* a >= max len of result */
      for (; ptr && z--; ptr = ptr->next_object)
      {
    if (!OMinsert_object(result,a,ptr))    /* append a copy of object */
    {
      free_objects(result);
      return NULL;
    }
      }

      break;
    }
    case STRING:            /* substr string pos z */
    {
      char *p, *q;
      dString *ds;
      int x;
      StringObject *string;

      string = (StringObject *)object;
      ds = &((StringObject *)result)->string;

      x = imin(len - n, z);

      if (!pad_dString(ds,x))         /* make result big enough */
      {
    free_objects(result);
    return NULL;
      }
      p = string->string.string;
      q = ds->string;
      strncpy(q, p+n, x);
      q[x] = '\0';

      break;
    }
  }

  add_object_to_pool(pool, result);

  return result;
}

    /* Copy an element from a list or string and atomize it.
     * Restrictions:
     *   Only works for strings or lists.
     * Input:
     *   pool:  where to put the returned object.
     *   object:  list/string to copy element from.
     *   n: first element to copy (0 is the first element of a list).
     * Returns:
     *   Pointer to a object that holds the result.
     *   NULL if out of memory or wrong object type.
     * Notes:
     *   No garbage generated.
     */
Object *OMnth_element(pool,object,n) ObjectPool *pool; Object *object;
{
  int len, type, z;
  ListObject *list;
  Object *ptr;

  type = object->type;

  if (type == STRING) return OMextract_elements(pool,object,n,1);

  if (type != LIST) return NULL;

  z = 1;
  OMnz_magic(len = OMlength_of(object), &n,&z);

    /* we now know we have a list */

  if (n == len)        /* list not long enough, return empty list */
    return OMcreate_object(pool,LIST,0);

  list = (ListObject *)object;

        /* find element n */
  for (ptr = list->elements; n--; ptr = ptr->next_object)  ;

  return OMdup_object(pool, ptr);        /* atomize element */
}

    /* Remove elements from a list or string.
     * Input:
     *   object:  object to remove stuff from.  Must be string or list.
     *   n: first element to remove.  0 is the first element of a list.
     *   z: number of elements to remove.
     * Returns:
     *   TRUE:  Everything went as expected.
     *   FALSE: type mismatch.
     * Notes:
     *   If (n >= (length object)) no-op
     *   If z goes off the end, stop there.
     *   ???If (z <= 0) no-op
     *   If (z <= 0) remove -z elements from end of list.  ie z == -2 means
     *     remove last 2 elements.
     *   (remove-items [] n [z]):  [].
     *   No garbage generated.
     *   ??? return the removed elements?
     */
int OMremove_items(object,n,z) Object *object;
{
  switch(object->type)
  {
    default:  return FALSE;
    case LIST:
    {
      int a;
      ListObject *list = (ListObject *)object;
      Object *first, *last, *drag, *drag1;

    /* !!! This stuff isn't very robust - should use nz_magic() and do a
     * bit more checking.
     */

        /* find first element to free */
      drag = NULL;
      for (a = n, first = list->elements; first; first = first->next_object)
      {
        if (a-- == 0) break;
    drag = first;
      }
      if (!first) break;        /* list not long enough */

        /* find last element to free */
      for (a = z, last = first; last; last = last->next_object)
      {
    if (--a == 0) break;
    drag1 = last;
      }
      if (last == NULL) last = drag1;

        /* link elements out of list */
      if (drag == NULL) list->elements = last->next_object;
      else        drag->next_object = last->next_object;

        /* free dead elements: Won't be GCed 'cause not "real" objects */
      last->next_object = NULL;
      free_objects(first);

      break;
    }
    case STRING:
    {
      char *p, *q;
      int len, x;
      StringObject *string = (StringObject *)object;

      OMnz_magic(len = OMlength_of(object), &n,&z);

    /* Calc how many characters need to be moved from the end of the
     *   string (if any) to cover the removed characters.
     */
      x = imin(len, n + z);

      p = &string->string.string[n];
      q = &string->string.string[x];

      n = len - x;

      while (n--) *p++ = *q++;
      *p = '\0';

      break;
    }
  }
  return TRUE;
}


#ifdef TEST
/* ******************************************************************** */
/* ******************************* TEST ******************************* */
/* ******************************************************************** */

ObjectPool *pool;
Object *object = NULL, *frotz = NULL, *save[10];

int sweeper()
{
  int j;

  if (object) OMgc_mark_object(object);
  if (frotz)  OMgc_mark_object(frotz);
  for (j = 10; j--; ) OMgc_mark_object(save[j]);

  return TRUE;
}

static void print_object(prefix,object) char *prefix; Object *object;
{
  printf("%s",prefix);
  switch(object->type)
  {
    case STRING:
    printf("\"%s\"\n",((StringObject *)object)->string.string); break;
    case NUMBER: printf("%d\n",((NumberObject *)object)->number); break;
    case LIST: printf("LIST\n"); break;
    default: printf("????\n");
  }
}


pretty_print_object(object) Object *object;
{
  static char buf[100];
  static int level = 0;

  buf[level] = '\0';

  print_object(buf,object);

  level += 2;
  strcat(buf,"  ");

  if (object->type == LIST)
  {
    ListObject *list = (ListObject *)object;
    Object *element;

    for (element = list->elements; element; element = element->next_object)
      pretty_print_object(element);
  }

  level -= 2;
}

main()
{
  char buf[100];

  if (!(pool = OMcreate_object_pool(sweeper)))
  {
    printf("No memory at all!!\n");
    exit(1);
  }

  while (TRUE)
  {
    printf("Command:  Add-to, Create, Extract, Gc, Length, Print, Set, Remove, Quit: ");
    gets(buf);
    switch(*buf)
    {
      case 'q':  goto done;
      case 'D':  if (object) OMdup_object(pool,object); break;
      case '+':            /* jam object to frotz */
        if (!object) { printf("Need a object!\n"); break; }
    frotz = object;
    object = NULL;
    break;
      case 'S':         /* Swap frotz and object */
      {
    Object *tmp;

    if (!object || !frotz) { printf("Need frotz and object!\n"); break; }
    tmp = frotz;
    frotz = object;
    object = (Object *)tmp;
    break;
      }
      case '1':
      case '2':
      case '3':
      case '4':
      case '5':
      {
    int n;

    n = *buf - '0';
    save[n] = object;
    break;
      }
      case '-':
      {
    int n;

    printf("Restore #");
    gets(buf); n = atoi(buf);
    if (n < 0 || n > 5) { printf("Out of range!\n"); break; }
    object = save[n];
    break;
      }
      case 'c':            /* create object */
      {
    int type, t, n = 0;

    printf("Object type:  list (%d), string(%d), number(%d): ",
          LIST,STRING,NUMBER);
    gets(buf); type = atoi(buf);
    if (type != LIST && type != NUMBER && type != STRING)
      { printf("Bad type!\n"); break; }
    if (!(object = OMcreate_object(pool,type,n)))
    {
      printf("No memory to create object!\n");
      break;
    }
    break;
      }
      case 'a':            /* Add-to */
      {
    /* add object to frotz */
    int n;

    if (!object || !frotz) { printf("Need a list and a object!\n"); break; }
    printf("Insert object at n: ");
    gets(buf); n = atoi(buf);
    if (!OMinsert_object(frotz,n,object)) printf("Opps\n");
    break;
      }
      case 'g':            /* garbage collect */
    OMgc_the_world(); break;
      case 'p':            /* print pool */
      {
    int j;
    Object *ptr;

    if (frotz)  { printf("frotz:\n");  pretty_print_object(frotz);  }
    if (object) { printf("object:\n"); pretty_print_object(object); }
    for (j = 0; j < 10; j++)
      if (save[j])
      {
        printf("Save[%d]:\n",j); pretty_print_object(save[j]);
      }
    printf("======== object pool =======\n");
    for (ptr = pool->first_object; ptr; ptr = ptr->next_object)
        pretty_print_object(ptr);
      }
      break;
      case 'l':            /* object length */
        printf("Length of object = %d\n",OMlength_of(object));
    break;
      case 's':            /* set object value */
    switch(object->type)
    {
      case LIST: printf("LIST\n"); break;
      case STRING:
        printf("string value: "); gets(buf);
        OMset_object(object, STRING, buf);
        break;
      case NUMBER:
      {
        long int x;

        printf("number value: "); gets(buf); x = atol(buf);
        OMset_object(object, NUMBER, x);
        break;
      }
      default:  printf("unknown type\n"); break;
    }
    break;
      case 'r':            /* remove stuff */
      {
    int n,z;

    printf("First element:  "); gets(buf); n = atoi(buf);
    printf("Number of elements:  "); gets(buf); z = atoi(buf);
    OMremove_items(object,n,z);
      }
      break;
      case 'e':            /* extract */
      {
    int n,z;
    Object *foo;

    if (object->type != LIST && object->type != STRING)
    {
      printf("Can't do that.\n");
      break;
    }

    printf("First element:  "); gets(buf); n = atoi(buf);
    printf("Number of elements:  "); gets(buf); z = atoi(buf);
    if (!(foo = OMextract_elements(pool,object,n,z)))
    {
      printf("Out of memory!\n");
      break;
    }
    object = foo;
      }
      break;
    }
  }
done: ;
}

#endif        /* TEST */