![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lam8.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / lisp|
Return to lam8.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
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.