Commit | Line | Data |
---|---|---|
31cef89c BJ |
1 | |
2 | static char *sccsid = "@(#)divbig.c 34.1 10/3/80"; | |
3 | ||
8cd657f4 JF |
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(); | |
31cef89c | 17 | snpand(3); |
8cd657f4 JF |
18 | |
19 | /* copy dividend */ | |
31cef89c BJ |
20 | for(work = dividend; work; work = work ->s.CDR) |
21 | stack(work->s.I); | |
8cd657f4 JF |
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 */ | |
31cef89c BJ |
34 | for(work = divisor; work; work = work->s.CDR) |
35 | stack(work->s.I); | |
8cd657f4 JF |
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 | } | |
31cef89c BJ |
95 | /* |
96 | * asm code commented out due to optimizer bug | |
97 | calqhat(ujp,v1p) | |
8cd657f4 JF |
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 | } | |
31cef89c | 114 | mlsb(utop,ubot,vtop,nqhat) |
8cd657f4 JF |
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 | } | |
31cef89c | 125 | adback(utop,ubot,vtop) |
8cd657f4 JF |
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 | } | |
31cef89c | 135 | dsdiv(top,bot,div) |
8cd657f4 JF |
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 | } | |
31cef89c | 143 | dsmult(top,bot,mult) |
8cd657f4 JF |
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 | } | |
31cef89c | 153 | lispval export(top,bot) |
8cd657f4 JF |
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 | } | |
31cef89c | 161 | */ |
8cd657f4 JF |
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(); | |
31cef89c | 194 | for(count = 0; handy->s.CDR!=((lispval) 0); handy = handy->s.CDR) |
8cd657f4 | 195 | count += 30; |
31cef89c | 196 | count += Ihau(handy->s.I); |
8cd657f4 JF |
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: | |
31cef89c BJ |
225 | for(; work!=((lispval) 0); work = work->s.CDR) |
226 | stack(work->s.I); | |
8cd657f4 JF |
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; | |
31cef89c BJ |
250 | if(n==0) return(inewint(0)); |
251 | if(n > 0) { | |
8cd657f4 JF |
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 | } |