/* xloinit - object function initialization routine */
void xloinit(void)
{
/* create the 'Class' object */
class = xlclass("CLASS",CLASSSIZE);
setelement(class,0,class);
/* create the 'Object' object */
object = xlclass("OBJECT",0);
/* finish initializing 'class' */
setivar(class,SUPERCLASS,object);
xladdivar(class,"IVARTOTAL"); /* ivar number 6 */
xladdivar(class,"IVARCNT"); /* ivar number 5 */
xladdivar(class,"SUPERCLASS"); /* ivar number 4 */
xladdivar(class,"CVALS"); /* ivar number 3 */
xladdivar(class,"CVARS"); /* ivar number 2 */
xladdivar(class,"IVARS"); /* ivar number 1 */
xladdivar(class,"MESSAGES"); /* ivar number 0 */
xladdmsg(class,":NEW",FT_CLNEW);
xladdmsg(class,":ISNEW",FT_CLISNEW);
xladdmsg(class,":ANSWER",FT_CLANSWER);
/* finish initializing 'object' */
setivar(object,SUPERCLASS,NIL);
xladdmsg(object,":ISNEW",FT_OBISNEW);
xladdmsg(object,":CLASS",FT_OBCLASS);
xladdmsg(object,":SHOW",FT_OBSHOW);
xladdmsg(object,":ISA",FT_OBISA);
}
/* xlobsetvalue - set the value of an instance variable */
int xlobsetvalue(LVAL pair, LVAL sym, LVAL val)
{
LVAL cls,names;
int ivtotal,n;
/* find the instance or class variable */
for (cls = cdr(pair); objectp(cls); cls = getivar(cls,SUPERCLASS)) {
/* check the instance variables */
names = getivar(cls,IVARS);
ivtotal = getivcnt(cls,IVARTOTAL);
for (n = ivtotal - getivcnt(cls,IVARCNT); n < ivtotal; ++n) {
if (car(names) == sym) {
setivar(car(pair),n,val);
return (TRUE);
}
names = cdr(names);
}
/* check the class variables */
names = getivar(cls,CVARS);
for (n = 0; consp(names); ++n) {
if (car(names) == sym) {
setelement(getivar(cls,CVALS),n,val);
return (TRUE);
}
names = cdr(names);
}
}
/* variable not found */
return (FALSE);
}
/* xlclass - define a class */
LVAL xlclass(const char *name, int vcnt)
{
LVAL sym,cls;
/* create the class */
sym = xlenter(name);
cls = newobject(class,CLASSSIZE);
setvalue(sym,cls);
/* set the instance variable counts */
setivar(cls,IVARCNT,cvfixnum((FIXTYPE)vcnt));
setivar(cls,IVARTOTAL,cvfixnum((FIXTYPE)vcnt));
/* set the superclass to 'Object' */
setivar(cls,SUPERCLASS,object);
/* return the new class */
return (cls);
}
/* clisnew - initialize a new class */
LVAL clisnew(void)
{
LVAL self,ivars,cvars,super;
int n;
/* get self, the ivars, cvars and superclass */
self = xlgaobject();
ivars = xlgalist();
cvars = (moreargs() ? xlgalist() : NIL);
super = (moreargs() ? xlgaobject() : object);
xllastarg();
/* store the instance and class variable lists and the superclass */
setivar(self,IVARS,ivars);
setivar(self,CVARS,cvars);
setivar(self,CVALS,(cvars ? newvector(listlength(cvars)) : NIL));
setivar(self,SUPERCLASS,super);
/* compute the instance variable count */
n = listlength(ivars);
setivar(self,IVARCNT,cvfixnum((FIXTYPE)n));
n += getivcnt(super,IVARTOTAL);
setivar(self,IVARTOTAL,cvfixnum((FIXTYPE)n));
/* return the new class object */
return (self);
}
/* entermsg - add a message to a class */
LOCAL LVAL entermsg(LVAL cls, LVAL msg)
{
LVAL lptr,mptr;
/* lookup the message */
for (lptr = getivar(cls,MESSAGES); lptr; lptr = cdr(lptr))
if (car(mptr = car(lptr)) == msg)
return (mptr);
/* allocate a new message entry if one wasn't found */
xlsave1(mptr);
mptr = consa(msg);
setivar(cls,MESSAGES,cons(mptr,getivar(cls,MESSAGES)));
xlpop();
/* return the symbol node */
return (mptr);
}
/* xladdivar - enter an instance variable */
void xladdivar(LVAL cls, const char *var)
{
setivar(cls,IVARS,cons(xlenter(var),getivar(cls,IVARS)));
}
void
setmgvar( /* set a variable */
char *fname,
FILE *fp,
char *string
)
{
char name[128];
FILE *fp2;
register int i;
register char *s;
register VARIABLE *vp;
if (!strncmp(string, "include=", 8)) { /* include file */
if ((s = findfile(string+8, libpath)) == NULL) {
fprintf(stderr, "%s\n", string);
fprintf(stderr, "%s: %s: File not found: %s\n",
progname, fname, string+8);
quit(1);
}
strcpy(name, s);
mgload(name);
return;
}
s = string;
i = 0;
while (i < sizeof(name)-1 && isid(*s))
name[i++] = *s++;
name[i] = '\0';
vp = vlookup(name);
if (vp != NULL) {
undefine(vp);
switch (vp->type) {
case REAL:
case FUNCTION:
if ((*s == '(') != (vp->type == FUNCTION)) {
fprintf(stderr, "%s\n", string);
fprintf(stderr,
"%s: %s: Bad %s declaration: %s\n",
progname, fname,
vp->type == FUNCTION ?
"function" : "variable",
name);
quit(1);
}
scompile(string, fname, 0);
vp->v.dfn = savestr(string);
break;
case STRING:
if (*s++ != '=') {
fprintf(stderr, "%s\n", string);
fprintf(stderr, "%s: %s: Missing '='\n",
progname, fname);
quit(1);
}
vp->v.s = savestr(s);
break;
case DATA:
if (*s++ != '=') {
fprintf(stderr, "%s\n", string);
fprintf(stderr, "%s: %s: Missing '='\n",
progname, fname);
quit(1);
}
if (!*s) {
loaddata(fname, fp, &vp->v.d);
} else if (*s == '!') {
if ((fp2 = popen(s+1, "r")) == NULL) {
fprintf(stderr, "%s\n", string);
fprintf(stderr,
"%s: %s: Cannot execute: %s\n",
progname, fname, s+1);
quit(1);
}
loaddata(s, fp2, &vp->v.d);
pclose(fp2);
} else {
if ((fp2 = fopen(s, "r")) == NULL) {
fprintf(stderr, "%s\n", string);
fprintf(stderr,
"%s: %s: Data file not found: %s\n",
progname, fname, s);
quit(1);
}
loaddata(s, fp2, &vp->v.d);
fclose(fp2);
}
break;
}
vp->flags |= DEFINED;
} else
setivar(name, fname, string); /* intermediate */
}