Return to lam8.c CVS log

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

Annotation of 3BSD/cmd/lisp/lam8.c, revision 1.1

1.1     ! root        1: #include "global.h"
        !             2: 
        !             3: /* various functions from the c math library */
        !             4: double sin(),cos(),asin(),acos(),atan2(),sqrt(), log(), exp();
        !             5: 
        !             6: lispval Imath(func)
        !             7: double func();
        !             8: {
        !             9:        register lispval handy;
        !            10:        register double res;
        !            11:        chkarg(1);
        !            12: 
        !            13:        switch(TYPE(handy=lbot->val)) {
        !            14:         case INT: res = func((double)handy->i); 
        !            15:                   break;
        !            16: 
        !            17:         case DOUB: res = func(handy->r);
        !            18:                   break;
        !            19: 
        !            20:         default:  error("Non fixnum or flonum to math function",FALSE);
        !            21:        }
        !            22:        handy = newdoub();
        !            23:        handy->r = res;
        !            24:        return(handy);
        !            25: }
        !            26: lispval Lsin()
        !            27: {
        !            28:        return(Imath(sin));
        !            29: }
        !            30: 
        !            31: lispval Lcos()
        !            32: {
        !            33:        return(Imath(cos));
        !            34: }
        !            35: 
        !            36: lispval Lasin()
        !            37: {
        !            38:        return(Imath(asin));
        !            39: }
        !            40: 
        !            41: lispval Lacos()
        !            42: {
        !            43:        return(Imath(acos));
        !            44: }
        !            45: 
        !            46: lispval Lsqrt()
        !            47: {
        !            48:        return(Imath(sqrt));
        !            49: }
        !            50: lispval Lexp()
        !            51: {
        !            52:        return(Imath(exp));
        !            53: }
        !            54: 
        !            55: lispval Llog()
        !            56: {
        !            57:        return(Imath(log));
        !            58: }
        !            59: 
        !            60: /* although we call this atan, it is really atan2 to the c-world,
        !            61:    that is, it takes two args
        !            62:  */
        !            63: lispval Latan()
        !            64: {
        !            65:        register lispval arg;
        !            66:        register double arg1v;
        !            67:        register double res;
        !            68:        chkarg(2);
        !            69: 
        !            70:        switch(TYPE(arg=lbot->val)) {
        !            71: 
        !            72:        case INT:  arg1v = (double) arg->i;
        !            73:                   break;
        !            74: 
        !            75:        case DOUB: arg1v = arg->r;
        !            76:                   break;
        !            77: 
        !            78:        default:   error("Non fixnum or flonum arg to atan2",FALSE);
        !            79:        }
        !            80: 
        !            81:        switch(TYPE(arg = (lbot+1)->val)) {
        !            82: 
        !            83:        case INT: res = atan2(arg1v,(double) arg->i);
        !            84:                  break;
        !            85: 
        !            86:        case DOUB: res = atan2(arg1v, arg->r);
        !            87:                  break;
        !            88: 
        !            89:        default:  error("Non fixnum or flonum to atan2",FALSE);
        !            90:        }
        !            91:        arg = newdoub();
        !            92:        arg->r = res;
        !            93:        return(arg);
        !            94: }
        !            95: 
        !            96: /* (random) returns a fixnum in the range -2**30 to 2**30 -1
        !            97:    (random fixnum) returns a fixnum in the range 0 to fixnum-1
        !            98:  */
        !            99: lispval
        !           100: Lrandom()
        !           101: {
        !           102:        register int curval;
        !           103:        float pow();
        !           104: 
        !           105:        curval = rand();        /* get numb from 0 to 2**31-1 */
        !           106: 
        !           107:        if(np==lbot) return(inewint(curval-(int)pow((double)2,(double)30)));
        !           108: 
        !           109:        if((TYPE(lbot->val) != INT)
        !           110:            || (lbot->val->i <= 0)) errorh(Vermisc,"random: non fixnum arg:",
        !           111:                                                 nil, FALSE, 0, lbot->val);
        !           112: 
        !           113:        return(inewint(curval % lbot->val->i )); 
        !           114: 
        !           115: }
        !           116: lispval
        !           117: Lmakunb()
        !           118: {
        !           119:        register lispval work;
        !           120: 
        !           121:        chkarg(1);
        !           122:        work = lbot->val;
        !           123:        if(work==nil || (TYPE(work)!=ATOM))
        !           124:                return(work);
        !           125:        work->clb = CNIL;
        !           126:        return(work);
        !           127: }
        !           128: lispval
        !           129: Lpolyev()
        !           130: {
        !           131:        register int count; 
        !           132:        register double *handy, *base;
        !           133:        register struct argent *argp, *lbot, *np;
        !           134:        lispval result; int type;
        !           135: 
        !           136:        count = 2 * (((int) np) - (int) lbot);
        !           137:        if(count == 0) 
        !           138:                return(inewint(0));
        !           139:        if(count == 8)
        !           140:                return(lbot->val);
        !           141:        base = handy = (double *) alloca(count);
        !           142:        for(argp = lbot; argp < np; argp++) {
        !           143:                while((type = TYPE(argp->val))!=DOUB && type!=INT)
        !           144:                        argp->val = (lispval) errorh(Vermisc,"%%machine-polyev:non-real arg",nil,TRUE,73,lbot,argp->val);
        !           145:                if(TYPE(argp->val)==INT) {
        !           146:                        *handy++ = argp->val->i;
        !           147:                } else
        !           148:                        *handy++ = argp->val->r;
        !           149:        }
        !           150:        count = count/sizeof(double) - 2;
        !           151:        asm("polyd      (r9),r11,8(r9)");
        !           152:        asm("movd       r0,(r9)");
        !           153:        result = newdoub();
        !           154:        result->r = *base;
        !           155:        return(result);
        !           156: }

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