2.3.2 ���X�g���]��

�����������X�g��������evform���]�����s���������D

/* evform - evaluate a form */
LOCAL LVAL evform(form)
  LVAL form;
{
    LVAL fun,args,val,type;
    LVAL tracing=NIL;
    LVAL *argv;
    int argc;

    /* protect some pointers */
    xlstkcheck(2);
    xlsave(fun);
    xlsave(args);

    /* get the function and the argument list */
    fun = car(form);
    args = cdr(form);

    /* get the functional value of symbols */
    if (symbolp(fun)) {
        if (getvalue(s_tracelist) &&
              member(fun,getvalue(s_tracelist)))
            tracing = fun;
        fun = xlgetfunction(fun);
    }

    /* check for nil */
    if (null(fun))
        xlerror("bad function",NIL);

    /* dispatch on node type */
    switch (ntype(fun)) {
    case SUBR:
        argv = xlargv;
        argc = xlargc;
        xlargc = evpushargs(fun,args);
        xlargv = xlfp + 3;
        trenter(tracing,xlargc,xlargv);
        val = (*getsubr(fun))();
        trexit(tracing,val);
        xlsp = xlfp;
        xlfp = xlfp - (int)getfixnum(*xlfp);
        xlargv = argv;
        xlargc = argc;
        break;
    case FSUBR:
        argv = xlargv;
        argc = xlargc;
        xlargc = pushargs(fun,args);
        xlargv = xlfp + 3;
        val = (*getsubr(fun))();
        xlsp = xlfp;
        xlfp = xlfp - (int)getfixnum(*xlfp);
        xlargv = argv;
        xlargc = argc;
        break;
    case CONS:
        if (!consp(cdr(fun)))
            xlerror("bad function",fun);
        if ((type = car(fun)) == s_lambda)
            fun = xlclose(NIL,
                          s_lambda,
                          car(cdr(fun)),
                          cdr(cdr(fun)),
                          xlenv,xlfenv);
        else
            xlerror("bad function",fun);
        /**** fall through into the next case ****/
    case CLOSURE:
        if (gettype(fun) == s_lambda) {
            argc = evpushargs(fun,args);
            argv = xlfp + 3;
            trenter(tracing,argc,argv);
            val = evfun(fun,argc,argv);
            trexit(tracing,val);
            xlsp = xlfp;
            xlfp = xlfp - (int)getfixnum(*xlfp);
        }
        else {
            macroexpand(fun,args,&fun);
            val = xleval(fun);
        }
        break;
    default:
        xlerror("bad function",fun);
    }

    /* restore the stack */
    xlpopn(2);

    /* return the result value */
    return (val);
}