![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to divbig.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 divbig.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / lisp |
1.1 root 1:
2: static char *sccsid = "@(#)divbig.c 34.1 10/3/80";
3:
4: #include "global.h"
5:
6: #define b 0x40000000
7: #define toint(p) ((int) (p))
8:
9: divbig(dividend, divisor, quotient, remainder)
10: lispval dividend, divisor, *quotient, *remainder;
11: {
12: register *ujp, *vip;
13: int *sp(), *alloca(), d, negflag = 0, m, n, carry, rem, qhat, j;
14: int borrow, negrem = 0;
15: int *utop = sp(), *ubot, *vbot, *qbot;
16: register lispval work; lispval export();
17: snpand(3);
18:
19: /* copy dividend */
20: for(work = dividend; work; work = work ->s.CDR)
21: stack(work->s.I);
22: ubot = sp();
23: if(*ubot < 0) { /* knuth's division alg works only for pos
24: bignums */
25: negflag ^= 1;
26: negrem = 1;
27: dsmult(utop-1,ubot,-1);
28: }
29: stack(0);
30: ubot = sp();
31:
32:
33: /*copy divisor */
34: for(work = divisor; work; work = work->s.CDR)
35: stack(work->s.I);
36:
37: vbot = sp();
38: stack(0);
39: if(*vbot < 0) {
40: negflag ^= 1;
41: dsmult(ubot-1,vbot,-1);
42: }
43:
44: /* check validity of data */
45: n = ubot - vbot;
46: m = utop - ubot - n - 1;
47: if (n == 1) {
48: /* do destructive division by a single. */
49: rem = dsdiv(utop-1,ubot,*vbot);
50: if(negrem)
51: rem = -rem;
52: if(negflag)
53: dsmult(utop-1,ubot,-1);
54: if(remainder)
55: *remainder = inewint(rem);
56: if(quotient)
57: *quotient = export(utop,ubot);
58: return;
59: }
60: if (m < 0) {
61: if (remainder)
62: *remainder = dividend;
63: if(quotient)
64: *quotient = inewint(0);
65: return;
66: }
67: qbot = alloca(toint(utop) + toint(vbot) - 2 * toint(ubot));
68: d1:
69: d = b /(*vbot +1);
70: dsmult(utop-1,ubot,d);
71: dsmult(ubot-1,vbot,d);
72:
73: d2: for(j=0,ujp=ubot; j <= m; j++,ujp++) {
74:
75: d3:
76: qhat = calqhat(ujp,vbot);
77: d4:
78: if((borrow = mlsb(ujp + n, ujp, ubot, -qhat)) < 0) {
79: adback(ujp + n, ujp, ubot);
80: qhat--;
81: }
82: qbot[j] = qhat;
83: }
84: d8: if(remainder) {
85: dsdiv(utop, utop - n, d);
86: if(negrem) dsmult(utop-1,utop-n,-1);
87: *remainder = export(utop,utop-n);
88: }
89: if(quotient) {
90: if(negflag)
91: dsmult(qbot+m,qbot,-1);
92: *quotient = export(qbot + m + 1, qbot);
93: }
94: }
95: /*
96: * asm code commented out due to optimizer bug
97: calqhat(ujp,v1p)
98: register int *ujp, *v1p;
99: {
100: asm(" movl $0x3fffffff,r0");
101: asm(" cmpl (r10),(r11)");
102: asm(" beql on1");
103: asm(" emul (r11),$0x40000000,4(r11),r1");
104: asm(" ediv (r10),r1,r0,r5");
105: asm("on1:");
106: asm(" emul r0,4(r10),$0,r1");
107: asm(" emul r5,$0x40000000,8(r11),r3");
108: asm(" subl2 r3,r1");
109: asm(" sbwc r4,r2");
110: asm(" bleq out1");
111: asm(" decl r0");
112: asm("out1:");
113: }
114: mlsb(utop,ubot,vtop,nqhat)
115: register int *utop, *ubot, *vtop;
116: register int nqhat;
117: {
118: asm(" clrl r0");
119: asm("loop2: addl2 (r11),r0");
120: asm(" emul r8,-(r9),r0,r2");
121: asm(" extzv $0,$30,r2,(r11)");
122: asm(" extv $30,$32,r2,r0");
123: asm(" acbl r10,$-4,r11,loop2");
124: }
125: adback(utop,ubot,vtop)
126: register int *utop, *ubot, *vtop;
127: {
128: asm(" clrl r0");
129: asm("loop3: addl2 -(r9),r0");
130: asm(" addl2 (r11),r0");
131: asm(" extzv $0,$30,r0,(r11)");
132: asm(" extv $30,$2,r0,r0");
133: asm(" acbl r10,$-4,r11,loop3");
134: }
135: dsdiv(top,bot,div)
136: register int* bot;
137: {
138: asm(" clrl r0");
139: asm("loop4: emul r0,$0x40000000,(r11),r1");
140: asm(" ediv 12(ap),r1,(r11),r0");
141: asm(" acbl 4(ap),$4,r11,loop4");
142: }
143: dsmult(top,bot,mult)
144: register int* top;
145: {
146: asm(" clrl r0");
147: asm("loop5: emul 12(ap),(r11),r0,r1");
148: asm(" extzv $0,$30,r1,(r11)");
149: asm(" extv $30,$32,r1,r0");
150: asm(" acbl 8(ap),$-4,r11,loop5");
151: asm(" movl r1,4(r11)");
152: }
153: lispval export(top,bot)
154: register lispval bot;
155: {
156: register r10, r9, r8, r7, r6;
157: asm(" movl 4(ap),r10");
158: asm(" movl $0xC0000000,r4");
159: asm(" jmp Bexport");
160: }
161: */
162:
163: #define MAXINT 0x8000000L
164:
165: Ihau(fix)
166: register int fix;
167: {
168: register count;
169: if(fix==MAXINT)
170: return(32);
171: if(fix < 0)
172: fix = -fix;
173: for(count = 0; fix; count++)
174: fix /= 2;
175: return(count);
176: }
177: lispval
178: Lhau()
179: {
180: register count;
181: register lispval handy;
182: register dum1,dum2;
183: register struct argent *lbot, *np;
184: lispval Labsval();
185:
186: handy = lbot->val;
187: top:
188: switch(TYPE(handy)) {
189: case INT:
190: count = Ihau(handy->i);
191: break;
192: case SDOT:
193: lbot->val = Labsval();
194: for(count = 0; handy->s.CDR!=((lispval) 0); handy = handy->s.CDR)
195: count += 30;
196: count += Ihau(handy->s.I);
197: break;
198: default:
199: handy = errorh(Vermisc,"Haulong: bad argument",nil,
200: TRUE,997,handy);
201: goto top;
202: }
203: return(inewint(count));
204: }
205: lispval
206: Lhaipar()
207: {
208: int *sp();
209: register lispval work;
210: register n;
211: register int *top = sp() - 1;
212: register int *bot;
213: register struct argent *lbot, *np;
214: int mylen;
215:
216: /*chkarg(2);*/
217: work = lbot->val;
218: /* copy data onto stack */
219: on1:
220: switch(TYPE(work)) {
221: case INT:
222: stack(work->i);
223: break;
224: case SDOT:
225: for(; work!=((lispval) 0); work = work->s.CDR)
226: stack(work->s.I);
227: break;
228: default:
229: work = errorh(Vermisc,"Haipart: bad first argument",nil,
230: TRUE,996,work);
231: goto on1;
232: }
233: bot = sp();
234: if(*bot < 0) {
235: stack(0);
236: dsmult(top,bot,-1);
237: bot--;
238: }
239: for(; *bot==0 && bot < top; bot++);
240: /* recalculate haulong internally */
241: mylen = (top - bot) * 30 + Ihau(*bot);
242: /* get second argument */
243: work = lbot[1].val;
244: while(TYPE(work)!=INT)
245: work = errorh(Vermisc,"Haipart: 2nd arg not int",nil,
246: TRUE,995,work);
247: n = work->i;
248: if(n >= mylen || -n >= mylen)
249: goto done;
250: if(n==0) return(inewint(0));
251: if(n > 0) {
252: /* Here we want n most significant bits
253: so chop off mylen - n bits */
254: stack(0);
255: n = mylen - n;
256: for(n; n >= 30; n -= 30)
257: top--;
258: if(top < bot)
259: error("Internal error in haipart #1",FALSE);
260: dsdiv(top,bot,1<<n);
261:
262: } else {
263: /* here we want abs(n) low order bits */
264: stack(0);
265: bot = top + 1;
266: for(; n <= 0; n += 30)
267: bot--;
268: n = 30 - n;
269: *bot &= ~ (-1<<n);
270: }
271: done:
272: return(export(top + 1,bot));
273: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.