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

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.