BSD 3 development

[unix-history] / usr / src / cmd / lisp / lam8.c

#include "global.h"

/* various functions from the c math library */
double sin(),cos(),asin(),acos(),atan2(),sqrt(), log(), exp();

lispval Imath(func)
double func();
{
       register lispval handy;
       register double res;
       chkarg(1);

       switch(TYPE(handy=lbot->val)) {
        case INT: res = func((double)handy->i); 
                  break;

        case DOUB: res = func(handy->r);
                  break;

        default:  error("Non fixnum or flonum to math function",FALSE);
       }
       handy = newdoub();
       handy->r = res;
       return(handy);
}
lispval Lsin()
{
       return(Imath(sin));
}

lispval Lcos()
{
       return(Imath(cos));
}

lispval Lasin()
{
       return(Imath(asin));
}

lispval Lacos()
{
       return(Imath(acos));
}

lispval Lsqrt()
{
       return(Imath(sqrt));
}
lispval Lexp()
{
       return(Imath(exp));
}

lispval Llog()
{
       return(Imath(log));
}

/* although we call this atan, it is really atan2 to the c-world,
  that is, it takes two args
*/
lispval Latan()
{
       register lispval arg;
       register double arg1v;
       register double res;
       chkarg(2);

       switch(TYPE(arg=lbot->val)) {

       case INT:  arg1v = (double) arg->i;
                  break;

       case DOUB: arg1v = arg->r;
                  break;

       default:   error("Non fixnum or flonum arg to atan2",FALSE);
       }

       switch(TYPE(arg = (lbot+1)->val)) {

       case INT: res = atan2(arg1v,(double) arg->i);
                 break;

       case DOUB: res = atan2(arg1v, arg->r);
                 break;

       default:  error("Non fixnum or flonum to atan2",FALSE);
       }
       arg = newdoub();
       arg->r = res;
       return(arg);
}

/* (random) returns a fixnum in the range -2**30 to 2**30 -1
  (random fixnum) returns a fixnum in the range 0 to fixnum-1
*/
lispval
Lrandom()
{
       register int curval;
       float pow();

       curval = rand();        /* get numb from 0 to 2**31-1 */

       if(np==lbot) return(inewint(curval-(int)pow((double)2,(double)30)));

       if((TYPE(lbot->val) != INT)
           || (lbot->val->i <= 0)) errorh(Vermisc,"random: non fixnum arg:",
                                                nil, FALSE, 0, lbot->val);

       return(inewint(curval % lbot->val->i )); 

}
lispval
Lmakunb()
{
       register lispval work;

       chkarg(1);
       work = lbot->val;
       if(work==nil || (TYPE(work)!=ATOM))
               return(work);
       work->clb = CNIL;
       return(work);
}
lispval
Lpolyev()
{
       register int count; 
       register double *handy, *base;
       register struct argent *argp, *lbot, *np;
       lispval result; int type;

       count = 2 * (((int) np) - (int) lbot);
       if(count == 0) 
               return(inewint(0));
       if(count == 8)
               return(lbot->val);
       base = handy = (double *) alloca(count);
       for(argp = lbot; argp < np; argp++) {
               while((type = TYPE(argp->val))!=DOUB && type!=INT)
                       argp->val = (lispval) errorh(Vermisc,"%%machine-polyev:non-real arg",nil,TRUE,73,lbot,argp->val);
               if(TYPE(argp->val)==INT) {
                       *handy++ = argp->val->i;
               } else
                       *handy++ = argp->val->r;
       }
       count = count/sizeof(double) - 2;
       asm("polyd      (r9),r11,8(r9)");
       asm("movd       r0,(r9)");
       result = newdoub();
       result->r = *base;
       return(result);
}