URL https://opencores.org/ocsvn/eco32/eco32/trunk

Subversion Repositories eco32

[/] [eco32/] [trunk/] [fp/] [implementation/] [arith/] [mmix-arith.c] - Blame information for rev 198

Go to most recent revision | Details | Compare with Previous | View Log

Line No.	Rev	Author	Line
1	15	hellwig	`#define sign_bit ((unsigned) 0x80000000) \`
2
3			`#define ROUND_OFF 1`
4			`#define ROUND_UP 2`
5			`#define ROUND_DOWN 3`
6			`#define ROUND_NEAR 4 \`
7
8			`#define X_BIT (1<<8)`
9			`#define Z_BIT (1<<9)`
10			`#define U_BIT (1<<10)`
11			`#define O_BIT (1<<11)`
12			`#define I_BIT (1<<12)`
13			`#define W_BIT (1<<13)`
14			`#define V_BIT (1<<14)`
15			`#define D_BIT (1<<15)`
16			`#define E_BIT (1<<18) \`
17
18			`#define zero_exponent (-1000) \`
19
20			`#define bignum_prec 157 \`
21
22			`#define magic_offset 2112`
23			`#define origin 37 \`
24
25			`#define buf0 (buf+8)`
26			`#define buf_max (buf+777) \`
27
28			`/1:/`
29			`#line 32 "./mmix-arith.w"`
30
31			`#include <stdio.h>`
32			`#include <string.h>`
33			`#include <ctype.h>`
34			`/2:/`
35			`#line 49 "./mmix-arith.w"`
36
37			`#ifdef __STDC__`
38			`#define ARGS(list) list`
39			`#else`
40			`#define ARGS(list) ()`
41			`#endif`
42
43			`/:2/`
44			`#line 36 "./mmix-arith.w"`
45
46			`typedef enum{false,true}bool;`
47			`/3:/`
48			`#line 60 "./mmix-arith.w"`
49
50			`typedef unsigned int tetra;`
51
52			`typedef struct{tetra h,l;}octa;`
53
54			`/:3/`
55			`#line 38 "./mmix-arith.w"`
56
57			`/36:/`
58			`#line 605 "./mmix-arith.w"`
59
60			`typedef enum{zro,num,inf,nan}ftype;`
61
62			`/:36//59:/`
63			`#line 1110 "./mmix-arith.w"`
64
65			`typedef struct{`
66			`int a;`
67			`int b;`
68			`tetra dat[bignum_prec];`
69			`}bignum;`
70
71			`/:59/`
72			`#line 39 "./mmix-arith.w"`
73
74			`/4:/`
75			`#line 67 "./mmix-arith.w"`
76
77			`octa zero_octa;`
78			`octa neg_one= {-1,-1};`
79			`octa inf_octa= {0x7ff00000,0};`
80			`octa standard_NaN= {0x7ff80000,0};`
81			`octa aux;`
82			`bool overflow;`
83
84			`/:4//9:/`
85			`#line 174 "./mmix-arith.w"`
86
87			`extern octa aux;`
88			`extern bool overflow;`
89
90			`/:9//30:/`
91			`#line 464 "./mmix-arith.w"`
92
93			`int cur_round;`
94
95			`/:30//32:/`
96			`#line 528 "./mmix-arith.w"`
97
98			`int exceptions;`
99
100			`/:32//69:/`
101			`#line 1359 "./mmix-arith.w"`
102
103			`octa val;`
104			`char*next_char;`
105
106			`/:69//75:/`
107			`#line 1432 "./mmix-arith.w"`
108
109			`static char buf[785]= "00000000";`
110
111			`/:75/`
112			`#line 40 "./mmix-arith.w"`
113
114			`/5:/`
115			`#line 78 "./mmix-arith.w"`
116
117			`octa oplus ARGS((octa,octa));`
118			`octa oplus(y,z)`
119			`octa y,z;`
120			`{octa x;`
121			`x.h= y.h+z.h;`
122			`x.l= y.l+z.l;`
123			`if(x.l<y.l)x.h++;`
124			`return x;`
125			`}`
126
127			`octa ominus ARGS((octa,octa));`
128			`octa ominus(y,z)`
129			`octa y,z;`
130			`{octa x;`
131			`x.h= y.h-z.h;`
132			`x.l= y.l-z.l;`
133			`if(x.l> y.l)x.h--;`
134			`return x;`
135			`}`
136
137			`/:5//6:/`
138			`#line 102 "./mmix-arith.w"`
139
140			`octa incr ARGS((octa,int));`
141			`octa incr(y,delta)`
142			`octa y;`
143			`int delta;`
144			`{octa x;`
145			`x.h= y.h;x.l= y.l+delta;`
146			`if(delta>=0){`
147			`if(x.l<y.l)x.h++;`
148			`}else if(x.l> y.l)x.h--;`
149			`return x;`
150			`}`
151
152			`/:6//7:/`
153			`#line 117 "./mmix-arith.w"`
154
155			`octa shift_left ARGS((octa,int));`
156			`octa shift_left(y,s)`
157			`octa y;`
158			`int s;`
159			`{`
160			`while(s>=32)y.h= y.l,y.l= 0,s-= 32;`
161			`if(s){register tetra yhl= y.h<<s,ylh= y.l>>(32-s);`
162			`y.h= yhl+ylh;y.l<<= s;`
163			`}`
164			`return y;`
165			`}`
166
167			`octa shift_right ARGS((octa,int,int));`
168			`octa shift_right(y,s,u)`
169			`octa y;`
170			`int s,u;`
171			`{`
172			`while(s>=32)y.l= y.h,y.h= (u?0:-(y.h>>31)),s-= 32;`
173			`if(s){register tetra yhl= y.h<<(32-s),ylh= y.l>>s;`
174			`y.h= (u?0:(-(y.h>>31))<<(32-s))+(y.h>>s);y.l= yhl+ylh;`
175			`}`
176			`return y;`
177			`}`
178
179			`/:7//8:/`
180			`#line 150 "./mmix-arith.w"`
181
182			`octa omult ARGS((octa,octa));`
183			`octa omult(y,z)`
184			`octa y,z;`
185			`{`
186			`register int i,j,k;`
187			`tetra u[4],v[4],w[8];`
188			`register tetra t;`
189			`octa acc;`
190			`/10:/`
191			`#line 178 "./mmix-arith.w"`
192
193			`u[3]= y.h>>16,u[2]= y.h&0xffff,u[1]= y.l>>16,u[0]= y.l&0xffff;`
194			`v[3]= z.h>>16,v[2]= z.h&0xffff,v[1]= z.l>>16,v[0]= z.l&0xffff;`
195
196			`/:10/`
197			`#line 159 "./mmix-arith.w"`
198			`;`
199			`for(j= 0;j<4;j++)w[j]= 0;`
200			`for(j= 0;j<4;j++)`
201			`if(!v[j])w[j+4]= 0;`
202			`else{`
203			`for(i= k= 0;i<4;i++){`
204			`t= u[i]*v[j]+w[i+j]+k;`
205			`w[i+j]= t&0xffff,k= t>>16;`
206			`}`
207			`w[j+4]= k;`
208			`}`
209			`/11:/`
210			`#line 182 "./mmix-arith.w"`
211
212			`aux.h= (w[7]<<16)+w[6],aux.l= (w[5]<<16)+w[4];`
213			`acc.h= (w[3]<<16)+w[2],acc.l= (w[1]<<16)+w[0];`
214
215			`/:11/`
216			`#line 170 "./mmix-arith.w"`
217			`;`
218			`return acc;`
219			`}`
220
221			`/:8//12:/`
222			`#line 191 "./mmix-arith.w"`
223
224			`octa signed_omult ARGS((octa,octa));`
225			`octa signed_omult(y,z)`
226			`octa y,z;`
227			`{`
228			`octa acc;`
229			`acc= omult(y,z);`
230			`if(y.h&sign_bit)aux= ominus(aux,z);`
231			`if(z.h&sign_bit)aux= ominus(aux,y);`
232			`overflow= (aux.h!=aux.l\|\|(aux.h^(aux.h>>1)^(acc.h&sign_bit)));`
233			`return acc;`
234			`}`
235
236			`/:12//13:/`
237			`#line 215 "./mmix-arith.w"`
238
239			`octa odiv ARGS((octa,octa,octa));`
240			`octa odiv(x,y,z)`
241			`octa x,y,z;`
242			`{`
243			`register int i,j,k,n,d;`
244			`tetra u[8],v[4],q[4],mask,qhat,rhat,vh,vmh;`
245			`register tetra t;`
246			`octa acc;`
247			`/14:/`
248			`#line 234 "./mmix-arith.w"`
249
250			`if(x.h> z.h\|\|(x.h==z.h&&x.l>=z.l)){`
251			`aux= y;return x;`
252			`}`
253
254			`/:14/`
255			`#line 224 "./mmix-arith.w"`
256			`;`
257			`/15:/`
258			`#line 239 "./mmix-arith.w"`
259
260			`u[7]= x.h>>16,u[6]= x.h&0xffff,u[5]= x.l>>16,u[4]= x.l&0xffff;`
261			`u[3]= y.h>>16,u[2]= y.h&0xffff,u[1]= y.l>>16,u[0]= y.l&0xffff;`
262			`v[3]= z.h>>16,v[2]= z.h&0xffff,v[1]= z.l>>16,v[0]= z.l&0xffff;`
263
264			`/:15/`
265			`#line 225 "./mmix-arith.w"`
266			`;`
267			`/16:/`
268			`#line 244 "./mmix-arith.w"`
269
270			`for(n= 4;v[n-1]==0;n--);`
271
272			`/:16/`
273			`#line 226 "./mmix-arith.w"`
274			`;`
275			`/17:/`
276			`#line 250 "./mmix-arith.w"`
277
278			`vh= v[n-1];`
279			`for(d= 0;vh<0x8000;d++,vh<<= 1);`
280			`for(j= k= 0;j<n+4;j++){`
281			`t= (u[j]<<d)+k;`
282			`u[j]= t&0xffff,k= t>>16;`
283			`}`
284			`for(j= k= 0;j<n;j++){`
285			`t= (v[j]<<d)+k;`
286			`v[j]= t&0xffff,k= t>>16;`
287			`}`
288			`vh= v[n-1];`
289			`vmh= (n> 1?v[n-2]:0);`
290
291			`/:17/`
292			`#line 227 "./mmix-arith.w"`
293			`;`
294			`for(j= 3;j>=0;j--)/20:/`
295			`#line 276 "./mmix-arith.w"`
296
297			`{`
298			`/21:/`
299			`#line 284 "./mmix-arith.w"`
300
301			`t= (u[j+n]<<16)+u[j+n-1];`
302			`qhat= t/vh,rhat= t-vh*qhat;`
303			`if(n> 1)while(qhat==0x10000\|\|qhat*vmh> (rhat<<16)+u[j+n-2]){`
304			`qhat--,rhat+= vh;`
305			`if(rhat>=0x10000)break;`
306			`}`
307
308			`/:21/`
309			`#line 278 "./mmix-arith.w"`
310			`;`
311			`/22:/`
312			`#line 296 "./mmix-arith.w"`
313
314			`for(i= k= 0;i<n;i++){`
315			`t= u[i+j]+0xffff0000-k-qhat*v[i];`
316			`u[i+j]= t&0xffff,k= 0xffff-(t>>16);`
317			`}`
318
319			`/:22/`
320			`#line 279 "./mmix-arith.w"`
321			`;`
322			`/23:/`
323			`#line 305 "./mmix-arith.w"`
324
325			`if(u[j+n]!=k){`
326			`qhat--;`
327			`for(i= k= 0;i<n;i++){`
328			`t= u[i+j]+v[i]+k;`
329			`u[i+j]= t&0xffff,k= t>>16;`
330			`}`
331			`}`
332
333			`/:23/`
334			`#line 280 "./mmix-arith.w"`
335			`;`
336			`q[j]= qhat;`
337			`}`
338
339			`/:20/`
340			`#line 228 "./mmix-arith.w"`
341			`;`
342			`/18:/`
343			`#line 264 "./mmix-arith.w"`
344
345			`mask= (1<<d)-1;`
346			`for(j= 3;j>=n;j--)u[j]= 0;`
347			`for(k= 0;j>=0;j--){`
348			`t= (k<<16)+u[j];`
349			`u[j]= t>>d,k= t&mask;`
350			`}`
351
352			`/:18/`
353			`#line 229 "./mmix-arith.w"`
354			`;`
355			`/19:/`
356			`#line 272 "./mmix-arith.w"`
357
358			`acc.h= (q[3]<<16)+q[2],acc.l= (q[1]<<16)+q[0];`
359			`aux.h= (u[3]<<16)+u[2],aux.l= (u[1]<<16)+u[0];`
360
361			`/:19/`
362			`#line 230 "./mmix-arith.w"`
363			`;`
364			`return acc;`
365			`}`
366
367			`/:13//24:/`
368			`#line 317 "./mmix-arith.w"`
369
370			`octa signed_odiv ARGS((octa,octa));`
371			`octa signed_odiv(y,z)`
372			`octa y,z;`
373			`{`
374			`octa yy,zz,q;`
375			`register int sy,sz;`
376			`if(y.h&sign_bit)sy= 2,yy= ominus(zero_octa,y);`
377			`else sy= 0,yy= y;`
378			`if(z.h&sign_bit)sz= 1,zz= ominus(zero_octa,z);`
379			`else sz= 0,zz= z;`
380			`q= odiv(zero_octa,yy,zz);`
381			`overflow= false;`
382			`switch(sy+sz){`
383			`case 2+1:aux= ominus(zero_octa,aux);`
384			`if(q.h==sign_bit)overflow= true;`
385			`case 0+0:return q;`
386			`case 2+0:if(aux.h\|\|aux.l)aux= ominus(zz,aux);`
387			`goto negate_q;`
388			`case 0+1:if(aux.h\|\|aux.l)aux= ominus(aux,zz);`
389			`negate_q:if(aux.h\|\|aux.l)return ominus(neg_one,q);`
390			`else return ominus(zero_octa,q);`
391			`}`
392			`}`
393
394			`/:24//25:/`
395			`#line 346 "./mmix-arith.w"`
396
397			`octa oand ARGS((octa,octa));`
398			`octa oand(y,z)`
399			`octa y,z;`
400			`{octa x;`
401			`x.h= y.h&z.h;x.l= y.l&z.l;`
402			`return x;`
403			`}`
404
405			`octa oandn ARGS((octa,octa));`
406			`octa oandn(y,z)`
407			`octa y,z;`
408			`{octa x;`
409			`x.h= y.h&~z.h;x.l= y.l&~z.l;`
410			`return x;`
411			`}`
412
413			`octa oxor ARGS((octa,octa));`
414			`octa oxor(y,z)`
415			`octa y,z;`
416			`{octa x;`
417			`x.h= y.h^z.h;x.l= y.l^z.l;`
418			`return x;`
419			`}`
420
421			`/:25//26:/`
422			`#line 387 "./mmix-arith.w"`
423
424			`int count_bits ARGS((tetra));`
425			`int count_bits(x)`
426			`tetra x;`
427			`{`
428			`register int xx= x;`
429			`xx= xx-((xx>>1)&0x55555555);`
430			`xx= (xx&0x33333333)+((xx>>2)&0x33333333);`
431			`xx= (xx+(xx>>4))&0x0f0f0f0f;`
432			`xx= xx+(xx>>8);`
433			`return(xx+(xx>>16))&0xff;`
434			`}`
435
436			`/:26//27:/`
437			`#line 403 "./mmix-arith.w"`
438
439			`tetra byte_diff ARGS((tetra,tetra));`
440			`tetra byte_diff(y,z)`
441			`tetra y,z;`
442			`{`
443			`register tetra d= (y&0x00ff00ff)+0x01000100-(z&0x00ff00ff);`
444			`register tetra m= d&0x01000100;`
445			`register tetra x= d&(m-(m>>8));`
446			`d= ((y>>8)&0x00ff00ff)+0x01000100-((z>>8)&0x00ff00ff);`
447			`m= d&0x01000100;`
448			`return x+((d&(m-(m>>8)))<<8);`
449			`}`
450
451			`/:27//28:/`
452			`#line 421 "./mmix-arith.w"`
453
454			`tetra wyde_diff ARGS((tetra,tetra));`
455			`tetra wyde_diff(y,z)`
456			`tetra y,z;`
457			`{`
458			`register tetra a= ((y>>16)-(z>>16))&0x10000;`
459			`register tetra b= ((y&0xffff)-(z&0xffff))&0x10000;`
460			`return y-(z^((y^z)&(b-a-(b>>16))));`
461			`}`
462
463			`/:28//29:/`
464			`#line 434 "./mmix-arith.w"`
465
466			`octa bool_mult ARGS((octa,octa,bool));`
467			`octa bool_mult(y,z,xor)`
468			`octa y,z;`
469			`bool xor;`
470			`{`
471			`octa o,x;`
472			`register tetra a,b,c;`
473			`register int k;`
474			`for(k= 0,o= y,x= zero_octa;o.h\|\|o.l;k++,o= shift_right(o,8,1))`
475			`if(o.l&0xff){`
476			`a= ((z.h>>k)&0x01010101)*0xff;`
477			`b= ((z.l>>k)&0x01010101)*0xff;`
478			`c= (o.l&0xff)*0x01010101;`
479			`if(xor)x.h^= a&c,x.l^= b&c;`
480			`else x.h\|= a&c,x.l\|= b&c;`
481			`}`
482			`return x;`
483			`}`
484
485			`/:29//31:/`
486			`#line 503 "./mmix-arith.w"`
487
488			`octa fpack ARGS((octa,int,char,int));`
489			`octa fpack(f,e,s,r)`
490			`octa f;`
491			`int e;`
492			`char s;`
493			`int r;`
494			`{`
495			`octa o;`
496			`if(e> 0x7fd)e= 0x7ff,o= zero_octa;`
497			`else{`
498			`if(e<0){`
499			`if(e<-54)o.h= 0,o.l= 1;`
500			`else{octa oo;`
501			`o= shift_right(f,-e,1);`
502			`oo= shift_left(o,-e);`
503			`if(oo.l!=f.l\|\|oo.h!=f.h)o.l\|= 1;`
504
505			`}`
506			`e= 0;`
507			`}else o= f;`
508			`}`
509			`/33:/`
510			`#line 533 "./mmix-arith.w"`
511
512			`if(o.l&3)exceptions\|= X_BIT;`
513			`switch(r){`
514			`case ROUND_DOWN:if(s=='-')o= incr(o,3);break;`
515			`case ROUND_UP:if(s!='-')o= incr(o,3);`
516			`case ROUND_OFF:break;`
517			`case ROUND_NEAR:o= incr(o,o.l&4?2:1);break;`
518			`}`
519			`o= shift_right(o,2,1);`
520			`o.h+= e<<20;`
521			`if(o.h>=0x7ff00000)exceptions\|= O_BIT+X_BIT;`
522			`else if(o.h<0x100000)exceptions\|= U_BIT;`
523			`if(s=='-')o.h\|= sign_bit;`
524			`return o;`
525
526			`/:33/`
527			`#line 525 "./mmix-arith.w"`
528			`;`
529			`}`
530
531			`/:31//34:/`
532			`#line 551 "./mmix-arith.w"`
533
534			`tetra sfpack ARGS((octa,int,char,int));`
535			`tetra sfpack(f,e,s,r)`
536			`octa f;`
537			`int e;`
538			`char s;`
539			`int r;`
540			`{`
541			`register tetra o;`
542			`if(e> 0x47d)e= 0x47f,o= 0;`
543			`else{`
544			`o= shift_left(f,3).h;`
545			`if(f.l&0x1fffffff)o\|= 1;`
546			`if(e<0x380){`
547			`if(e<0x380-25)o= 1;`
548			`else{register tetra o0,oo;`
549			`o0= o;`
550			`o= o>>(0x380-e);`
551			`oo= o<<(0x380-e);`
552			`if(oo!=o0)o\|= 1;`
553
554			`}`
555			`e= 0x380;`
556			`}`
557			`}`
558			`/35:/`
559			`#line 579 "./mmix-arith.w"`
560
561			`if(o&3)exceptions\|= X_BIT;`
562			`switch(r){`
563			`case ROUND_DOWN:if(s=='-')o+= 3;break;`
564			`case ROUND_UP:if(s!='-')o+= 3;`
565			`case ROUND_OFF:break;`
566			`case ROUND_NEAR:o+= (o&4?2:1);break;`
567			`}`
568			`o= o>>2;`
569			`o+= (e-0x380)<<23;`
570			`if(o>=0x7f800000)exceptions\|= O_BIT+X_BIT;`
571			`else if(o<0x100000)exceptions\|= U_BIT;`
572			`if(s=='-')o\|= sign_bit;`
573			`return o;`
574
575			`/:35/`
576			`#line 576 "./mmix-arith.w"`
577			`;`
578			`}`
579
580			`/:34//37:/`
581			`#line 608 "./mmix-arith.w"`
582
583			`ftype funpack ARGS((octa,octa,int,char*));`
584			`ftype funpack(x,f,e,s)`
585			`octa x;`
586			`octa*f;`
587			`int*e;`
588			`char*s;`
589			`{`
590			`register int ee;`
591			`exceptions= 0;`
592			`*s= (x.h&sign_bit?'-':'+');`
593			`*f= shift_left(x,2);`
594			`f->h&= 0x3fffff;`
595			`ee= (x.h>>20)&0x7ff;`
596			`if(ee){`
597			`*e= ee-1;`
598			`f->h\|= 0x400000;`
599			`return(ee<0x7ff?num:f->h==0x400000&&!f->l?inf:nan);`
600			`}`
601			`if(!x.l&&!f->h){`
602			`*e= zero_exponent;return zro;`
603			`}`
604			`do{ee--;f= shift_left(f,1);}while(!(f->h&0x400000));`
605			`*e= ee;return num;`
606			`}`
607
608			`/:37//38:/`
609			`#line 634 "./mmix-arith.w"`
610
611			`ftype sfunpack ARGS((tetra,octa,int,char*));`
612			`ftype sfunpack(x,f,e,s)`
613			`tetra x;`
614			`octa*f;`
615			`int*e;`
616			`char*s;`
617			`{`
618			`register int ee;`
619			`exceptions= 0;`
620			`*s= (x&sign_bit?'-':'+');`
621			`f->h= (x>>1)&0x3fffff,f->l= x<<31;`
622			`ee= (x>>23)&0xff;`
623			`if(ee){`
624			`*e= ee+0x380-1;`
625			`f->h\|= 0x400000;`
626			`return(ee<0xff?num:(x&0x7fffffff)==0x7f800000?inf:nan);`
627			`}`
628			`if(!(x&0x7fffffff)){`
629			`*e= zero_exponent;return zro;`
630			`}`
631			`do{ee--;f= shift_left(f,1);}while(!(f->h&0x400000));`
632			`*e= ee+0x380;return num;`
633			`}`
634
635			`/:38//39:/`
636			`#line 663 "./mmix-arith.w"`
637
638			`octa load_sf ARGS((tetra));`
639			`octa load_sf(z)`
640			`tetra z;`
641			`{`
642			`octa f,x;int e;char s;ftype t;`
643			`t= sfunpack(z,&f,&e,&s);`
644			`switch(t){`
645			`case zro:x= zero_octa;break;`
646			`case num:return fpack(f,e,s,ROUND_OFF);`
647			`case inf:x= inf_octa;break;`
648			`case nan:x= shift_right(f,2,1);x.h\|= 0x7ff00000;break;`
649			`}`
650			`if(s=='-')x.h\|= sign_bit;`
651			`return x;`
652			`}`
653
654			`/:39//40:/`
655			`#line 680 "./mmix-arith.w"`
656
657			`tetra store_sf ARGS((octa));`
658			`tetra store_sf(x)`
659			`octa x;`
660			`{`
661			`octa f;tetra z;int e;char s;ftype t;`
662			`t= funpack(x,&f,&e,&s);`
663			`switch(t){`
664			`case zro:z= 0;break;`
665			`case num:return sfpack(f,e,s,cur_round);`
666			`case inf:z= 0x7f800000;break;`
667			`case nan:if(!(f.h&0x200000)){`
668			`f.h\|= 0x200000;exceptions\|= I_BIT;`
669			`}`
670			`z= 0x7f800000\|(f.h<<1)\|(f.l>>31);break;`
671			`}`
672			`if(s=='-')z\|= sign_bit;`
673			`return z;`
674			`}`
675
676			`/:40//41:/`
677			`#line 705 "./mmix-arith.w"`
678
679			`octa fmult ARGS((octa,octa));`
680			`octa fmult(y,z)`
681			`octa y,z;`
682			`{`
683			`ftype yt,zt;`
684			`int ye,ze;`
685			`char ys,zs;`
686			`octa x,xf,yf,zf;`
687			`register int xe;`
688			`register char xs;`
689			`yt= funpack(y,&yf,&ye,&ys);`
690			`zt= funpack(z,&zf,&ze,&zs);`
691			`xs= ys+zs-'+';`
692			`switch(4*yt+zt){`
693			`/42:/`
694			`#line 731 "./mmix-arith.w"`
695
696			`case 4*nan+nan:if(!(y.h&0x80000))exceptions\|= I_BIT;`
697			`case 4zro+nan:case 4num+nan:case 4*inf+nan:`
698			`if(!(z.h&0x80000))exceptions\|= I_BIT,z.h\|= 0x80000;`
699			`return z;`
700			`case 4nan+zro:case 4nan+num:case 4*nan+inf:`
701			`if(!(y.h&0x80000))exceptions\|= I_BIT,y.h\|= 0x80000;`
702			`return y;`
703
704			`/:42/`
705			`#line 720 "./mmix-arith.w"`
706			`;`
707			`case 4zro+zro:case 4zro+num:case 4*num+zro:x= zero_octa;break;`
708			`case 4num+inf:case 4inf+num:case 4*inf+inf:x= inf_octa;break;`
709			`case 4zro+inf:case 4inf+zro:x= standard_NaN;`
710			`exceptions\|= I_BIT;break;`
711			`case 4num+num:/43:*/`
712			`#line 740 "./mmix-arith.w"`
713
714			`xe= ye+ze-0x3fd;`
715			`x= omult(yf,shift_left(zf,9));`
716			`if(aux.h>=0x400000)xf= aux;`
717			`else xf= shift_left(aux,1),xe--;`
718			`if(x.h\|\|x.l)xf.l\|= 1;`
719			`return fpack(xf,xe,xs,cur_round);`
720
721			`/:43/`
722			`#line 725 "./mmix-arith.w"`
723			`;`
724			`}`
725			`if(xs=='-')x.h\|= sign_bit;`
726			`return x;`
727			`}`
728
729			`/:41//44:/`
730			`#line 748 "./mmix-arith.w"`
731
732			`octa fdivide ARGS((octa,octa));`
733			`octa fdivide(y,z)`
734			`octa y,z;`
735			`{`
736			`ftype yt,zt;`
737			`int ye,ze;`
738			`char ys,zs;`
739			`octa x,xf,yf,zf;`
740			`register int xe;`
741			`register char xs;`
742			`yt= funpack(y,&yf,&ye,&ys);`
743			`zt= funpack(z,&zf,&ze,&zs);`
744			`xs= ys+zs-'+';`
745			`switch(4*yt+zt){`
746			`/42:/`
747			`#line 731 "./mmix-arith.w"`
748
749			`case 4*nan+nan:if(!(y.h&0x80000))exceptions\|= I_BIT;`
750			`case 4zro+nan:case 4num+nan:case 4*inf+nan:`
751			`if(!(z.h&0x80000))exceptions\|= I_BIT,z.h\|= 0x80000;`
752			`return z;`
753			`case 4nan+zro:case 4nan+num:case 4*nan+inf:`
754			`if(!(y.h&0x80000))exceptions\|= I_BIT,y.h\|= 0x80000;`
755			`return y;`
756
757			`/:42/`
758			`#line 763 "./mmix-arith.w"`
759			`;`
760			`case 4zro+inf:case 4zro+num:case 4*num+inf:x= zero_octa;break;`
761			`case 4*num+zro:exceptions\|= Z_BIT;`
762			`case 4inf+num:case 4inf+zro:x= inf_octa;break;`
763			`case 4zro+zro:case 4inf+inf:x= standard_NaN;`
764			`exceptions\|= I_BIT;break;`
765			`case 4num+num:/45:*/`
766			`#line 775 "./mmix-arith.w"`
767
768			`xe= ye-ze+0x3fd;`
769			`xf= odiv(yf,zero_octa,shift_left(zf,9));`
770			`if(xf.h>=0x800000){`
771			`aux.l\|= xf.l&1;`
772			`xf= shift_right(xf,1,1);`
773			`xe++;`
774			`}`
775			`if(aux.h\|\|aux.l)xf.l\|= 1;`
776			`return fpack(xf,xe,xs,cur_round);`
777
778			`/:45/`
779			`#line 769 "./mmix-arith.w"`
780			`;`
781			`}`
782			`if(xs=='-')x.h\|= sign_bit;`
783			`return x;`
784			`}`
785
786			`/:44//46:/`
787			`#line 790 "./mmix-arith.w"`
788
789			`octa fplus ARGS((octa,octa));`
790			`octa fplus(y,z)`
791			`octa y,z;`
792			`{`
793			`ftype yt,zt;`
794			`int ye,ze;`
795			`char ys,zs;`
796			`octa x,xf,yf,zf;`
797			`register int xe,d;`
798			`register char xs;`
799			`yt= funpack(y,&yf,&ye,&ys);`
800			`zt= funpack(z,&zf,&ze,&zs);`
801			`switch(4*yt+zt){`
802			`/42:/`
803			`#line 731 "./mmix-arith.w"`
804
805			`case 4*nan+nan:if(!(y.h&0x80000))exceptions\|= I_BIT;`
806			`case 4zro+nan:case 4num+nan:case 4*inf+nan:`
807			`if(!(z.h&0x80000))exceptions\|= I_BIT,z.h\|= 0x80000;`
808			`return z;`
809			`case 4nan+zro:case 4nan+num:case 4*nan+inf:`
810			`if(!(y.h&0x80000))exceptions\|= I_BIT,y.h\|= 0x80000;`
811			`return y;`
812
813			`/:42/`
814			`#line 804 "./mmix-arith.w"`
815			`;`
816			`case 4*zro+num:return fpack(zf,ze,zs,ROUND_OFF);break;`
817			`case 4*num+zro:return fpack(yf,ye,ys,ROUND_OFF);break;`
818			`case 4*inf+inf:if(ys!=zs){`
819			`exceptions\|= I_BIT;x= standard_NaN;xs= zs;break;`
820			`}`
821			`case 4num+inf:case 4zro+inf:x= inf_octa;xs= zs;break;`
822			`case 4inf+num:case 4inf+zro:x= inf_octa;xs= ys;break;`
823			`case 4*num+num:if(y.h!=(z.h^0x80000000)\|\|y.l!=z.l)`
824			`/47:/`
825			`#line 821 "./mmix-arith.w"`
826
827			`{octa o,oo;`
828			`if(ye<ze\|\|(ye==ze&&(yf.h<zf.h\|\|(yf.h==zf.h&&yf.l<zf.l))))`
829			`/48:/`
830			`#line 839 "./mmix-arith.w"`
831
832			`{`
833			`o= yf,yf= zf,zf= o;`
834			`d= ye,ye= ze,ze= d;`
835			`d= ys,ys= zs,zs= d;`
836			`}`
837
838			`/:48/`
839			`#line 824 "./mmix-arith.w"`
840			`;`
841			`d= ye-ze;`
842			`xs= ys,xe= ye;`
843			`if(d)/49:/`
844			`#line 859 "./mmix-arith.w"`
845
846			`{`
847			`if(d<=2)zf= shift_right(zf,d,1);`
848			`else if(d> 53)zf.h= 0,zf.l= 1;`
849			`else{`
850			`if(ys!=zs)d--,xe--,yf= shift_left(yf,1);`
851			`o= zf;`
852			`zf= shift_right(o,d,1);`
853			`oo= shift_left(zf,d);`
854			`if(oo.l!=o.l\|\|oo.h!=o.h)zf.l\|= 1;`
855			`}`
856			`}`
857
858			`/:49/`
859			`#line 827 "./mmix-arith.w"`
860			`;`
861			`if(ys==zs){`
862			`xf= oplus(yf,zf);`
863			`if(xf.h>=0x800000)xe++,d= xf.l&1,xf= shift_right(xf,1,1),xf.l\|= d;`
864			`}else{`
865			`xf= ominus(yf,zf);`
866			`if(xf.h>=0x800000)xe++,d= xf.l&1,xf= shift_right(xf,1,1),xf.l\|= d;`
867			`else while(xf.h<0x400000)xe--,xf= shift_left(xf,1);`
868			`}`
869			`return fpack(xf,xe,xs,cur_round);`
870			`}`
871
872			`/:47/`
873			`#line 813 "./mmix-arith.w"`
874			`;`
875			`case 4*zro+zro:x= zero_octa;`
876			`xs= (ys==zs?ys:cur_round==ROUND_DOWN?'-':'+');break;`
877			`}`
878			`if(xs=='-')x.h\|= sign_bit;`
879			`return x;`
880			`}`
881
882			`/:46//50:/`
883			`#line 883 "./mmix-arith.w"`
884
885			`int fepscomp ARGS((octa,octa,octa,int));`
886			`int fepscomp(y,z,e,s)`
887			`octa y,z,e;`
888			`int s;`
889			`{`
890			`octa yf,zf,ef,o,oo;`
891			`int ye,ze,ee;`
892			`char ys,zs,es;`
893			`register int yt,zt,et,d;`
894			`et= funpack(e,&ef,&ee,&es);`
895			`if(es=='-')return 2;`
896			`switch(et){`
897			`case nan:return 2;`
898			`case inf:ee= 10000;`
899			`case num:case zro:break;`
900			`}`
901			`yt= funpack(y,&yf,&ye,&ys);`
902			`zt= funpack(z,&zf,&ze,&zs);`
903			`switch(4*yt+zt){`
904			`case 4nan+nan:case 4nan+inf:case 4nan+num:case 4nan+zro:`
905			`case 4inf+nan:case 4num+nan:case 4*zro+nan:return 2;`
906			`case 4*inf+inf:return(ys==zs\|\|ee>=1023);`
907			`case 4inf+num:case 4inf+zro:case 4num+inf:case 4zro+inf:`
908			`return(s&&ee>=1022);`
909			`case 4*zro+zro:return 1;`
910			`case 4zro+num:case 4num+zro:if(!s)return 0;`
911			`case 4*num+num:break;`
912			`}`
913			`/51:/`
914			`#line 919 "./mmix-arith.w"`
915
916			`/52:/`
917			`#line 934 "./mmix-arith.w"`
918
919			`if(ye<0&&yt!=zro)yf= shift_left(y,2),ye= 0;`
920			`if(ze<0&&zt!=zro)zf= shift_left(z,2),ze= 0;`
921
922			`/:52/`
923			`#line 920 "./mmix-arith.w"`
924			`;`
925			`if(ye<ze\|\|(ye==ze&&(yf.h<zf.h\|\|(yf.h==zf.h&&yf.l<zf.l))))`
926			`/48:/`
927			`#line 839 "./mmix-arith.w"`
928
929			`{`
930			`o= yf,yf= zf,zf= o;`
931			`d= ye,ye= ze,ze= d;`
932			`d= ys,ys= zs,zs= d;`
933			`}`
934
935			`/:48/`
936			`#line 922 "./mmix-arith.w"`
937			`;`
938			`if(ze==zero_exponent)ze= ye;`
939			`d= ye-ze;`
940			`if(!s)ee-= d;`
941			`if(ee>=1023)return 1;`
942			`/53:/`
943			`#line 956 "./mmix-arith.w"`
944
945			`if(d> 54)o= zero_octa,oo= zf;`
946			`else o= shift_right(zf,d,1),oo= shift_left(o,d);`
947			`if(oo.h!=zf.h\|\|oo.l!=zf.l){`
948			`if(ee<1020)return 0;`
949			`o= incr(o,ys==zs?0:1);`
950			`}`
951			`o= (ys==zs?ominus(yf,o):oplus(yf,o));`
952
953			`/:53/`
954			`#line 927 "./mmix-arith.w"`
955			`;`
956			`if(!o.h&&!o.l)return 1;`
957			`if(ee<968)return 0;`
958			`if(ee>=1021)ef= shift_left(ef,ee-1021);`
959			`else ef= shift_right(ef,1021-ee,1);`
960			`return o.h<ef.h\|\|(o.h==ef.h&&o.l<=ef.l);`
961
962			`/:51/`
963			`#line 912 "./mmix-arith.w"`
964			`;`
965			`}`
966
967			`/:50//54:/`
968			`#line 972 "./mmix-arith.w"`
969
970			`static void bignum_times_ten ARGS((bignum*));`
971			`static void bignum_dec ARGS((bignum,bignum,tetra));`
972			`static int bignum_compare ARGS((bignum,bignum));`
973			`void print_float ARGS((octa));`
974			`void print_float(x)`
975			`octa x;`
976			`{`
977			`/56:/`
978			`#line 1035 "./mmix-arith.w"`
979
980			`octa f,g;`
981			`register int e;`
982			`register int j,k;`
983
984			`/:56//66:/`
985			`#line 1281 "./mmix-arith.w"`
986
987			`bignum ff,gg;`
988			`bignum tt;`
989			`char s[18];`
990			`register char*p;`
991
992			`/:66/`
993			`#line 980 "./mmix-arith.w"`
994			`;`
995			`if(x.h&sign_bit)printf("-");`
996			`/55:/`
997			`#line 1019 "./mmix-arith.w"`
998
999			`f= shift_left(x,1);`
1000			`e= f.h>>21;`
1001			`f.h&= 0x1fffff;`
1002			`if(!f.h&&!f.l)/57:/`
1003			`#line 1045 "./mmix-arith.w"`
1004
1005			`{`
1006			`if(!e){`
1007			`printf("0.");return;`
1008			`}`
1009			`if(e==0x7ff){`
1010			`printf("Inf");return;`
1011			`}`
1012			`e--;`
1013			`f.h= 0x3fffff,f.l= 0xffffffff;`
1014			`g.h= 0x400000,g.l= 2;`
1015			`}`
1016
1017			`/:57/`
1018			`#line 1023 "./mmix-arith.w"`
1019
1020			`else{`
1021			`g= incr(f,1);`
1022			`f= incr(f,-1);`
1023			`if(!e)e= 1;`
1024			`else if(e==0x7ff){`
1025			`printf("NaN");`
1026			`if(g.h==0x100000&&g.l==1)return;`
1027			`e= 0x3ff;`
1028			`}else f.h\|= 0x200000,g.h\|= 0x200000;`
1029			`}`
1030
1031			`/:55/`
1032			`#line 983 "./mmix-arith.w"`
1033			`;`
1034			`/63:/`
1035			`#line 1195 "./mmix-arith.w"`
1036
1037			`k= (magic_offset-e)/28;`
1038			`ff.dat[k-1]= shift_right(f,magic_offset+28-e-28*k,1).l&0xfffffff;`
1039			`gg.dat[k-1]= shift_right(g,magic_offset+28-e-28*k,1).l&0xfffffff;`
1040			`ff.dat[k]= shift_right(f,magic_offset-e-28*k,1).l&0xfffffff;`
1041			`gg.dat[k]= shift_right(g,magic_offset-e-28*k,1).l&0xfffffff;`
1042			`ff.dat[k+1]= shift_left(f,e+28*k-(magic_offset-28)).l&0xfffffff;`
1043			`gg.dat[k+1]= shift_left(g,e+28*k-(magic_offset-28)).l&0xfffffff;`
1044			`ff.a= (ff.dat[k-1]?k-1:k);`
1045			`ff.b= (ff.dat[k+1]?k+1:k);`
1046			`gg.a= (gg.dat[k-1]?k-1:k);`
1047			`gg.b= (gg.dat[k+1]?k+1:k);`
1048
1049			`/:63/`
1050			`#line 984 "./mmix-arith.w"`
1051			`;`
1052			`/64:/`
1053			`#line 1223 "./mmix-arith.w"`
1054
1055			`if(e> 0x401)/65:/`
1056			`#line 1254 "./mmix-arith.w"`
1057
1058			`{register int open= x.l&1;`
1059			`tt.dat[origin]= 10;`
1060			`tt.a= tt.b= origin;`
1061			`for(e= 1;bignum_compare(&gg,&tt)>=open;e++)`
1062			`bignum_times_ten(&tt);`
1063			`p= s;`
1064			`while(1){`
1065			`bignum_times_ten(&ff);`
1066			`bignum_times_ten(&gg);`
1067			`for(j= '0';bignum_compare(&ff,&tt)>=0;j++)`
1068			`bignum_dec(&ff,&tt,0x10000000),bignum_dec(&gg,&tt,0x10000000);`
1069			`if(bignum_compare(&gg,&tt)>=open)break;`
1070			`*p++= j;`
1071			`if(ff.a==bignum_prec-1&&!open)`
1072			`goto done;`
1073			`}`
1074			`for(k= j;bignum_compare(&gg,&tt)>=open;k++)bignum_dec(&gg,&tt,0x10000000);`
1075			`*p++= (j+1+k)>>1;`
1076			`done:;`
1077			`}`
1078
1079			`/:65/`
1080			`#line 1224 "./mmix-arith.w"`
1081
1082			`else{`
1083			`if(ff.a> origin)ff.dat[origin]= 0;`
1084			`for(e= 1,p= s;gg.a> origin\|\|ff.dat[origin]==gg.dat[origin];){`
1085			`if(gg.a> origin)e--;`
1086			`else*p++= ff.dat[origin]+'0',ff.dat[origin]= 0,gg.dat[origin]= 0;`
1087			`bignum_times_ten(&ff);`
1088			`bignum_times_ten(&gg);`
1089			`}`
1090			`*p++= ((ff.dat[origin]+1+gg.dat[origin])>>1)+'0';`
1091			`}`
1092			`*p= '\0';`
1093
1094			`/:64/`
1095			`#line 985 "./mmix-arith.w"`
1096			`;`
1097			`/67:/`
1098			`#line 1296 "./mmix-arith.w"`
1099
1100			`if(e> 17\|\|e<(int)strlen(s)-17)`
1101			`printf("%c%s%se%d",s[0],(s[1]?".":""),s+1,e-1);`
1102			`else if(e<0)printf(".%0*d%s",-e,0,s);`
1103			`else if(strlen(s)>=e)printf("%.*s.%s",e,s,s+e);`
1104			`else printf("%s%0*d.",s,e-(int)strlen(s),0);`
1105
1106			`/:67/`
1107			`#line 986 "./mmix-arith.w"`
1108			`;`
1109			`}`
1110
1111			`/:54//60:/`
1112			`#line 1120 "./mmix-arith.w"`
1113
1114			`static void bignum_times_ten(f)`
1115			`bignum*f;`
1116			`{`
1117			`register tetrap,q;register tetra x,carry;`
1118			`for(p= &f->dat[f->b],q= &f->dat[f->a],carry= 0;p>=q;p--){`
1119			`x= p10+carry;`
1120			`*p= x&0xfffffff;`
1121			`carry= x>>28;`
1122			`}`
1123			`*p= carry;`
1124			`if(carry)f->a--;`
1125			`if(f->dat[f->b]==0&&f->b> f->a)f->b--;`
1126			`}`
1127
1128			`/:60//61:/`
1129			`#line 1138 "./mmix-arith.w"`
1130
1131			`static int bignum_compare(f,g)`
1132			`bignumf,g;`
1133			`{`
1134			`register tetrap,pp,q,qq;`
1135			`if(f->a!=g->a)return f->a> g->a?-1:1;`
1136			`pp= &f->dat[f->b],qq= &g->dat[g->b];`
1137			`for(p= &f->dat[f->a],q= &g->dat[g->a];p<=pp;p++,q++){`
1138			`if(p!=q)returnp<q?-1:1;`
1139			`if(q==qq)return p<pp;`
1140			`}`
1141			`return-1;`
1142			`}`
1143
1144			`/:61//62:/`
1145			`#line 1155 "./mmix-arith.w"`
1146
1147			`static void bignum_dec(f,g,r)`
1148			`bignumf,g;`
1149			`tetra r;`
1150			`{`
1151			`register tetrap,q,*qq;`
1152			`register int x,borrow;`
1153			`while(g->b> f->b)f->dat[++f->b]= 0;`
1154			`qq= &g->dat[g->a];`
1155			`for(p= &f->dat[g->b],q= &g->dat[g->b],borrow= 0;q>=qq;p--,q--){`
1156			`x= p-q-borrow;`
1157			`if(x>=0)borrow= 0,*p= x;`
1158			`else borrow= 1,*p= x+r;`
1159			`}`
1160			`for(;borrow;p--)`
1161			`if(p)borrow= 0,p= *p-1;`
1162			`else*p= r-1;`
1163			`while(f->dat[f->a]==0){`
1164			`if(f->a==f->b){`
1165			`f->a= f->b= bignum_prec-1,f->dat[bignum_prec-1]= 0;`
1166			`return;`
1167			`}`
1168			`f->a++;`
1169			`}`
1170			`while(f->dat[f->b]==0)f->b--;`
1171			`}`
1172
1173			`/:62//68:/`
1174			`#line 1340 "./mmix-arith.w"`
1175
1176			`static void bignum_double ARGS((bignum*));`
1177			`int scan_const ARGS((char*));`
1178			`int scan_const(s)`
1179			`char*s;`
1180			`{`
1181			`/70:/`
1182			`#line 1363 "./mmix-arith.w"`
1183
1184			`register charp,q;`
1185			`register bool NaN;`
1186			`int sign;`
1187
1188			`/:70//76:/`
1189			`#line 1435 "./mmix-arith.w"`
1190
1191			`register char*dec_pt;`
1192			`register int exp;`
1193			`register int zeros;`
1194
1195			`/:76//81:/`
1196			`#line 1503 "./mmix-arith.w"`
1197
1198			`register int k,x;`
1199			`register char*pp;`
1200			`bignum ff,tt;`
1201
1202			`/:81/`
1203			`#line 1346 "./mmix-arith.w"`
1204			`;`
1205			`val.h= val.l= 0;`
1206			`p= s;`
1207			`if(p=='+'\|\|p=='-')sign= *p++;else sign= '+';`
1208			`if(strncmp(p,"NaN",3)==0)NaN= true,p+= 3;`
1209			`else NaN= false;`
1210			`if((isdigit(p)&&!NaN)\|\|(p=='.'&&isdigit(*(p+1))))`
1211			`/73:/`
1212			`#line 1396 "./mmix-arith.w"`
1213
1214			`{`
1215			`for(q= buf0,dec_pt= (char)0;isdigit(p);p++){`
1216			`val= oplus(val,shift_left(val,2));`
1217			`val= incr(shift_left(val,1),*p-'0');`
1218			`if(q> buf0\|\|*p!='0')`
1219			`if(q<buf_max)q++= p;`
1220			`else if((q-1)=='0')(q-1)= *p;`
1221			`}`
1222			`if(NaN)*q++= '1';`
1223			`if(p=='.')/74:*/`
1224			`#line 1415 "./mmix-arith.w"`
1225
1226			`{`
1227			`dec_pt= q;`
1228			`p++;`
1229			`for(zeros= 0;isdigit(*p);p++)`
1230			`if(*p=='0'&&q==buf0)zeros++;`
1231			`else if(q<buf_max)q++= p;`
1232			`else if((q-1)=='0')(q-1)= *p;`
1233			`}`
1234
1235			`/:74/`
1236			`#line 1406 "./mmix-arith.w"`
1237			`;`
1238			`next_char= p;`
1239			`if(p=='e'&&!NaN)/77:*/`
1240			`#line 1447 "./mmix-arith.w"`
1241
1242			`{register char exp_sign;`
1243			`p++;`
1244			`if(p=='+'\|\|p=='-')exp_sign= *p++;else exp_sign= '+';`
1245			`if(isdigit(*p)){`
1246			`for(exp= p++-'0';isdigit(p);p++)`
1247			`if(exp<1000)exp= 10exp+p-'0';`
1248			`if(!dec_pt)dec_pt= q,zeros= 0;`
1249			`if(exp_sign=='-')exp= -exp;`
1250			`next_char= p;`
1251			`}`
1252			`}`
1253
1254			`/:77/`
1255			`#line 1408 "./mmix-arith.w"`
1256
1257			`else exp= 0;`
1258			`if(dec_pt)/78:/`
1259			`#line 1460 "./mmix-arith.w"`
1260
1261			`{`
1262			`/79:/`
1263			`#line 1477 "./mmix-arith.w"`
1264
1265			`x= buf+341+zeros-dec_pt-exp;`
1266			`if(q==buf0\|\|x>=1413){`
1267			`make_it_zero:exp= -99999;goto packit;`
1268			`}`
1269			`if(x<0){`
1270			`make_it_infinite:exp= 99999;goto packit;`
1271			`}`
1272			`ff.a= x/9;`
1273			`for(p= q;p<q+8;p++)*p= '0';`
1274			`q= q-1-(q+341+zeros-dec_pt-exp)%9;`
1275			`for(p= buf0-x%9,k= ff.a;p<=q&&k<=156;p+= 9,k++)`
1276			`/80:/`
1277			`#line 1497 "./mmix-arith.w"`
1278
1279			`{`
1280			`for(x= p-'0',pp= p+1;pp<p+9;pp++)x= 10x+*pp-'0';`
1281			`ff.dat[k]= x;`
1282			`}`
1283
1284			`/:80/`
1285			`#line 1490 "./mmix-arith.w"`
1286			`;`
1287			`ff.b= k-1;`
1288			`for(x= 0;p<=q;p+= 9)if(strncmp(p,"000000000",9)!=0)x= 1;`
1289			`ff.dat[156]+= x;`
1290
1291			`while(ff.dat[ff.b]==0)ff.b--;`
1292
1293			`/:79/`
1294			`#line 1462 "./mmix-arith.w"`
1295			`;`
1296			`/83:/`
1297			`#line 1526 "./mmix-arith.w"`
1298
1299			`val= zero_octa;`
1300			`if(ff.a> 36){`
1301			`for(exp= 0x3fe;ff.a> 36;exp--)bignum_double(&ff);`
1302			`for(k= 54;k;k--){`
1303			`if(ff.dat[36]){`
1304			`if(k>=32)val.h\|= 1<<(k-32);else val.l\|= 1<<k;`
1305			`ff.dat[36]= 0;`
1306			`if(ff.b==36)break;`
1307			`}`
1308			`bignum_double(&ff);`
1309			`}`
1310			`}else{`
1311			`tt.a= tt.b= 36,tt.dat[36]= 2;`
1312			`for(exp= 0x3fe;bignum_compare(&ff,&tt)>=0;exp++)bignum_double(&tt);`
1313			`for(k= 54;k;k--){`
1314			`bignum_double(&ff);`
1315			`if(bignum_compare(&ff,&tt)>=0){`
1316			`if(k>=32)val.h\|= 1<<(k-32);else val.l\|= 1<<k;`
1317			`bignum_dec(&ff,&tt,1000000000);`
1318			`if(ff.a==bignum_prec-1)break;`
1319			`}`
1320			`}`
1321			`}`
1322			`if(k==0)val.l\|= 1;`
1323
1324			`/:83/`
1325			`#line 1463 "./mmix-arith.w"`
1326			`;`
1327			`packit:/84:/`
1328			`#line 1559 "./mmix-arith.w"`
1329
1330			`val= fpack(val,exp,sign,ROUND_NEAR);`
1331			`if(NaN){`
1332			`if((val.h&0x7fffffff)==0x40000000)val.h\|= 0x7fffffff,val.l= 0xffffffff;`
1333			`else if((val.h&0x7fffffff)==0x3ff00000&&!val.l)val.h\|= 0x40000000,val.l= 1;`
1334			`else val.h\|= 0x40000000;`
1335			`}`
1336
1337			`/:84/`
1338			`#line 1464 "./mmix-arith.w"`
1339			`;`
1340			`return 1;`
1341			`}`
1342
1343			`/:78/`
1344			`#line 1410 "./mmix-arith.w"`
1345			`;`
1346			`if(sign=='-')val= ominus(zero_octa,val);`
1347			`return 0;`
1348			`}`
1349
1350			`/:73/`
1351			`#line 1353 "./mmix-arith.w"`
1352			`;`
1353			`if(NaN)/71:/`
1354			`#line 1368 "./mmix-arith.w"`
1355
1356			`{`
1357			`next_char= p;`
1358			`val.h= 0x600000,exp= 0x3fe;`
1359			`goto packit;`
1360			`}`
1361
1362			`/:71/`
1363			`#line 1354 "./mmix-arith.w"`
1364			`;`
1365			`if(strncmp(p,"Inf",3)==0)/72:/`
1366			`#line 1375 "./mmix-arith.w"`
1367
1368			`{`
1369			`next_char= p+3;`
1370			`goto make_it_infinite;`
1371			`}`
1372
1373			`/:72/`
1374			`#line 1355 "./mmix-arith.w"`
1375			`;`
1376			`no_const_found:next_char= s;return-1;`
1377			`}`
1378
1379			`/:68//82:/`
1380			`#line 1511 "./mmix-arith.w"`
1381
1382			`static void bignum_double(f)`
1383			`bignum*f;`
1384			`{`
1385			`register tetrap,q;register int x,carry;`
1386			`for(p= &f->dat[f->b],q= &f->dat[f->a],carry= 0;p>=q;p--){`
1387			`x= p+p+carry;`
1388			`if(x>=1000000000)carry= 1,*p= x-1000000000;`
1389			`else carry= 0,*p= x;`
1390			`}`
1391			`*p= carry;`
1392			`if(carry)f->a--;`
1393			`if(f->dat[f->b]==0&&f->b> f->a)f->b--;`
1394			`}`
1395
1396			`/:82//85:/`
1397			`#line 1575 "./mmix-arith.w"`
1398
1399			`int fcomp ARGS((octa,octa));`
1400			`int fcomp(y,z)`
1401			`octa y,z;`
1402			`{`
1403			`ftype yt,zt;`
1404			`int ye,ze;`
1405			`char ys,zs;`
1406			`octa yf,zf;`
1407			`register int x;`
1408			`yt= funpack(y,&yf,&ye,&ys);`
1409			`zt= funpack(z,&zf,&ze,&zs);`
1410			`switch(4*yt+zt){`
1411			`case 4nan+nan:case 4zro+nan:case 4num+nan:case 4inf+nan:`
1412			`case 4nan+zro:case 4nan+num:case 4*nan+inf:return 2;`
1413			`case 4*zro+zro:return 0;`
1414			`case 4zro+num:case 4num+zro:case 4zro+inf:case 4inf+zro:`
1415			`case 4num+num:case 4num+inf:case 4inf+num:case 4inf+inf:`
1416			`if(ys!=zs)x= 1;`
1417			`else if(y.h> z.h)x= 1;`
1418			`else if(y.h<z.h)x= -1;`
1419			`else if(y.l> z.l)x= 1;`
1420			`else if(y.l<z.l)x= -1;`
1421			`else return 0;`
1422			`break;`
1423			`}`
1424			`return(ys=='-'?-x:x);`
1425			`}`
1426
1427			`/:85//86:/`
1428			`#line 1608 "./mmix-arith.w"`
1429
1430			`octa fintegerize ARGS((octa,int));`
1431			`octa fintegerize(z,r)`
1432			`octa z;`
1433			`int r;`
1434			`{`
1435			`ftype zt;`
1436			`int ze;`
1437			`char zs;`
1438			`octa xf,zf;`
1439			`zt= funpack(z,&zf,&ze,&zs);`
1440			`if(!r)r= cur_round;`
1441			`switch(zt){`
1442			`case nan:if(!(z.h&0x80000)){exceptions\|= I_BIT;z.h\|= 0x80000;}`
1443			`case inf:case zro:return z;`
1444			`case num:/87:/`
1445			`#line 1627 "./mmix-arith.w"`
1446
1447			`if(ze>=1074)return fpack(zf,ze,zs,ROUND_OFF);`
1448			`if(ze<=1020)xf.h= 0,xf.l= 1;`
1449			`else{octa oo;`
1450			`xf= shift_right(zf,1074-ze,1);`
1451			`oo= shift_left(xf,1074-ze);`
1452			`if(oo.l!=zf.l\|\|oo.h!=zf.h)xf.l\|= 1;`
1453
1454			`}`
1455			`switch(r){`
1456			`case ROUND_DOWN:if(zs=='-')xf= incr(xf,3);break;`
1457			`case ROUND_UP:if(zs!='-')xf= incr(xf,3);`
1458			`case ROUND_OFF:break;`
1459			`case ROUND_NEAR:xf= incr(xf,xf.l&4?2:1);break;`
1460			`}`
1461			`xf.l&= 0xfffffffc;`
1462			`if(ze>=1022)return fpack(shift_left(xf,1074-ze),ze,zs,ROUND_OFF);`
1463			`if(xf.l)xf.h= 0x3ff00000,xf.l= 0;`
1464			`if(zs=='-')xf.h\|= sign_bit;`
1465			`return xf;`
1466
1467			`/:87/`
1468			`#line 1623 "./mmix-arith.w"`
1469			`;`
1470			`}`
1471			`}`
1472
1473			`/:86//88:/`
1474			`#line 1650 "./mmix-arith.w"`
1475
1476			`octa fixit ARGS((octa,int));`
1477			`octa fixit(z,r)`
1478			`octa z;`
1479			`int r;`
1480			`{`
1481			`ftype zt;`
1482			`int ze;`
1483			`char zs;`
1484			`octa zf,o;`
1485			`zt= funpack(z,&zf,&ze,&zs);`
1486			`if(!r)r= cur_round;`
1487			`switch(zt){`
1488			`case nan:case inf:exceptions\|= I_BIT;return z;`
1489			`case zro:return zero_octa;`
1490			`case num:if(funpack(fintegerize(z,r),&zf,&ze,&zs)==zro)return zero_octa;`
1491			`if(ze<=1076)o= shift_right(zf,1076-ze,1);`
1492			`else{`
1493			`if(ze> 1085\|\|(ze==1085&&(zf.h> 0x400000\|\|`
1494			`(zf.h==0x400000&&(zf.l\|\|zs!='-')))))exceptions\|= W_BIT;`
1495			`if(ze>=1140)return zero_octa;`
1496			`o= shift_left(zf,ze-1076);`
1497			`}`
1498			`return(zs=='-'?ominus(zero_octa,o):o);`
1499			`}`
1500			`}`
1501
1502			`/:88//89:/`
1503			`#line 1681 "./mmix-arith.w"`
1504
1505			`octa floatit ARGS((octa,int,int,int));`
1506			`octa floatit(z,r,u,p)`
1507			`octa z;`
1508			`int r;`
1509			`int u;`
1510			`int p;`
1511			`{`
1512			`int e;char s;`
1513			`register int t;`
1514			`exceptions= 0;`
1515			`if(!z.h&&!z.l)return zero_octa;`
1516			`if(!r)r= cur_round;`
1517			`if(!u&&(z.h&sign_bit))s= '-',z= ominus(zero_octa,z);else s= '+';`
1518			`e= 1076;`
1519			`while(z.h<0x400000)e--,z= shift_left(z,1);`
1520			`while(z.h>=0x800000){`
1521			`e++;`
1522			`t= z.l&1;`
1523			`z= shift_right(z,1,1);`
1524			`z.l\|= t;`
1525			`}`
1526			`if(p)/90:/`
1527			`#line 1707 "./mmix-arith.w"`
1528
1529			`{`
1530			`register int ex;register tetra t;`
1531			`t= sfpack(z,e,s,r);`
1532			`ex= exceptions;`
1533			`sfunpack(t,&z,&e,&s);`
1534			`exceptions= ex;`
1535			`}`
1536
1537			`/:90/`
1538			`#line 1703 "./mmix-arith.w"`
1539			`;`
1540			`return fpack(z,e,s,r);`
1541			`}`
1542
1543			`/:89//91:/`
1544			`#line 1718 "./mmix-arith.w"`
1545
1546			`octa froot ARGS((octa,int));`
1547			`octa froot(z,r)`
1548			`octa z;`
1549			`int r;`
1550			`{`
1551			`ftype zt;`
1552			`int ze;`
1553			`char zs;`
1554			`octa x,xf,rf,zf;`
1555			`register int xe,k;`
1556			`if(!r)r= cur_round;`
1557			`zt= funpack(z,&zf,&ze,&zs);`
1558			`if(zs=='-'&&zt!=zro)exceptions\|= I_BIT,x= standard_NaN;`
1559			`else switch(zt){`
1560			`case nan:if(!(z.h&0x80000))exceptions\|= I_BIT,z.h\|= 0x80000;`
1561			`return z;`
1562			`case inf:case zro:x= z;break;`
1563			`case num:/92:/`
1564			`#line 1750 "./mmix-arith.w"`
1565
1566			`xf.h= 0,xf.l= 2;`
1567			`xe= (ze+0x3fe)>>1;`
1568			`if(ze&1)zf= shift_left(zf,1);`
1569			`rf.h= 0,rf.l= (zf.h>>22)-1;`
1570			`for(k= 53;k;k--){`
1571			`rf= shift_left(rf,2);xf= shift_left(xf,1);`
1572			`if(k>=43)rf= incr(rf,(zf.h>>(2*(k-43)))&3);`
1573			`else if(k>=27)rf= incr(rf,(zf.l>>(2*(k-27)))&3);`
1574			`if((rf.l> xf.l&&rf.h>=xf.h)\|\|rf.h> xf.h){`
1575			`xf.l++;rf= ominus(rf,xf);xf.l++;`
1576			`}`
1577			`}`
1578			`if(rf.h\|\|rf.l)xf.l++;`
1579			`return fpack(xf,xe,'+',r);`
1580
1581			`/:92/`
1582			`#line 1736 "./mmix-arith.w"`
1583			`;`
1584			`}`
1585			`if(zs=='-')x.h\|= sign_bit;`
1586			`return x;`
1587			`}`
1588
1589			`/:91//93:/`
1590			`#line 1774 "./mmix-arith.w"`
1591
1592			`octa fremstep ARGS((octa,octa,int));`
1593			`octa fremstep(y,z,delta)`
1594			`octa y,z;`
1595			`int delta;`
1596			`{`
1597			`ftype yt,zt;`
1598			`int ye,ze;`
1599			`char xs,ys,zs;`
1600			`octa x,xf,yf,zf;`
1601			`register int xe,thresh,odd;`
1602			`yt= funpack(y,&yf,&ye,&ys);`
1603			`zt= funpack(z,&zf,&ze,&zs);`
1604			`switch(4*yt+zt){`
1605			`/42:/`
1606			`#line 731 "./mmix-arith.w"`
1607
1608			`case 4*nan+nan:if(!(y.h&0x80000))exceptions\|= I_BIT;`
1609			`case 4zro+nan:case 4num+nan:case 4*inf+nan:`
1610			`if(!(z.h&0x80000))exceptions\|= I_BIT,z.h\|= 0x80000;`
1611			`return z;`
1612			`case 4nan+zro:case 4nan+num:case 4*nan+inf:`
1613			`if(!(y.h&0x80000))exceptions\|= I_BIT,y.h\|= 0x80000;`
1614			`return y;`
1615
1616			`/:42/`
1617			`#line 1788 "./mmix-arith.w"`
1618			`;`
1619			`case 4zro+zro:case 4num+zro:case 4*inf+zro:`
1620			`case 4inf+num:case 4inf+inf:x= standard_NaN;`
1621			`exceptions\|= I_BIT;break;`
1622			`case 4zro+num:case 4zro+inf:case 4*num+inf:return y;`
1623			`case 4num+num:/94:*/`
1624			`#line 1809 "./mmix-arith.w"`
1625
1626			`odd= 0;`
1627			`thresh= ye-delta;`
1628			`if(thresh<ze)thresh= ze;`
1629			`while(ye>=thresh)/95:/`
1630			`#line 1830 "./mmix-arith.w"`
1631
1632			`{`
1633			`if(yf.h==zf.h&&yf.l==zf.l)goto zero_out;`
1634			`if(yf.h<zf.h\|\|(yf.h==zf.h&&yf.l<zf.l)){`
1635			`if(ye==ze)goto try_complement;`
1636			`ye--,yf= shift_left(yf,1);`
1637			`}`
1638			`yf= ominus(yf,zf);`
1639			`if(ye==ze)odd= 1;`
1640			`while(yf.h<0x400000)ye--,yf= shift_left(yf,1);`
1641			`}`
1642
1643			`/:95/`
1644			`#line 1815 "./mmix-arith.w"`
1645			`;`
1646			`if(ye>=ze){`
1647			`exceptions\|= E_BIT;return fpack(yf,ye,ys,ROUND_OFF);`
1648			`}`
1649			`if(ye<ze-1)return fpack(yf,ye,ys,ROUND_OFF);`
1650			`yf= shift_right(yf,1,1);`
1651			`try_complement:xf= ominus(zf,yf),xe= ze,xs= '+'+'-'-ys;`
1652			`if(xf.h> yf.h\|\|(xf.h==yf.h&&(xf.l> yf.l\|\|(xf.l==yf.l&&!odd))))`
1653			`xf= yf,xs= ys;`
1654			`while(xf.h<0x400000)xe--,xf= shift_left(xf,1);`
1655			`return fpack(xf,xe,xs,ROUND_OFF);`
1656
1657			`/:94/`
1658			`#line 1793 "./mmix-arith.w"`
1659			`;`
1660			`zero_out:x= zero_octa;`
1661			`}`
1662			`if(ys=='-')x.h\|= sign_bit;`
1663			`return x;`
1664			`}`
1665
1666			`/:93/`
1667			`#line 41 "./mmix-arith.w"`
1668
1669
1670			`/:1/`

Browse

Tools

Subversion Repositories eco32

[/] [eco32/] [trunk/] [fp/] [implementation/] [arith/] [mmix-arith.c] - Blame information for rev 198