/* xlsym - symbol handling routines */

#ifdef AZTEC
#include "stdio.h"
#else
#include <stdio.h>
#endif

#include "xlisp.h"

/* global variables */
struct node *oblist;
struct node *s_unbound;

/* external variables */
extern struct node *xlstack;

/* forward declarations */
FORWARD struct node *xlmakesym();
FORWARD struct node *findprop();

/* xlenter - enter a symbol into the oblist */
struct node *xlenter(name,type)
  char *name;
{
    struct node *oldstk,*lsym,*nsym,newsym;
    int cmp;

    /* check for nil */
    if (strcmp(name,"nil") == 0)
	return (NULL);

    /* check for symbol already in table */
    lsym = NULL;
    nsym = oblist->n_symvalue;
    while (nsym) {
	if ((cmp = strcmp(name,xlsymname(nsym->n_listvalue))) <= 0)
	    break;
	lsym = nsym;
	nsym = nsym->n_listnext;
    }

    /* check to see if we found it */
    if (nsym && cmp == 0)
	return (nsym->n_listvalue);

    /* make a new symbol node and link it into the oblist */
    oldstk = xlsave(&newsym,NULL);
    newsym.n_ptr = newnode(LIST);
    newsym.n_ptr->n_listvalue = xlmakesym(name,type);
    newsym.n_ptr->n_listnext = nsym;
    if (lsym)
	lsym->n_listnext = newsym.n_ptr;
    else
	oblist->n_symvalue = newsym.n_ptr;
    xlstack = oldstk;

    /* return the new symbol */
    return (newsym.n_ptr->n_listvalue);
}

/* xlsenter - enter a symbol with a static print name */
struct node *xlsenter(name)
  char *name;
{
    return (xlenter(name,STATIC));
}

/* xlintern - intern a symbol onto the oblist */
struct node *xlintern(sym)
  struct node *sym;
{
    struct node *oldstk,*lsym,*nsym,newsym;
    char *name;
    int cmp;

    /* get the symbol's print name */
    name = xlsymname(sym);

    /* check for nil */
    if (strcmp(name,"nil") == 0)
	return (NULL);

    /* check for symbol already in table */
    lsym = NULL;
    nsym = oblist->n_symvalue;
    while (nsym) {
	if ((cmp = strcmp(name,xlsymname(nsym->n_listvalue))) <= 0)
	    break;
	lsym = nsym;
	nsym = nsym->n_listnext;
    }

    /* check to see if we found it */
    if (nsym && cmp == 0)
	return (nsym->n_listvalue);

    /* link the symbol into the oblist */
    oldstk = xlsave(&newsym,NULL);
    newsym.n_ptr = newnode(LIST);
    newsym.n_ptr->n_listvalue = sym;
    newsym.n_ptr->n_listnext = nsym;
    if (lsym)
	lsym->n_listnext = newsym.n_ptr;
    else
	oblist->n_symvalue = newsym.n_ptr;
    xlstack = oldstk;

    /* return the symbol */
    return (sym);
}

/* xlmakesym - make a new symbol node */
struct node *xlmakesym(name,type)
  char *name;
{
    struct node *oldstk,sym,*str;

    /* create a new stack frame */
    oldstk = xlsave(&sym,NULL);

    /* make a new symbol node */
    sym.n_ptr = newnode(SYM);
    sym.n_ptr->n_symvalue = s_unbound;
    sym.n_ptr->n_symplist = newnode(LIST);
    sym.n_ptr->n_symplist->n_listvalue = str = newnode(STR);
    str->n_str = (type == DYNAMIC ? strsave(name) : name);
    str->n_strtype = type;

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the new symbol node */
    return (sym.n_ptr);
}

/* xlsymname - return the print name of a symbol */
char *xlsymname(sym)
  struct node *sym;
{
    return (sym->n_symplist->n_listvalue->n_str);
}

/* xlgetprop - get the value of a property */
struct node *xlgetprop(sym,prp)
  struct node *sym,*prp;
{
    struct node *p;

    if ((p = findprop(sym,prp)) == NULL)
	return (NULL);
    return (p->n_listnext);
}

/* xlputprop - put a property value onto the property list */
xlputprop(sym,val,prp)
  struct node *sym,*val,*prp;
{
    struct node *oldstk,p,*pair;

    if ((pair = findprop(sym,prp)) == NULL) {
	oldstk = xlsave(&p,NULL);
	p.n_ptr = newnode(LIST);
	p.n_ptr->n_listvalue = pair = newnode(LIST);
	p.n_ptr->n_listnext = sym->n_symplist->n_listnext;
	sym->n_symplist->n_listnext = p.n_ptr;
	pair->n_listvalue = prp;
	xlstack = oldstk;
    }
    pair->n_listnext = val;
}

/* xlremprop - remove a property from a property list */
xlremprop(sym,prp)
  struct node *sym,*prp;
{
    struct node *last,*p;

    last = NULL;
    for (p = sym->n_symplist->n_listnext; p; p = p->n_listnext) {
	if (p->n_listvalue->n_listvalue == prp)
	    if (last)
		last->n_listnext = p->n_listnext;
	    else
		sym->n_symplist->n_listnext = p->n_listnext;
	last = p;
    }
}

/* findprop - find a property pair */
LOCAL struct node *findprop(sym,prp)
  struct node *sym,*prp;
{
    struct node *p;

    for (p = sym->n_symplist->n_listnext; p; p = p->n_listnext)
	if (p->n_listvalue->n_listvalue == prp)
	    return (p->n_listvalue);
    return (NULL);
}

/* xlsinit - symbol initialization routine */
xlsinit()
{
    /* initialize the oblist */
    oblist = xlmakesym("*oblist*",STATIC);
    oblist->n_symvalue = newnode(LIST);
    oblist->n_symvalue->n_listvalue = oblist;

    /* enter the unbound symbol indicator */
    s_unbound = xlsenter("*unbound*");
    s_unbound->n_symvalue = s_unbound;
}