![[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] / 3BSD / cmd / lisp|
Return to lam4.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / lisp |
1.1 root 1: #include "global.h"
2: #define protect(z) (np++->val = (z))
3: typedef struct argent *ap;
4: static int restype;
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;
12:
13: oldnp = result = np;
14: protect(rdrsdot);
15: rdrsdot->CDR = (lispval) 0;
16: rdrsdot->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->I=result->val->I;
47: rdrsdot->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->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: error("Non-number to add",FALSE);
79: }
80: }
81: if(restype==DOUB || prunep==FALSE)
82: return(result->val);
83: else if (result->val->CDR==(lispval) 0)
84: return(inewint(result->val->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;
101: lispval Lminus();
102:
103: oldnp = result = np;
104: mynp = lbot + 1;
105: protect(rdrsdot);
106: rdrsdot->CDR = (lispval) 0;
107: rdrsdot->I =0;
108: restype = SDOT;
109: prunep = TRUE;
110: if(oldnp==lbot)
111: goto out;
112: if(oldnp==mynp)
113: return(Lminus());
114: work = lbot->val;
115: switch(TYPE(work)) {
116: case INT:
117: rdrsdot->I = work->i;
118: break;
119: case SDOT:
120: result->val = adbig(result->val,work);
121: if(TYPE(result->val)==INT) {
122: rdrsdot->I = result->val->i;
123: result->val = rdrsdot;
124: }
125: break;
126: case DOUB:
127: (result->val = newdoub())->r = work->r;
128: restype = DOUB;
129: }
130:
131: for(; mynp < oldnp; mynp++)
132: {
133: work = mynp->val;
134: switch(TYPE(work)) {
135: case INT:
136: switch(restype) {
137: case DOUB:
138: result->val->r -= work->i;
139: break;
140: case SDOT:
141: dmlad(result->val,1, -work->i);
142: prunep = TRUE;
143: break;
144: default:
145: goto urk;
146: }
147: break;
148: case SDOT:
149: switch(restype) {
150: case DOUB:
151: error("Don't know how to make bignums into reals, yet",FALSE);
152: break;
153: case SDOT:
154: result->val = subbig(result->val,work);
155: restype = TYPE(result->val);
156: if(restype==INT) {
157: rdrsdot->I=result->val->I;
158: rdrsdot->CDR = (lispval) 0;
159: result->val = rdrsdot;
160: restype=SDOT;
161: prunep = TRUE;
162: } else
163: prunep = FALSE;
164: break;
165: default:
166: goto urk;
167: }
168: break;
169: case DOUB:
170: switch(restype) {
171: case SDOT:
172: if(result->val->CDR==(lispval) 0) {
173: protect(newdoub());
174: np[-1].val->r = result->val->i-work->r;
175: result->val = np[-1].val;
176: np--;
177: restype = DOUB;
178: } else
179: error("Don't know how to make bignums into reals, yet",FALSE);
180: break;
181: case DOUB:
182: result->val->r -= work->r;
183: break;
184: default:
185: goto urk;
186: }
187: break;
188: default:
189: error("Non-number to minus",FALSE);
190: }
191: }
192: out:
193: if(restype==DOUB || prunep==FALSE)
194: return(result->val);
195: else if (result->val->CDR==(lispval) 0)
196: return(inewint(result->val->I));
197: else {
198: struct sdot dummybig;
199:
200: dummybig.I = 0;
201: dummybig.CDR = (lispval) 0;
202: return(adbig(&dummybig,result->val));
203: }
204: urk:
205: error("Internal error in (add,sub,quo,times)",FALSE);
206: }
207: lispval
208: Ltimes()
209: {
210: register lispval work;
211: register ap result, mynp, oldnp, lbot, np;
212: int itemp;
213:
214: oldnp = result = np;
215: protect(rdrsdot);
216: rdrsdot->CDR = (lispval) 0;
217: rdrsdot->I = 1;
218: restype = SDOT;
219: prunep = TRUE;
220:
221: for(mynp = lbot; mynp < oldnp; mynp++)
222: {
223: work = mynp->val;
224: switch(TYPE(work)) {
225: case INT:
226: switch(restype) {
227: case DOUB:
228: result->val->r *= work->i;
229: break;
230: case SDOT:
231: dmlad(result->val,work->i,0);
232: prunep = TRUE;
233: break;
234: default:
235: goto urk;
236: }
237: break;
238: case SDOT:
239: switch(restype) {
240: case DOUB:
241: error("Don't know how to make bignums into reals, yet",FALSE);
242: break;
243: case SDOT:
244: result->val = mulbig(work,result->val);
245: restype = TYPE(result->val);
246: if(restype==INT) {
247: if(result->val->i==0)
248: return(result->val);
249: rdrsdot->I=result->val->I;
250: rdrsdot->CDR = (lispval) 0;
251: result->val = rdrsdot;
252: restype=SDOT;
253: prunep = TRUE;
254: } else
255: prunep = FALSE;
256: break;
257: default:
258: goto urk;
259: }
260: break;
261: case DOUB:
262: switch(restype) {
263: case SDOT:
264: if(result->val->CDR==(lispval) 0) {
265: protect(newdoub());
266: np[-1].val->r = result->val->i*work->r;
267: result->val = np[-1].val;
268: np--;
269: restype = DOUB;
270: } else
271: error("Don't know how to make bignums into reals, yet",FALSE);
272: break;
273: case DOUB:
274: result->val->r *= work->r;
275: break;
276: default:
277: goto urk;
278: }
279: break;
280: default:
281: error("Non-number to times",FALSE);
282: }
283: }
284: if(restype==DOUB || prunep==FALSE)
285: return(result->val);
286: else if (result->val->CDR==(lispval) 0)
287: return(inewint(result->val->I));
288: else {
289: struct sdot dummybig;
290:
291: dummybig.I = 0;
292: dummybig.CDR = (lispval) 0;
293: return(adbig(&dummybig,result->val));
294: }
295: urk:
296: error("Internal error in (add,sub,quo,times)",FALSE);
297: }
298: lispval
299: Lquo()
300: {
301: register lispval work;
302: register lispval result;
303: register struct argent *mynp;
304: register struct argent *oldnp, *lbot, *np;
305: int bigflag = 0, realflag = 0, itemp;
306: struct sdot dummybig;
307: lispval divbig(), *resaddr;
308:
309: mynp = lbot;
310: oldnp = np-1;
311: dummybig.CDR = (lispval) 0;
312: dummybig.I = 1;
313: if(mynp > oldnp) goto out;
314: work = (mynp++)->val;
315: itemp = TYPE(work);
316: switch(itemp) {
317: case INT:
318: dummybig.I = work->i;
319: break;
320: case DOUB:
321: realflag = 1;
322: protect(result = newdoub());
323: result->r = work->r;
324: break;
325: case SDOT:
326: protect(work);
327: resaddr = &(np[-1].val);
328: bigflag = 1;
329: break;
330: default:
331: error("Don't know how to divide this type.",FALSE);
332: }
333: for(;mynp <= oldnp; mynp++) {
334: work = mynp->val;
335: itemp = TYPE(work);
336: switch(itemp) {
337:
338: case INT:
339: if (work->i==0)
340: kill(getpid(),8);
341: if (realflag)
342: result->r /= work->i;
343: else if(bigflag) {
344: dummybig.I = work->i;
345: divbig(*resaddr, &dummybig, resaddr, 0);
346: } else {
347: dummybig.I /= work->i;
348: }
349: break;
350: case DOUB:
351: if(realflag)
352: result->r /= work->r;
353: else if(bigflag)
354: error("Don't know how to make bignums into reals, yet",FALSE);
355: else {
356: realflag = 1;
357: result = newdoub();
358: result->r = (double) dummybig.I / work->r;
359: protect(result);
360: }
361: break;
362: case SDOT:
363: if(realflag)
364: error("Don't know how to divide reals by bignums ",FALSE);
365: else if(bigflag)
366: divbig(*resaddr, work, resaddr, 0);
367: else {
368: bigflag = 1;
369: protect(newsdot());
370: resaddr = &(np[-1].val);
371: np[-1].val->i = dummybig.I;
372: divbig(*resaddr, work, resaddr, 0);
373: }
374: break;
375: default:
376: error("Don't know how to divide this type",FALSE);
377:
378: }
379: }
380: out:
381: if(realflag)
382: return(result);
383: else if (bigflag)
384: return(*resaddr);
385: else {
386: result = inewint( dummybig.I );
387: return(result);
388: }
389: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.