Return to eval2.c CVS log

Up to [CSRG BSD Unix] / 40BSD / cmd / lisp

Annotation of 40BSD/cmd/lisp/eval2.c, revision 1.1

1.1     ! root        1: static char *sccsid = "@(#)eval2.c     34.1 10/3/80";
        !             2: 
        !             3: #include "global.h"
        !             4: 
        !             5: /* Iarray - handle array call.
        !             6:  *  fun - array object
        !             7:  *  args - arguments to the array call , most likely subscripts.
        !             8:  *  evalp - flag, if TRUE then the arguments should be evaluated when they
        !             9:  *     are stacked.
        !            10:  */
        !            11: lispval
        !            12: Iarray(fun,args,evalp)
        !            13: register lispval fun,args;
        !            14: {
        !            15:        register lispval reg, temp;
        !            16:        register struct argent *lbot, *np;
        !            17:        
        !            18:        lbot = np;
        !            19:        protect(fun->ar.accfun);
        !            20:        for ( ; args != nil ; args = args->d.cdr)  /* stack subscripts */
        !            21:          if(evalp) protect(eval(args->d.car));
        !            22:          else protect(args->d.car);
        !            23:        protect(fun);
        !            24:        return(vtemp = Lfuncal());
        !            25: }
        !            26: 
        !            27: lispval
        !            28: Ifcall(a)
        !            29: lispval a;
        !            30: {
        !            31:        int *alloca();
        !            32:        register int *arglist;
        !            33:        register int index;
        !            34:        register struct argent *mynp;
        !            35:        register lispval ltemp;
        !            36:        register struct argent *lbot;
        !            37:        register struct argent *np;
        !            38:        int itemp;
        !            39:        int nargs = np - lbot;
        !            40: 
        !            41:        arglist = alloca((nargs + 1) * sizeof(int));
        !            42:        mynp = lbot;
        !            43:        *arglist = nargs;
        !            44:        for(index = 1; index <=  nargs; index++) {
        !            45:                switch(TYPE(ltemp=mynp->val)) {
        !            46:                case INT:
        !            47:                        arglist[index] = sp();
        !            48:                        stack(0);
        !            49:                        *(int *) arglist[index] = ltemp->i;
        !            50:                        break;
        !            51:                case DOUB:
        !            52:                        stack(0);
        !            53:                        arglist[index] = sp();
        !            54:                        stack(0);
        !            55:                        *(double *) arglist[index] = ltemp->r;
        !            56:                        break;
        !            57:                case HUNK2:
        !            58:                case HUNK4:
        !            59:                case HUNK8:
        !            60:                case HUNK16:
        !            61:                case HUNK32:
        !            62:                case HUNK64:
        !            63:                case HUNK128:
        !            64:                case DTPR:
        !            65:                case ATOM:
        !            66:                case SDOT:
        !            67:                        arglist[index] = (int) ltemp;
        !            68:                        break;
        !            69: 
        !            70:                case ARRAY:
        !            71:                        arglist[index] = (int) ltemp->ar.data;
        !            72:                        break;
        !            73: 
        !            74: 
        !            75:                case BCD:
        !            76:                        arglist[index] = (int) ltemp->bcd.entry;
        !            77:                        break;
        !            78: 
        !            79:                default:
        !            80:                        error("foreign call: illegal argument ",FALSE);
        !            81:                        break;
        !            82:                }
        !            83:                mynp++;
        !            84:        }
        !            85:        switch(((char *)a->bcd.discipline)[0]) {
        !            86:                case 'i': /* integer-function */
        !            87:                        ltemp = inewint(callg(a->bcd.entry,arglist));
        !            88:                        break;
        !            89: 
        !            90:                case 'r': /* real-function*/
        !            91:                        ltemp = newdoub();
        !            92:                        ltemp->r = (* ((double (*)()) callg))(a->bcd.entry,arglist);
        !            93:                        break;
        !            94: 
        !            95:                case 'f':  /* function */
        !            96:                        ltemp = (lispval) callg(a->bcd.entry,arglist);
        !            97:                        break;
        !            98: 
        !            99:                default:
        !           100:                case 's': /* subroutine */
        !           101:                        callg(a->bcd.entry,arglist);
        !           102:                        ltemp = tatom;
        !           103:        }
        !           104:        return(ltemp);
        !           105: }
        !           106: callg(funct,arglist)
        !           107: lispval (*funct)();
        !           108: int *arglist;
        !           109: {
        !           110:        asm("   callg   *8(ap),*4(ap)");
        !           111: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.