/* symbols.c: Functions for manipulating language symbols. */

/* Author: Brian J. Fox (bfox@ai.mit.edu) Mon Aug 21 11:12:04 1995.

   This file is part of <Meta-HTML>(tm), a system for the rapid deployment
   of Internet and Intranet applications via the use of the Meta-HTML
   language.

   Copyright (c) 1995, 1996, Brian J. Fox (bfox@ai.mit.edu).
   Copyright (c) 1996, Universal Access Inc. (http://www.ua.com).

   Meta-HTML is free software; you can redistribute it and/or modify
   it under the terms of the UAI Free Software License as published
   by Universal Access Inc.; either version 1, or (at your option) any
   later version.

   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
   UAI Free Software License for more details.

   You should have received a copy of the UAI Free Software License
   along with this program; if you have not, you may obtain one by
   writing to:

   Universal Access Inc.
   129 El Paseo Court
   Santa Barbara, CA
   93101  */

#if defined (HAVE_CONFIG_H)
#  include <config.h>
#endif

#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <xmalloc/xmalloc.h>
#include "symbols.h"

/* The Mac only defines "macintosh" in sys/types.h.  Sigh... */
#include <sys/types.h>

#if defined (macintosh)
#  include <mac_port.h>
#endif

/* The list of all created packages. */
Package **AllPackages = (Package **)NULL;
static int AP_index = 0;
static int AP_slots = 0;

/* Default number of slots for a symbol table.  Some callers
   may want to change this if they create a large number of
   symbol tables designed to hold only a few entries. */
int symbol_small_prime = 107;

/* The package which is "current".  That is, this is the package to use
   when no package name is supplied.  You can change this with
   symbol_set_default_package (). */
Package *CurrentPackage = (Package *)NULL;

/* A translation table for ASCII characters.  This one has only uppercase
   characters in it. */
static char u_stb[128] =
{
  0x00, /* nul */  0x01, /* soh */  0x02, /* stx */  0x03, /* etx */
  0x04, /* eot */  0x05, /* enq */  0x06, /* ack */  0x07, /* bel */
  0x08, /* bs */   0x09, /* ht */   0x0a, /* nl */   0x0b, /* vt */
  0x0c, /* np */   0x0d, /* cr */   0x0e, /* so */   0x0f, /* si */
  0x10, /* dle */  0x11, /* dc1 */  0x12, /* dc2 */  0x13, /* dc3 */
  0x14, /* dc4 */  0x15, /* nak */  0x16, /* syn */  0x17, /* etb */
  0x18, /* can */  0x19, /* em */   0x1a, /* sub */  0x1b, /* esc */
  0x1c, /* fs */   0x1d, /* gs */   0x1e, /* rs */   0x1f, /* us */
  0x20, /* sp */   0x21, /* ! */    0x22, /* " */    0x23, /* # */
  0x24, /* $ */    0x25, /* % */    0x26, /* & */    0x27, /* ' */
  0x28, /* ( */    0x29, /* ) */    0x2a, /* * */    0x2b, /* + */
  0x2c, /* , */    0x2d, /* - */    0x2e, /* . */    0x2f, /* / */
  0x30, /* 0 */    0x31, /* 1 */    0x32, /* 2 */    0x33, /* 3 */
  0x34, /* 4 */    0x35, /* 5 */    0x36, /* 6 */    0x37, /* 7 */
  0x38, /* 8 */    0x39, /* 9 */    0x3a, /* : */    0x3b, /* ; */
  0x3c, /* < */    0x3d, /* = */    0x3e, /* > */    0x3f, /* ? */
  0x40, /* @ */    0x41, /* A */    0x42, /* B */    0x43, /* C */
  0x44, /* D */    0x45, /* E */    0x46, /* F */    0x47, /* G */
  0x48, /* H */    0x49, /* I */    0x4a, /* J */    0x4b, /* K */
  0x4c, /* L */    0x4d, /* M */    0x4e, /* N */    0x4f, /* O */
  0x50, /* P */    0x51, /* Q */    0x52, /* R */    0x53, /* S */
  0x54, /* T */    0x55, /* U */    0x56, /* V */    0x57, /* W */
  0x58, /* X */    0x59, /* Y */    0x5a, /* Z */    0x5b, /* [ */
  0x5c, /* \ */    0x5d, /* ] */    0x5e, /* ^ */    0x5f, /* _ */
  0x60, /* ` */    0x41, /* A */    0x42, /* B */    0x43, /* C */
  0x44, /* D */    0x45, /* E */    0x46, /* F */    0x47, /* G */
  0x48, /* H */    0x49, /* I */    0x4a, /* J */    0x4b, /* K */
  0x4c, /* L */    0x4d, /* M */    0x4e, /* N */    0x4f, /* O */
  0x50, /* P */    0x51, /* Q */    0x52, /* R */    0x53, /* S */
  0x54, /* T */    0x55, /* U */    0x56, /* V */    0x57, /* W */
  0x58, /* X */    0x59, /* Y */    0x5a, /* Z */    0x7b, /* { */
  0x7c, /* | */    0x7d, /* } */    0x7e, /* ~ */    0x7f /*del*/
};

#if defined (LowerCaseTranslationTable)
/* A translation table for ASCII characters.  This one has only lowercase
   characters in it. */
static char l_stb[128] =
{
  0x00, /* nul */  0x01, /* soh */  0x02, /* stx */  0x03, /* etx */
  0x04, /* eot */  0x05, /* enq */  0x06, /* ack */  0x07, /* bel */
  0x08, /* bs */   0x09, /* ht */   0x0a, /* nl */   0x0b, /* vt */
  0x0c, /* np */   0x0d, /* cr */   0x0e, /* so */   0x0f, /* si */
  0x10, /* dle */  0x11, /* dc1 */  0x12, /* dc2 */  0x13, /* dc3 */
  0x14, /* dc4 */  0x15, /* nak */  0x16, /* syn */  0x17, /* etb */
  0x18, /* can */  0x19, /* em */   0x1a, /* sub */  0x1b, /* esc */
  0x1c, /* fs */   0x1d, /* gs */   0x1e, /* rs */   0x1f, /* us */
  0x20, /* sp */   0x21, /* ! */    0x22, /* " */    0x23, /* # */
  0x24, /* $ */    0x25, /* % */    0x26, /* & */    0x27, /* ' */
  0x28, /* ( */    0x29, /* ) */    0x2a, /* * */    0x2b, /* + */
  0x2c, /* , */    0x2d, /* - */    0x2e, /* . */    0x2f, /* / */
  0x30, /* 0 */    0x31, /* 1 */    0x32, /* 2 */    0x33, /* 3 */
  0x34, /* 4 */    0x35, /* 5 */    0x36, /* 6 */    0x37, /* 7 */
  0x38, /* 8 */    0x39, /* 9 */    0x3a, /* : */    0x3b, /* ; */
  0x3c, /* < */    0x3d, /* = */    0x3e, /* > */    0x3f, /* ? */
  0x40, /* @ */    0x61, /* a */    0x62, /* b */    0x63, /* c */
  0x64, /* d */    0x65, /* e */    0x66, /* f */    0x67, /* g */
  0x68, /* h */    0x69, /* i */    0x6a, /* j */    0x6b, /* k */
  0x6c, /* l */    0x6d, /* m */    0x6e, /* n */    0x6f, /* o */
  0x70, /* p */    0x71, /* q */    0x72, /* r */    0x73, /* s */
  0x74, /* t */    0x75, /* u */    0x76, /* v */    0x77, /* w */
  0x78, /* x */    0x79, /* y */    0x7a, /* z */    0x5b, /* [ */
  0x5c, /* \ */    0x5d, /* ] */    0x5e, /* ^ */    0x5f, /* _ */
  0x60, /* ` */    0x61, /* a */    0x62, /* b */    0x63, /* c */
  0x64, /* d */    0x65, /* e */    0x66, /* f */    0x67, /* g */
  0x68, /* h */    0x69, /* i */    0x6a, /* j */    0x6b, /* k */
  0x6c, /* l */    0x6d, /* m */    0x6e, /* n */    0x6f, /* o */
  0x70, /* p */    0x71, /* q */    0x72, /* r */    0x73, /* s */
  0x74, /* t */    0x75, /* u */    0x76, /* v */    0x77, /* w */
  0x78, /* x */    0x79, /* y */    0x7a, /* z */    0x7b, /* { */
  0x7c, /* | */    0x7d, /* } */    0x7e, /* ~ */    0x7f /*  del*/
};
#endif /* LowerCaseTranslationTable */

/* Symbol character translation table. */
static char *stb = u_stb;

#define symchar(character) stb[(character & 0x7f)]

#if 0

/* Non-zero means translation tables are initialized. */
static int stb_initialized = 0;

static void
initialize_symbol_translations (void)
{
  if (!stb_initialized)
    {
      register int i;

      for (i = 0; i < 128; i++)
	u_stb[i] = l_stb[i] = (char)i;

      for (i = 'A'; i <= 'Z'; i++)
	l_stb[i] = i + 32;

      for (i = 'a'; i <= 'z'; i++)
	u_stb[i] = i - 32;

      stb_initialized = 1;
    }
}
#endif

/* Create a symbol table with ROWS slots for symbol lists. */
static SymbolTable *
symbol_create_table (int rows)
{
  register int i;
  SymbolTable *new = (SymbolTable *)xmalloc (sizeof (SymbolTable));

  if (rows == 0)
    rows = symbol_small_prime;

  new->symbol_list = (SymbolList **)xmalloc (rows * sizeof (SymbolList *));
  new->rows = rows;
  new->entries = 0;

  for (i = 0; i < rows; i++)
    new->symbol_list[i] = (SymbolList *)NULL;

  return (new);
}

static int
symbol_match_name (Symbol *symbol, char *name)
{
  register int i;

  for (i = 0; (symchar (name[i]) == symbol->name[i]) && name[i] != '\0'; i++);

  return ((name[i] + symbol->name[i]) == 0);
}

/* Return the index of the row in TABLE which will contain the symbol
   named NAME. */
static int
symbol_hash (SymbolTable *table, char *name)
{
  register unsigned int i, j;

  for (i = 0, j = 0; name[i] != '\0'; i++)
    j = (j << 2) + symchar (name[i]);

  return ((j & ~(0xffffffff << 31)) % table->rows);
}

/* Set the default package.  This is the package to use when
   the name of the package is "". */
void
symbol_set_default_package (Package *package)
{
  if (package)
    CurrentPackage = package;
}

/* Locate and return the existing package NAME. */
Package *
symbol_lookup_package (char *name)
{
  register int i = 0;
  Package *package = (Package *)NULL;

  if (name != (char *)NULL)
    {
      if (name[0] == '\0')
	{
	  package = CurrentPackage;
	}
      else if (AllPackages != (Package **)NULL)
	{
	  int name_len = strlen (name);

	  for (i = 0; i < AP_index; i++)
	    if ((AllPackages[i]->name_len == name_len) &&
		(symbol_match_name ((Symbol *)AllPackages[i], name)))
	      {
		package = AllPackages[i];
		break;
	      }
	}
    }
  return (package);
}

/* Create a package named NAME suitable for storing symbols in.
   If the package already exists, return that package.
   You can create an anonymous package by passing NULL as the name. */
Package *
symbol_get_package (char *name)
{
  register int i = 0;
  Package *package = (Package *)NULL;

  package = symbol_lookup_package (name);

  if (package == (Package *)NULL)
    {
      package = (Package *)xmalloc (sizeof (Package));
      package->name = name ? strdup (name) : name;
      package->name_len = name ? strlen (name) : 0;
      package->table = symbol_create_table (0);

      if (name != (char *)NULL)
	{
	  if ((AP_index + 2) > AP_slots)
	    AllPackages = (Package **) xrealloc
	      (AllPackages, (AP_slots += 10) * sizeof (Package *));

	  AllPackages[AP_index++] = package;
	  AllPackages[AP_index] = (Package *)NULL;

	  /* Fix up the name. */
	  for (i = 0; i < package->name_len; i++)
	    package->name[i] = symchar (package->name[i]);
	}
    }

  return (package);
}

/* Destroy the package PACKAGE, freeing all of the space that it
   was using.  If the package was not anonymous, this deletes it
   from the list of AllPackages. */
void
symbol_destroy_package (Package *package)
{
  register int i;

  if (package != (Package *)NULL)
    {
      if (package == CurrentPackage)
	CurrentPackage = (Package *)NULL;

      if ((package->name != (char *)NULL) && (AllPackages != (Package **)NULL))
	{
	  for (i = 0; i < AP_index; i++)
	    if ((AllPackages[i]->name_len == package->name_len) &&
		(symbol_match_name ((Symbol *)AllPackages[i], package->name)))
	      {
		/* Move subsequent packages back. */
		while ((AllPackages[i] = AllPackages[i + 1])
		       != (Package *)NULL)
		  i++;

		AP_index--;

		break;
	      }
	}

      /* Now, simply free the package contents. */
      if (package->name) free (package->name);
      for (i = 0; i < package->table->rows; i++)
	{
	  if (package->table->symbol_list[i] != (SymbolList *)NULL)
	    {
	      SymbolList *list = package->table->symbol_list[i];

	      while (list)
		{
		  Symbol *sym = list->symbol;
		  SymbolList *this = list;
		  list = list->next;

		  symbol_free (sym);
		  free (this);
		}

	    }
	}

      free (package->table->symbol_list);
      free (package->table);
      free (package);
    }
}

/* Return the package of IDENTIFIER, a full identifier for a symbol.
   Identifiers have two portions: the package part and the symbol name
   part.  The two parts are separated by a pair of colons, as in
   PACKAGE::SYMBOL. */
Package *
symbol_package (char *identifier)
{
  Package *package = CurrentPackage;
  char *colon = strstr (identifier, "::");

  if (colon != (char *)NULL)
    {
      register int i;
      char *packname = (char *)xmalloc (1 + (colon - identifier));

      for (i = 0; i != (colon - identifier); i++)
	packname[i] = symchar (identifier[i]);

      packname[i] = '\0';
      package = symbol_get_package (packname);
      free (packname);
    }

  return (package);
}

Symbol *
symbol_lookup_in_package (Package *package, char *name)
{
  SymbolTable *table = (SymbolTable *)NULL;
  Symbol *result = (Symbol *)NULL;

  if (package)
    table = package->table;

  if (table)
    {
      int row = symbol_hash (table, name);
      SymbolList *list = table->symbol_list[row];
      int name_len = strlen (name);

      while (list)
	{
	  if ((name_len == list->symbol->name_len) &&
	      (symbol_match_name (list->symbol, name) == 1))
	    {
	      result = list->symbol;
	      break;
	    }
	  else
	    list = list->next;
	}
    }

  return (result);
}

/* Remove from PACKAGE the symbol specified by NAME. */
Symbol *
symbol_remove_in_package (Package *package, char *name)
{
  SymbolTable *table = (SymbolTable *)NULL;
  Symbol *result = (Symbol *)NULL;

  if (package)
    table = package->table;

  if (table)
    {
      int row = symbol_hash (table, name);
      SymbolList *list = table->symbol_list[row];
      int name_len = strlen (name);
      SymbolList *prev = (SymbolList *)NULL;

      while (list)
	{
	  if ((name_len == list->symbol->name_len) &&
	      (symbol_match_name (list->symbol, name) == 1))
	    {
	      result = list->symbol;

	      if (prev)
		prev->next = list->next;
	      else
		table->symbol_list[row] = list->next;

	      free (list);
	      table->entries--;
	      break;
	    }
	  else
	    {
	      prev = list;
	      list = list->next;
	    }
	}
    }
  return (result);
}

/* Intern in PACKAGE, the symbol named NAME, and return the interned symbol.
   If the symbol is already present, then return that. */
Symbol *
symbol_intern_in_package (Package *package, char *name)
{
  Symbol *symbol = symbol_lookup_in_package (package, name);

  if (symbol == (Symbol *)NULL)
    {
      register int i;
      SymbolTable *table = package->table;
      int row = symbol_hash (table, name);
      SymbolList *list = table->symbol_list[row];
      SymbolList *new = (SymbolList *)xmalloc (sizeof (SymbolList));

      symbol = (Symbol *)xmalloc (sizeof (Symbol));
      symbol->flags = 0;
      symbol->name_len = strlen (name);
      symbol->name = (char *)xmalloc (1 + symbol->name_len);

      for (i = 0; i < symbol->name_len; i++)
	symbol->name[i] = symchar (name[i]);

      symbol->name[i] = '\0';

      symbol->values = (char **)NULL;
      symbol->values_index = 0;
      symbol->values_slots = 0;
      symbol->type = symtype_STRING;
      symbol->package = (void *)package;
      symbol->notifier = (int *)NULL;

      new->symbol = symbol;
      new->next = list;
      table->symbol_list[row] = new;
      table->entries++;
    }

  return (symbol);
}

/* Associate SYMBOL with NOTIFIER, the address of an integer. */
void
symbol_notify_value (Symbol *symbol, int *address)
{
  if (symbol != (Symbol *)NULL)
    {
      symbol->notifier = address;
      *address = (symbol->values_index != 0);
    }
}

/* Return the symbol name portion of the full IDENTIFIER. */
static char *
symbol_part (char *identifier)
{
  char *symbol_name = strstr (identifier, "::");

  if (symbol_name)
    symbol_name += 2;
  else
    symbol_name = identifier;

  return (symbol_name);
}

/* Intern the symbol named NAME, and return that symbol.
   This interns in the package specified in the symbol name given,
   so that `foo::bar' interns BAR in the FOO package, and `bar'
   interns BAR in the current package. */
Symbol *
symbol_intern (char *name)
{
  Package *package = symbol_package (name);
  char *symbol_name = symbol_part (name);
  Symbol *symbol;

  /* The PACKAGE will be NULL if this is the first call ever to
     a symbol interning or package function, and the name contained
     no package part.  In that case, create the default package. */
  if (package == (Package *)NULL)
    {
      if (!CurrentPackage)
	CurrentPackage = symbol_get_package (DEFAULT_PACKAGE_NAME);

      package = CurrentPackage;
    }

  symbol = symbol_intern_in_package (package, symbol_name);

  return (symbol);
}

/* Find in PACKAGE for NAME, and return the associated symbol. */
Symbol *
symbol_lookup (char *name)
{
  Package *package = symbol_package (name);
  char *symbol_name = symbol_part (name);
  Symbol *symbol;

  /* The PACKAGE will be NULL if this is the first call ever to
     a symbol interning or package function, and the name contained
     no package part.  In that case, create the default package. */
  if (package == (Package *)NULL)
    {
      package = symbol_get_package (DEFAULT_PACKAGE_NAME);
      CurrentPackage = package;
    }

  symbol = symbol_lookup_in_package (package, symbol_name);

  return (symbol);
}

/* Get the values of NAME. */
char **
symbol_get_values (char *name)
{
  Package *package = symbol_package (name);
  char *symbol_name = symbol_part (name);
  Symbol *symbol;
  char **values = (char **)NULL;

  /* The PACKAGE will be NULL if this is the first call ever to
     a symbol interning or package function, and the name contained
     no package part.  In that case, create the default package. */
  if (package == (Package *)NULL)
    {
      package = symbol_get_package (DEFAULT_PACKAGE_NAME);
      CurrentPackage = package;
    }

  symbol = symbol_lookup_in_package (package, symbol_name);

  if ((symbol != (Symbol *)NULL))
    values = symbol->values;

  return (values);
}

/* Remove the symbol specified by NAME.  The removed symbol is returned. */
Symbol *
symbol_remove (char *name)
{
  Package *package = symbol_package (name);
  Symbol *symbol = (Symbol *)NULL;

  if (package != (Package *)NULL)
    symbol = symbol_remove_in_package (package, symbol_part (name));

  return (symbol);
}

/* Return an array of pointers to every symbol in the package named by NAME.
   The actual symbols are returned, so modifications can be made to them
   directly.  Beware!  Changing the name of a symbol in the returned array
   will probably make the symbol impossible to find by normal lookup
   methods, so don't do it. */
Symbol **
symbol_package_symbols (char *name)
{
  Package *package = CurrentPackage;

  if (name)
    {
      if (name[0] == '\0')
	package = symbol_get_package (DEFAULT_PACKAGE_NAME);
      else
	package = symbol_get_package (name);
    }
  
  return (symbols_of_package (package));
}

/* Return an array of pointers to every symbol in the package PACKAGE.
   The actual symbols are returned, so modifications can be made to them
   directly.  Beware!  Changing the name of a symbol in the returned array
   will probably make the symbol impossible to find by normal lookup
   methods, so don't do it. */
Symbol **
symbols_of_package (Package *package)
{   
  Symbol **symbols = (Symbol **)NULL;

  if (package != (Package *)NULL)
    {
      SymbolTable *table = package->table;

      if (table->entries)
	{
	  register int i, j;

	  symbols = (Symbol **)xmalloc
	    ((1 + table->entries) * sizeof (Symbol *));

	  for (i = 0, j = 0; i < table->rows; i++)
	    {
	      SymbolList *list = table->symbol_list[i];

	      while (list)
		{
		  symbols[j++] = list->symbol;
		  list = list->next;
		}
	    }

	  symbols[j] = (Symbol *)NULL;
	}
    }

  return (symbols);
}

/* Free the individual pointers in ARRAY, and the ARRAY itself. */
static void
free_array (char **array)
{
  if (array != (char **)NULL)
    {
      register int i;

      for (i = 0; array[i] != (char *)NULL; i++)
	free (array[i]);

      free (array);
    }
}

/* Return the number of entries in ARRAY. */
static int
array_length (char **array)
{
  register int i = 0;

  if (array != (char **)NULL)
    for (i = 0; array[i] != (char *)NULL; i++);

  return (i);
}

/* Create and return a copy of ARRAY. */
static char **
copy_array (char **array)
{
  int len = array_length (array);
  char **copy = (char **)NULL;

  if (len)
    {
      register int i;

      copy = (char **)xmalloc ((1 + len) * sizeof (char *));
      for (i = 0; i < len; i++)
	copy[i] = strdup (array[i]);
      copy[i] = (char *)NULL;
    }

  return (copy);
}

/* Create a Datablock object from DATA and LENGTH. */
Datablock *
datablock_create (char *data, int length)
{
  Datablock *block = (Datablock *)xmalloc (sizeof (Datablock));

  memset ((char *)block, 0, sizeof (Datablock));
  block->length = length;

  if (length != 0)
    {
      block->data = (char *)xmalloc (length);
      memcpy (block->data, data, length);
    }

  return (block);
}

/* Return a duplicate of BLOCK. */
Datablock *
datablock_copy (Datablock *block)
{
  Datablock *new = datablock_create (block->data, block->length);
  return (new);
}

/* Free BLOCK and contents. */
void
datablock_free (Datablock *block)
{
  if (block != (Datablock *)NULL)
    {
      if (block->length != 0)
	free (block->data);

      free (block);
    }
}

/* Free all of the data associated with SYMBOL. */
void
symbol_free (Symbol *symbol)
{
  if (symbol != (Symbol *)NULL)
    {
      if (symbol->notifier)
	*(symbol->notifier) = 0;


      switch (symbol->type)
	{
	case symtype_STRING:
	  free (symbol->name);
	  free_array (symbol->values);
	  free (symbol);
	  break;

	case symtype_BINARY:
	  free (symbol->name);
	  datablock_free ((Datablock *)symbol->values);
	  free (symbol);
	  break;

	case symtype_FUNCTION:
	case symtype_USERFUN:
	  break;
	}
    }
}

void
symbol_reset (Symbol *symbol)
{
  switch (symbol->type)
    {
    case symtype_STRING:
      free_array (symbol->values);
      break;

    case symtype_BINARY:
      datablock_free ((Datablock *)symbol->values);
      break;

    case symtype_FUNCTION:
    case symtype_USERFUN:
      return;
    }

  symbol->flags = 0;
  symbol->type = symtype_STRING;
  symbol->values_index = 0;
  symbol->values_slots = 0;
  symbol->values = (char **)NULL;
}

int
symbol_get_flags (Symbol *symbol)
{
  int result = 0;

  if (symbol != (Symbol *)NULL)
    result = symbol->flags;

  return (result);
}

int
symbol_get_flag (Symbol *symbol, int flag)
{
  int result = 0;

  if (symbol != (Symbol *)NULL)
    result = (symbol->flags & flag);

  return (result);
}

void
symbol_set_flag (Symbol *symbol, int flag)
{
  if (symbol != (Symbol *)NULL) symbol->flags |= flag;
}

void
symbol_clear_flag (Symbol *symbol, int flag)
{
  if (symbol != (Symbol *)NULL) symbol->flags &= ~flag;
}

/* Copy SYMBOL into PACKAGE.  Both SYMBOL and PACKAGE are real data items,
   not names of those items.  Returns the copied symbol. */
Symbol *
symbol_copy (Symbol *symbol, Package *package)
{
  Symbol *copy;

  copy = symbol_remove_in_package (package, symbol->name);

  if (copy != (Symbol *)NULL)
    symbol_free (copy);

  copy = symbol_intern_in_package (package, symbol->name);
  copy->type = symbol->type;
  copy->flags = symbol->flags;
  copy->values_index = symbol->values_index;
  copy->values_slots = symbol->values_slots;

  switch (symbol->type)
    {
    case symtype_STRING:
      copy->values = copy_array (symbol->values);
      copy->values_slots = copy->values_index;
      break;

    case symtype_FUNCTION:
    case symtype_USERFUN:
      copy->values = symbol->values;
      break;

    case symtype_BINARY:
      copy->values = (char **)datablock_copy ((Datablock *)symbol->values);
      break;
    }

  return (copy);
}

/* Change the name of SYMBOL to NEWNAME. */
Symbol *
symbol_rename (Symbol *symbol, char *newname)
{
  Symbol *sym, *newsym;
  Package *pack = (Package *)symbol->package;

  sym = symbol_remove_in_package (pack, symbol->name);
  newsym = symbol_remove_in_package (pack, newname);
  symbol_free (newsym);
  newsym = symbol_intern_in_package (pack, newname);
  newsym->values = sym->values;
  newsym->values_index = sym->values_index;
  newsym->values_slots = sym->values_slots;
  newsym->type = sym->type;
  free (sym->name);
  free (sym);

  return (newsym);
}

/* Move SYMBOL from its current package into PACKAGE.
   Both SYMBOL and PACKAGE are real data items, not names of those items.
   Returns the moved symbol. */
Symbol *
symbol_move (Symbol *symbol, Package *package)
{
  int row;
  SymbolList *list = (SymbolList *)xmalloc (sizeof (SymbolList));

  row = symbol_hash (package->table, symbol->name);
  symbol_remove_in_package ((Package *)symbol->package, symbol->name);
  symbol_free (symbol_remove_in_package (package, symbol->name));
  list->next = package->table->symbol_list[row];
  package->table->symbol_list[row] = list;
  list->symbol = symbol;
  symbol->package = (void *)package;

  return (symbol);
}

/* Add to SYMBOL, the value VALUE.  The modified symbol is returned. */
Symbol *
symbol_add_value (Symbol *symbol, char *value)
{
  if (value != (char *)NULL)
    {
      switch (symbol->type)
	{
	case symtype_STRING:
	  if (symbol->values_index + 2 > symbol->values_slots)
	    symbol->values = (char **)xrealloc
	    (symbol->values, (symbol->values_slots += 10) * sizeof (char *));

	  symbol->values[symbol->values_index++] = strdup (value);
	  symbol->values[symbol->values_index] = (char *)NULL;
	  break;

	case symtype_FUNCTION:
	case symtype_USERFUN:
	  break;

	case symtype_BINARY:
	  symbol->values = (char **)datablock_copy ((Datablock *)value);
	  break;
	}
    }

  if (symbol->notifier)
    *(symbol->notifier) = (symbol->values_index != 0);

  return (symbol);
}

/* Return the full print name of SYMBOL. */
char *
symbol_full_name (Symbol *symbol)
{
  char *name;
  Package *pack = (Package *)symbol->package;

  if (pack->name != (char *)NULL)
    {
      name = (char *)xmalloc (3 + pack->name_len + symbol->name_len);
      strcpy (name, pack->name);
      name[pack->name_len + 0] = ':';
      name[pack->name_len + 1] = ':';
      strcpy (name + pack->name_len + 2, symbol->name);
    }
  else
    name = strdup (symbol->name);

  return (name);
}

/* Copy all of the symbols from FROM into TO. */
void
symbol_copy_package (Package *from, Package *to)
{
  Symbol **symbols = symbols_of_package (from);

  if (symbols)
    {
      register int i;
      Symbol *sym;

      for (i = 0; (sym = symbols[i]) != (Symbol *)NULL; i++)
	symbol_copy (sym, to);
    }
}

/* Store into the symbol referenced by NAME, the array of character strings
   pointed to by ARRAY. */
void
symbol_store_array (char *name, char **array)
{
  Symbol *sym;

  if ((sym = symbol_remove (name)) != (Symbol *)NULL)
    symbol_free (sym);

  /* Only assign when there really is anything to assign. */
  if (array != (char **)NULL)
    {
      register int i;

      for (i = 0; array[i] != (char *)NULL; i++);

      sym = symbol_intern (name);
      sym->values = array;
      sym->values_index = i;
      sym->values_slots = i;
    }
}

#if defined (TEST)

int
main (int argc, char *argv[])
{
  register int i, j;

  for (i = 1; i < argc; i++)
    symbol_intern (argv[i]);

  for (j = 0; j < AP_index; j++)
    {
      Package *pack = AllPackages[j];
      char *packname = pack->name;
      Symbol **symbols = symbol_package_symbols (packname);
      int max_row = 0;
      int min_row = 10000;
      
      fprintf (stdout, "Distribution of package `%s': \n   ", packname);
      for (i = 0; i < pack->table->rows; i++)
	{
	  int count = 0;
	  SymbolList *list = pack->table->symbol_list[i];

	  if (!(i % 8)) fprintf (stdout, "\n   ");
	  fprintf (stdout, "%03d: ", i);

	  while (list)
	    {
	      count++;
	      list = list->next;
	    }

	  if (count > max_row) max_row = count;
	  if (count < min_row) min_row = count;

	  fprintf (stdout, "%02d%s", count,
		   (i + 1) == pack->table->rows ? ".\n" : ", ");
	}
      fprintf (stdout, "Most in any single row: %d, Least: %d\n\n",
	       max_row, min_row);

      fprintf (stdout, "Symbols in package `%s' (%d):\n",
	       packname, pack->table->entries);

      for (i = 0; symbols && symbols[i]; i++)
	fprintf (stdout, "   `%s'\n", symbol_full_name (symbols[i]));

      fprintf (stdout, " (Total of %d symbols)\n\n",
	       pack->table->entries);

      free (symbols);
    }

  /* Test the remove algorithm. */


  return (0);
}
#endif /* TEST */
