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