Beispiel #1
0
/* 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);
}
Beispiel #2
0
/* 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);
}
Beispiel #3
0
/* 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);
}
Beispiel #4
0
/* 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);
}
Beispiel #5
0
/* 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);
}
Beispiel #6
0
/* 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 */
}