Category : Miscellaneous Language Source Code
Archive   : XSCHME02.ZIP
Filename : XSSYM.C

/* xssym.c - symbol handling routines */
/* Copyright (c) 1988, by David Michael Betz
All Rights Reserved
Permission is granted for unrestricted non-commercial use */

#include "xscheme.h"

/* external variables */
extern LVAL obarray;

/* forward declarations */
LVAL findprop();

/* xlsubr - define a builtin function */
xlsubr(sname,type,fcn,offset)
char *sname; int type; LVAL (*fcn)(); int offset;
{
LVAL sym;
sym = xlenter(sname);
setvalue(sym,cvsubr(type,fcn,offset));
}

/* xlenter - enter a symbol into the obarray */
LVAL xlenter(name)
char *name;
{
LVAL array,sym;
int i;

/* get the current obarray and the hash index for this symbol */
array = getvalue(obarray);
i = hash(name,HSIZE);

/* check if symbol is already in table */
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 */
sym = cons(cvsymbol(name),getelement(array,i));
setelement(array,i,sym);
sym = car(sym);

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

/* xlgetprop - get the value of a property */
LVAL xlgetprop(sym,prp)
LVAL sym,prp;
{
LVAL p;
return ((p = findprop(sym,prp)) ? car(p) : NIL);
}

/* xlputprop - put a property value onto the property list */
xlputprop(sym,val,prp)
LVAL sym,val,prp;
{
LVAL pair;
if (pair = findprop(sym,prp))
rplaca(pair,val);
else
setplist(sym,cons(prp,cons(val,getplist(sym))));
}

/* findprop - find a property pair */
LOCAL LVAL findprop(sym,prp)
LVAL sym,prp;
{
LVAL p;
for (p = getplist(sym); consp(p) && consp(cdr(p)); p = cdr(cdr(p)))
if (car(p) == prp)
return (cdr(p));
return (NIL);
}

/* hash - hash a symbol name string */
int hash(str,len)
char *str;
{
int i;
for (i = 0; *str; )
i = (i << 2) ^ *str++;
i %= len;
return (i < 0 ? -i : i);
}