![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lam4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / lisp|
Return to lam4.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / lisp |
1.1 root 1: static char *sccsid = "@(#)lam4.c 34.1 10/3/80";
2:
3: #include "global.h"
4: typedef struct argent *ap;
5: static int prunep; lispval adbig(),subbig(),mulbig();
6: lispval
7: Ladd()
8: {
9: register lispval work;
10: register ap result, mynp, oldnp, lbot, np;
11: int itemp,restype;
12:
13: oldnp = result = np;
14: protect(rdrsdot);
15: rdrsdot->s.CDR = (lispval) 0;
16: rdrsdot->s.I =0;
17: restype = SDOT;
18: prunep = TRUE;
19:
20: for(mynp = lbot; mynp < oldnp; mynp++)
21: {
22: work = mynp->val;
23: switch(TYPE(work)) {
24: case INT:
25: switch(restype) {
26: case DOUB:
27: result->val->r += work->i;
28: break;
29: case SDOT:
30: dmlad(result->val,1,work->i);
31: prunep = TRUE;
32: break;
33: default:
34: goto urk;
35: }
36: break;
37: case SDOT:
38: switch(restype) {
39: case DOUB:
40: error("Don't know how to make bignums into reals, yet",FALSE);
41: break;
42: case SDOT:
43: result->val = adbig(work,result->val);
44: restype = TYPE(result->val);
45: if(restype==INT) {
46: rdrsdot->s.I=result->val->s.I;
47: rdrsdot->s.CDR = (lispval) 0;
48: result->val = rdrsdot;
49: restype=SDOT;
50: prunep = TRUE;
51: } else
52: prunep = FALSE;
53: break;
54: default:
55: goto urk;
56: }
57: break;
58: case DOUB:
59: switch(restype) {
60: case SDOT:
61: if(result->val->s.CDR==(lispval) 0) {
62: protect(newdoub());
63: np[-1].val->r = result->val->i+work->r;
64: result->val = np[-1].val;
65: np--;
66: restype = DOUB;
67: } else
68: error("Don't know how to make bignums into reals, yet",FALSE);
69: break;
70: case DOUB:
71: result->val->r += work->r;
72: break;
73: default:
74: goto urk;
75: }
76: break;
77: default:
78: errorh(Vermisc,"Non-number to add",nil,0,FALSE,work);
79: }
80: }
81: if(restype==DOUB || prunep==FALSE)
82: return(result->val);
83: else if (result->val->s.CDR==(lispval) 0)
84: return(inewint(result->val->s.I));
85: else {
86: struct sdot dummybig;
87:
88: dummybig.I = 0;
89: dummybig.CDR = (lispval) 0;
90: return(adbig(&dummybig,result->val));
91: }
92: urk:
93: error("Internal error in (add,sub,quo,times)",FALSE);
94: }
95: lispval
96: Lsub()
97: {
98: register lispval work;
99: register ap result, mynp, oldnp, lbot, np;
100: int itemp,restype;
101: lispval Lminus();
102:
103: oldnp = result = np;
104: mynp = lbot + 1;
105: protect(rdrsdot);
106: rdrsdot->s.CDR = (lispval) 0;
107: rdrsdot->s.I =0;
108: restype = SDOT;
109: prunep = TRUE;
110: if(oldnp==lbot)
111: goto out;
112: if(oldnp==mynp) {
113: np--;
114: return(Lminus());
115: }
116: work = lbot->val;
117: switch(TYPE(work)) {
118: case INT:
119: rdrsdot->s.I = work->i;
120: break;
121: case SDOT:
122: result->val = adbig(result->val,work);
123: if(TYPE(result->val)==INT) {
124: rdrsdot->s.I = result->val->i;
125: result->val = rdrsdot;
126: }
127: break;
128: case DOUB:
129: (result->val = newdoub())->r = work->r;
130: restype = DOUB;
131: }
132:
133: for(; mynp < oldnp; mynp++)
134: {
135: work = mynp->val;
136: switch(TYPE(work)) {
137: case INT:
138: switch(restype) {
139: case DOUB:
140: result->val->r -= work->i;
141: break;
142: case SDOT:
143: dmlad(result->val,1, -work->i);
144: prunep = TRUE;
145: break;
146: default:
147: goto urk;
148: }
149: break;
150: case SDOT:
151: switch(restype) {
152: case DOUB:
153: errorh(Vermisc,
154: "difference: Don't know how to make bignums into reals, yet",
155: nil,FALSE,0,work);
156: break;
157: case SDOT:
158: result->val = subbig(result->val,work);
159: restype = TYPE(result->val);
160: if(restype==INT) {
161: rdrsdot->s.I=result->val->s.I;
162: rdrsdot->s.CDR = (lispval) 0;
163: result->val = rdrsdot;
164: restype=SDOT;
165: prunep = TRUE;
166: } else
167: prunep = FALSE;
168: break;
169: default:
170: goto urk;
171: }
172: break;
173: case DOUB:
174: switch(restype) {
175: case SDOT:
176: if(result->val->s.CDR==(lispval) 0) {
177: protect(newdoub());
178: np[-1].val->r = result->val->i-work->r;
179: result->val = np[-1].val;
180: np--;
181: restype = DOUB;
182: } else
183: errorh(Vermisc,
184: "difference: Don't know how to make bignums into reals ",nil,FALSE,0,work);
185: break;
186: case DOUB:
187: result->val->r -= work->r;
188: break;
189: default:
190: goto urk;
191: }
192: break;
193: default:
194: errorh(Vermisc,"Non-number to minus",nil,FALSE,0,work);
195: }
196: }
197: out:
198: if(restype==DOUB || prunep==FALSE)
199: return(result->val);
200: else if (result->val->s.CDR==(lispval) 0)
201: return(inewint(result->val->s.I));
202: else {
203: struct sdot dummybig;
204:
205: dummybig.I = 0;
206: dummybig.CDR = (lispval) 0;
207: return(adbig(&dummybig,result->val));
208: }
209: urk:
210: error("Internal error in (add,sub,quo,times)",FALSE);
211: }
212: lispval
213: Ltimes()
214: {
215: register lispval work;
216: register ap result, mynp, oldnp, lbot, np;
217: int itemp,restype;
218:
219: oldnp = result = np;
220: protect(rdrsdot);
221: rdrsdot->s.CDR = (lispval) 0;
222: rdrsdot->s.I = 1;
223: restype = SDOT;
224: prunep = TRUE;
225:
226: for(mynp = lbot; mynp < oldnp; mynp++)
227: {
228: work = mynp->val;
229: switch(TYPE(work)) {
230: case INT:
231: switch(restype) {
232: case DOUB:
233: result->val->r *= work->i;
234: break;
235: case SDOT:
236: dmlad(result->val,work->i,0);
237: prunep = TRUE;
238: break;
239: default:
240: goto urk;
241: }
242: break;
243: case SDOT:
244: switch(restype) {
245: case DOUB:
246: error("Don't know how to make bignums into reals, yet",FALSE);
247: break;
248: case SDOT:
249: result->val = mulbig(work,result->val);
250: restype = TYPE(result->val);
251: if(restype==INT) {
252: if(result->val->i==0)
253: return(result->val);
254: rdrsdot->s.I=result->val->s.I;
255: rdrsdot->s.CDR = (lispval) 0;
256: result->val = rdrsdot;
257: restype=SDOT;
258: prunep = TRUE;
259: } else
260: prunep = FALSE;
261: break;
262: default:
263: goto urk;
264: }
265: break;
266: case DOUB:
267: switch(restype) {
268: case SDOT:
269: if(result->val->s.CDR==(lispval) 0) {
270: protect(newdoub());
271: np[-1].val->r = result->val->i*work->r;
272: result->val = np[-1].val;
273: np--;
274: restype = DOUB;
275: } else
276: error("Don't know how to make bignums into reals, yet",FALSE);
277: break;
278: case DOUB:
279: result->val->r *= work->r;
280: break;
281: default:
282: goto urk;
283: }
284: break;
285: default:
286: error("Non-number to times",FALSE);
287: }
288: }
289: if(restype==DOUB || prunep==FALSE)
290: return(result->val);
291: else if (result->val->s.CDR==(lispval) 0)
292: return(inewint(result->val->s.I));
293: else {
294: struct sdot dummybig;
295:
296: dummybig.I = 0;
297: dummybig.CDR = (lispval) 0;
298: return(adbig(&dummybig,result->val));
299: }
300: urk:
301: error("Internal error in (add,sub,quo,times)",FALSE);
302: }
303: lispval
304: Lquo()
305: {
306: register lispval work;
307: register lispval result;
308: register struct argent *mynp;
309: register struct argent *oldnp, *lbot, *np;
310: int bigflag = 0, realflag = 0, itemp;
311: struct sdot dummybig;
312: lispval divbig(), *resaddr;
313:
314: mynp = lbot;
315: oldnp = np-1;
316: dummybig.CDR = (lispval) 0;
317: dummybig.I = 1;
318: if(mynp > oldnp) goto out;
319: work = (mynp++)->val;
320: itemp = TYPE(work);
321: switch(itemp) {
322: case INT:
323: if(mynp <= oldnp) dummybig.I = work->i;
324: else dummybig.I = 1/work->i;
325: break;
326: case DOUB:
327: realflag = 1;
328: protect(result = newdoub());
329: if(mynp <= oldnp) result->r = work->r;
330: else result->r = 1.0/work->r;
331: break;
332: case SDOT: /* must be fixed for the inverse case */
333: protect(work);
334: resaddr = &(np[-1].val);
335: bigflag = 1;
336: break;
337: default:
338: error("Don't know how to divide this type.",FALSE);
339: }
340: for(;mynp <= oldnp; mynp++) {
341: work = mynp->val;
342: itemp = TYPE(work);
343: switch(itemp) {
344:
345: case INT:
346: if (work->i==0)
347: kill(getpid(),8);
348: if (realflag)
349: result->r /= work->i;
350: else if(bigflag) {
351: dummybig.I = work->i;
352: divbig(*resaddr, &dummybig, resaddr, 0);
353: } else {
354: dummybig.I /= work->i;
355: }
356: break;
357: case DOUB:
358: if(realflag)
359: result->r /= work->r;
360: else if(bigflag)
361: error("Don't know how to make bignums into reals, yet",FALSE);
362: else {
363: realflag = 1;
364: result = newdoub();
365: result->r = (double) dummybig.I / work->r;
366: protect(result);
367: }
368: break;
369: case SDOT:
370: if(realflag)
371: error("Don't know how to divide reals by bignums ",FALSE);
372: else if(bigflag)
373: divbig(*resaddr, work, resaddr, 0);
374: else {
375: bigflag = 1;
376: protect(newsdot());
377: resaddr = &(np[-1].val);
378: np[-1].val->i = dummybig.I;
379: divbig(*resaddr, work, resaddr, 0);
380: }
381: break;
382: default:
383: error("Don't know how to divide this type",FALSE);
384:
385: }
386: }
387: out:
388: if(realflag)
389: return(result);
390: else if (bigflag)
391: return(*resaddr);
392: else {
393: result = inewint( dummybig.I );
394: return(result);
395: }
396: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.