/* xlenter - enter a symbol into the obarray */
NODE *xlenter(char *name,int type)
{
NODE ***oldstk,*sym __HEAPIFY,*array;
int i;
/* check for nil */
if (strcmp(name,"NIL") == 0)
return (NIL);
/* check for symbol already in table */
array = getvalue(obarray);
i = hash(name,HSIZE);
for (sym = getelement(array,i); sym; sym = cdr(sym))
if (strcmp(name,getstring(getpname(car(sym)))) == 0)
return (car(sym));
/* make a new symbol node and link it into the list */
oldstk = xlsave1(&sym);
sym = consd(getelement(array,i));
rplaca(sym,xlmakesym(name,type));
setelement(array,i,sym);
xlstack = oldstk;
/* return the new symbol */
return (car(sym));
}
/* xlenter - enter a symbol into the obarray */
LVAL xlenter(char *name)
{
LVAL sym,array;
int i;
/* check for nil */
if (strcmp(name,"NIL") == 0)
return (NIL);
/* check for symbol already in table */
array = getvalue(obarray);
i = hash(name,HSIZE);
for (sym = getelement(array,i); sym; sym = cdr(sym))
if (strcmp(name,(char *) getstring(getpname(car(sym)))) == 0)
return (car(sym));
/* make a new symbol node and link it into the list */
xlsave1(sym);
sym = consd(getelement(array,i));
rplaca(sym,xlmakesym(name));
setelement(array,i,sym);
xlpop();
/* return the new symbol */
return (car(sym));
}
/* xgensym - generate a symbol */
LVAL xgensym(void)
{
char sym[STRMAX+11]; /* enough space for prefix and number */
LVAL x;
/* get the prefix or number */
if (moreargs()) {
x = xlgetarg();
switch (ntype(x)) {
case SYMBOL:
x = getpname(x);
case STRING:
strncpy(gsprefix, (char *) getstring(x),STRMAX);
gsprefix[STRMAX] = '\0';
break;
case FIXNUM:
gsnumber = getfixnum(x);
break;
default:
xlerror("bad argument type",x);
}
}
xllastarg();
/* create the pname of the new symbol */
sprintf(sym,"%s%d",gsprefix,gsnumber++);
/* make a symbol with this print name */
return (xlmakesym(sym));
}
xlsinit(void)
{
NODE *array,*p;
obarray = xlmakesym("*OBARRAY*",1);
array = newvector(199);
((obarray)->n_info.n_xsym.xsy_value = (array));
p = consa(obarray);
((array)->n_info.n_xvect.xv_data[hash("*OBARRAY*",199)] = (p));
s_unbound = xlsenter("*UNBOUND*");
((s_unbound)->n_info.n_xsym.xsy_value = (s_unbound));
}
/* makesymbol - make a new symbol */
LOCAL LVAL makesymbol(int iflag)
{
LVAL pname;
/* get the print name of the symbol to intern */
pname = xlgastring();
xllastarg();
/* make the symbol */
return (iflag ? xlenter((char *) getstring(pname))
: xlmakesym((char *) getstring(pname)));
}
/* xlsinit - symbol initialization routine */
void xlsinit(void)
{
LVAL array,p;
/* initialize the obarray */
obarray = xlmakesym("*OBARRAY*");
array = newvector(HSIZE);
setvalue(obarray,array);
/* add the symbol *OBARRAY* to the obarray */
p = consa(obarray);
setelement(array,hash("*OBARRAY*",HSIZE),p);
}
/* xlsinit - symbol initialization routine */
void xlsinit(void)
{
NODE *array,*p;
/* initialize the obarray */
obarray = xlmakesym("*OBARRAY*",STATIC);
array = newvector(HSIZE);
setvalue(obarray,array);
/* add the symbol *OBARRAY* to the obarray */
p = consa(obarray);
setelement(array,hash("*OBARRAY*",HSIZE),p);
/* enter the unbound symbol indicator */
s_unbound = xlsenter("*UNBOUND*");
setvalue(s_unbound,s_unbound);
}
NODE *xlenter(char *name, int type)
{
NODE ***oldstk,*sym,*array;
int i;
if (strcmp(name,"NIL") == 0)
return ((NODE *)0);
array = ((obarray)->n_info.n_xsym.xsy_value);
i = hash(name,199);
for (sym = ((array)->n_info.n_xvect.xv_data[i]); sym; sym = ((sym)->n_info.n_xlist.xl_cdr))
if (strcmp(name,((((((sym)->n_info.n_xlist.xl_car))->n_info.n_xsym.xsy_plist->n_info.n_xlist.xl_car))->n_info.n_xstr.xst_str)) == 0)
return (((sym)->n_info.n_xlist.xl_car));
oldstk = xlsave(&sym,(NODE **)0);
sym = consd(((array)->n_info.n_xvect.xv_data[i]));
((sym)->n_info.n_xlist.xl_car = (xlmakesym(name,type)));
((array)->n_info.n_xvect.xv_data[i] = (sym));
xlstack = oldstk;
return (((sym)->n_info.n_xlist.xl_car));
}
/* Make a copy of the obarray so that we can erase any
changes the user makes to global variables */
void nyx_save_obarray()
{
LVAL array, obarrayvec;
int i;
xlsave1(array);
array = newvector(HSIZE);
obarrayvec = getvalue(obarray);
for(i=0; i<HSIZE; i++) {
LVAL from = getelement(obarrayvec, i);
if (from)
setelement(array, i, copylist(from));
}
nyx_old_obarray = obarray;
obarray = xlmakesym("*OBARRAY*");
setvalue(obarray, array);
xlpop();
}
/* punintern - parse an uninterned symbol */
LOCAL LVAL punintern(LVAL fptr)
{
int escflag;
pname(fptr,&escflag);
return (xlmakesym(buf));
}
