#include "lisp.h"

/* symbol manipulation for SIMULISP */

#define HASHSIZE 127		/* size of obarray */

extern char lcase[];		/* converts char to lower case */

object obarray[HASHSIZE];	/* hash array for symbols */

/* initialize symbol stuff */
i_symbol()
  {	register int i;

	for (i=0; i<HASHSIZE; i++) obarray[i] = nil;
}

/* mark obarray during a garbage collection */
m_obarray()
  {	register int i;

	/* mark each bucket in obarray */
	for (i=0; i<HASHSIZE; i++) m_obj(obarray[i]);
}

/* make a string object from an asciz string */
object m_string(name)
  register char *name;
  {	object s = NULL;
	register char *p;
	register int sunp;	/* sun unix cc bug */

	p = al_bytes(strlen(name)+1);
	SETVALUE(s,(sunp = (int)p));
	while (*p++ = *name++);
	SETTYPE(s,STRING);
	return(s);
}
	
/* compare pattern with string, case doesn't matter.  "*" wildcard accepted */
int stareq(p,s)
  register char *p,*s;
  {	while (1) {
	  if (*p == '*') {
	    /* skip past multiple wildcards */
	    do p++; while (*p == '*');

	    /* if pattern ends with wild card, automatic match */
	    if (*p == 0) return(1);

	    /* *p now points to first non-wildcard character, find matching
	     * character in string, then recursively match remaining pattern.
	     * if recursive match fails, assume current '*' matches more...
	     */
	    while (*s != 0) {
	      while (lcase[*s] != lcase[*p]) if (*s++ == 0) return(0);
	      if (stareq(p+1,++s)) return(1);
	    }

	    /* couldn't find matching character after '*', no match */
	    return(0);
	  } else if (*p == 0) return(*s == 0);
	  else if (lcase[*p++] != lcase[*s++]) return(0);
	}
}

/* given asciz name return corresponding symbol, creating new one
 * if need be.
 */
object intern(name)
  register char *name;
  {	register int hash = sym_hash(name,HASHSIZE);
	register symbol *sym;
	object p = obarray[hash];

	while (p != nil) {
	  sym = (symbol *)ADDR(p);
	  if (str_eql(name,ADDR(sym->sym_pname))) return(p);
	  p = sym->sym_hlink;
	}

	p = al_obj(SYMBOL);
	sym = (symbol *)ADDR(p);
	sym->sym_value = NULL;
	sym->sym_function = NULL;
	sym->sym_plist = nil;
	sym->sym_pname = m_string(name);
	sym->sym_hlink = obarray[hash];
	obarray[hash] = p;
	return(p);
}