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

Subversion Repositories eco32

Compare Revisions

  • This comparison shows the changes necessary to convert path 
    /eco32/tags/eco32-0.22/fp/implementation/arith
    from Rev 15 to Rev 21
    ↔ Reverse comparison
  •

Rev 15 → Rev 21

/mmix-arith.c
0,0 → 1,1670
#define sign_bit ((unsigned) 0x80000000) \
 
#define ROUND_OFF 1
#define ROUND_UP 2
#define ROUND_DOWN 3
#define ROUND_NEAR 4 \
 
#define X_BIT (1<<8)
#define Z_BIT (1<<9)
#define U_BIT (1<<10)
#define O_BIT (1<<11)
#define I_BIT (1<<12)
#define W_BIT (1<<13)
#define V_BIT (1<<14)
#define D_BIT (1<<15)
#define E_BIT (1<<18) \
 
#define zero_exponent (-1000) \
 
#define bignum_prec 157 \
 
#define magic_offset 2112
#define origin 37 \
 
#define buf0 (buf+8)
#define buf_max (buf+777) \
 
/*1:*/
#line 32 "./mmix-arith.w"
 
#include <stdio.h>
#include <string.h>
#include <ctype.h>
/*2:*/
#line 49 "./mmix-arith.w"
 
#ifdef __STDC__
#define ARGS(list) list
#else
#define ARGS(list) ()
#endif
 
/*:2*/
#line 36 "./mmix-arith.w"
 
typedef enum{false,true}bool;
/*3:*/
#line 60 "./mmix-arith.w"
 
typedef unsigned int tetra;
 
typedef struct{tetra h,l;}octa;
 
/*:3*/
#line 38 "./mmix-arith.w"
 
/*36:*/
#line 605 "./mmix-arith.w"
 
typedef enum{zro,num,inf,nan}ftype;
 
/*:36*//*59:*/
#line 1110 "./mmix-arith.w"
 
typedef struct{
int a;
int b;
tetra dat[bignum_prec];
}bignum;
 
/*:59*/
#line 39 "./mmix-arith.w"
 
/*4:*/
#line 67 "./mmix-arith.w"
 
octa zero_octa;
octa neg_one= {-1,-1};
octa inf_octa= {0x7ff00000,0};
octa standard_NaN= {0x7ff80000,0};
octa aux;
bool overflow;
 
/*:4*//*9:*/
#line 174 "./mmix-arith.w"
 
extern octa aux;
extern bool overflow;
 
/*:9*//*30:*/
#line 464 "./mmix-arith.w"
 
int cur_round;
 
/*:30*//*32:*/
#line 528 "./mmix-arith.w"
 
int exceptions;
 
/*:32*//*69:*/
#line 1359 "./mmix-arith.w"
 
octa val;
char*next_char;
 
/*:69*//*75:*/
#line 1432 "./mmix-arith.w"
 
static char buf[785]= "00000000";
 
/*:75*/
#line 40 "./mmix-arith.w"
 
/*5:*/
#line 78 "./mmix-arith.w"
 
octa oplus ARGS((octa,octa));
octa oplus(y,z)
octa y,z;
{octa x;
x.h= y.h+z.h;
x.l= y.l+z.l;
if(x.l<y.l)x.h++;
return x;
}
 
octa ominus ARGS((octa,octa));
octa ominus(y,z)
octa y,z;
{octa x;
x.h= y.h-z.h;
x.l= y.l-z.l;
if(x.l> y.l)x.h--;
return x;
}
 
/*:5*//*6:*/
#line 102 "./mmix-arith.w"
 
octa incr ARGS((octa,int));
octa incr(y,delta)
octa y;
int delta;
{octa x;
x.h= y.h;x.l= y.l+delta;
if(delta>=0){
if(x.l<y.l)x.h++;
}else if(x.l> y.l)x.h--;
return x;
}
 
/*:6*//*7:*/
#line 117 "./mmix-arith.w"
 
octa shift_left ARGS((octa,int));
octa shift_left(y,s)
octa y;
int s;
{
while(s>=32)y.h= y.l,y.l= 0,s-= 32;
if(s){register tetra yhl= y.h<<s,ylh= y.l>>(32-s);
y.h= yhl+ylh;y.l<<= s;
}
return y;
}
 
octa shift_right ARGS((octa,int,int));
octa shift_right(y,s,u)
octa y;
int s,u;
{
while(s>=32)y.l= y.h,y.h= (u?0:-(y.h>>31)),s-= 32;
if(s){register tetra yhl= y.h<<(32-s),ylh= y.l>>s;
y.h= (u?0:(-(y.h>>31))<<(32-s))+(y.h>>s);y.l= yhl+ylh;
}
return y;
}
 
/*:7*//*8:*/
#line 150 "./mmix-arith.w"
 
octa omult ARGS((octa,octa));
octa omult(y,z)
octa y,z;
{
register int i,j,k;
tetra u[4],v[4],w[8];
register tetra t;
octa acc;
/*10:*/
#line 178 "./mmix-arith.w"
 
u[3]= y.h>>16,u[2]= y.h&0xffff,u[1]= y.l>>16,u[0]= y.l&0xffff;
v[3]= z.h>>16,v[2]= z.h&0xffff,v[1]= z.l>>16,v[0]= z.l&0xffff;
 
/*:10*/
#line 159 "./mmix-arith.w"
;
for(j= 0;j<4;j++)w[j]= 0;
for(j= 0;j<4;j++)
if(!v[j])w[j+4]= 0;
else{
for(i= k= 0;i<4;i++){
t= u[i]*v[j]+w[i+j]+k;
w[i+j]= t&0xffff,k= t>>16;
}
w[j+4]= k;
}
/*11:*/
#line 182 "./mmix-arith.w"
 
aux.h= (w[7]<<16)+w[6],aux.l= (w[5]<<16)+w[4];
acc.h= (w[3]<<16)+w[2],acc.l= (w[1]<<16)+w[0];
 
/*:11*/
#line 170 "./mmix-arith.w"
;
return acc;
}
 
/*:8*//*12:*/
#line 191 "./mmix-arith.w"
 
octa signed_omult ARGS((octa,octa));
octa signed_omult(y,z)
octa y,z;
{
octa acc;
acc= omult(y,z);
if(y.h&sign_bit)aux= ominus(aux,z);
if(z.h&sign_bit)aux= ominus(aux,y);
overflow= (aux.h!=aux.l||(aux.h^(aux.h>>1)^(acc.h&sign_bit)));
return acc;
}
 
/*:12*//*13:*/
#line 215 "./mmix-arith.w"
 
octa odiv ARGS((octa,octa,octa));
octa odiv(x,y,z)
octa x,y,z;
{
register int i,j,k,n,d;
tetra u[8],v[4],q[4],mask,qhat,rhat,vh,vmh;
register tetra t;
octa acc;
/*14:*/
#line 234 "./mmix-arith.w"
 
if(x.h> z.h||(x.h==z.h&&x.l>=z.l)){
aux= y;return x;
}
 
/*:14*/
#line 224 "./mmix-arith.w"
;
/*15:*/
#line 239 "./mmix-arith.w"
 
u[7]= x.h>>16,u[6]= x.h&0xffff,u[5]= x.l>>16,u[4]= x.l&0xffff;
u[3]= y.h>>16,u[2]= y.h&0xffff,u[1]= y.l>>16,u[0]= y.l&0xffff;
v[3]= z.h>>16,v[2]= z.h&0xffff,v[1]= z.l>>16,v[0]= z.l&0xffff;
 
/*:15*/
#line 225 "./mmix-arith.w"
;
/*16:*/
#line 244 "./mmix-arith.w"
 
for(n= 4;v[n-1]==0;n--);
 
/*:16*/
#line 226 "./mmix-arith.w"
;
/*17:*/
#line 250 "./mmix-arith.w"
 
vh= v[n-1];
for(d= 0;vh<0x8000;d++,vh<<= 1);
for(j= k= 0;j<n+4;j++){
t= (u[j]<<d)+k;
u[j]= t&0xffff,k= t>>16;
}
for(j= k= 0;j<n;j++){
t= (v[j]<<d)+k;
v[j]= t&0xffff,k= t>>16;
}
vh= v[n-1];
vmh= (n> 1?v[n-2]:0);
 
/*:17*/
#line 227 "./mmix-arith.w"
;
for(j= 3;j>=0;j--)/*20:*/
#line 276 "./mmix-arith.w"
 
{
/*21:*/
#line 284 "./mmix-arith.w"
 
t= (u[j+n]<<16)+u[j+n-1];
qhat= t/vh,rhat= t-vh*qhat;
if(n> 1)while(qhat==0x10000||qhat*vmh> (rhat<<16)+u[j+n-2]){
qhat--,rhat+= vh;
if(rhat>=0x10000)break;
}
 
/*:21*/
#line 278 "./mmix-arith.w"
;
/*22:*/
#line 296 "./mmix-arith.w"
 
for(i= k= 0;i<n;i++){
t= u[i+j]+0xffff0000-k-qhat*v[i];
u[i+j]= t&0xffff,k= 0xffff-(t>>16);
}
 
/*:22*/
#line 279 "./mmix-arith.w"
;
/*23:*/
#line 305 "./mmix-arith.w"
 
if(u[j+n]!=k){
qhat--;
for(i= k= 0;i<n;i++){
t= u[i+j]+v[i]+k;
u[i+j]= t&0xffff,k= t>>16;
}
}
 
/*:23*/
#line 280 "./mmix-arith.w"
;
q[j]= qhat;
}
 
/*:20*/
#line 228 "./mmix-arith.w"
;
/*18:*/
#line 264 "./mmix-arith.w"
 
mask= (1<<d)-1;
for(j= 3;j>=n;j--)u[j]= 0;
for(k= 0;j>=0;j--){
t= (k<<16)+u[j];
u[j]= t>>d,k= t&mask;
}
 
/*:18*/
#line 229 "./mmix-arith.w"
;
/*19:*/
#line 272 "./mmix-arith.w"
 
acc.h= (q[3]<<16)+q[2],acc.l= (q[1]<<16)+q[0];
aux.h= (u[3]<<16)+u[2],aux.l= (u[1]<<16)+u[0];
 
/*:19*/
#line 230 "./mmix-arith.w"
;
return acc;
}
 
/*:13*//*24:*/
#line 317 "./mmix-arith.w"
 
octa signed_odiv ARGS((octa,octa));
octa signed_odiv(y,z)
octa y,z;
{
octa yy,zz,q;
register int sy,sz;
if(y.h&sign_bit)sy= 2,yy= ominus(zero_octa,y);
else sy= 0,yy= y;
if(z.h&sign_bit)sz= 1,zz= ominus(zero_octa,z);
else sz= 0,zz= z;
q= odiv(zero_octa,yy,zz);
overflow= false;
switch(sy+sz){
case 2+1:aux= ominus(zero_octa,aux);
if(q.h==sign_bit)overflow= true;
case 0+0:return q;
case 2+0:if(aux.h||aux.l)aux= ominus(zz,aux);
goto negate_q;
case 0+1:if(aux.h||aux.l)aux= ominus(aux,zz);
negate_q:if(aux.h||aux.l)return ominus(neg_one,q);
else return ominus(zero_octa,q);
}
}
 
/*:24*//*25:*/
#line 346 "./mmix-arith.w"
 
octa oand ARGS((octa,octa));
octa oand(y,z)
octa y,z;
{octa x;
x.h= y.h&z.h;x.l= y.l&z.l;
return x;
}
 
octa oandn ARGS((octa,octa));
octa oandn(y,z)
octa y,z;
{octa x;
x.h= y.h&~z.h;x.l= y.l&~z.l;
return x;
}
 
octa oxor ARGS((octa,octa));
octa oxor(y,z)
octa y,z;
{octa x;
x.h= y.h^z.h;x.l= y.l^z.l;
return x;
}
 
/*:25*//*26:*/
#line 387 "./mmix-arith.w"
 
int count_bits ARGS((tetra));
int count_bits(x)
tetra x;
{
register int xx= x;
xx= xx-((xx>>1)&0x55555555);
xx= (xx&0x33333333)+((xx>>2)&0x33333333);
xx= (xx+(xx>>4))&0x0f0f0f0f;
xx= xx+(xx>>8);
return(xx+(xx>>16))&0xff;
}
 
/*:26*//*27:*/
#line 403 "./mmix-arith.w"
 
tetra byte_diff ARGS((tetra,tetra));
tetra byte_diff(y,z)
tetra y,z;
{
register tetra d= (y&0x00ff00ff)+0x01000100-(z&0x00ff00ff);
register tetra m= d&0x01000100;
register tetra x= d&(m-(m>>8));
d= ((y>>8)&0x00ff00ff)+0x01000100-((z>>8)&0x00ff00ff);
m= d&0x01000100;
return x+((d&(m-(m>>8)))<<8);
}
 
/*:27*//*28:*/
#line 421 "./mmix-arith.w"
 
tetra wyde_diff ARGS((tetra,tetra));
tetra wyde_diff(y,z)
tetra y,z;
{
register tetra a= ((y>>16)-(z>>16))&0x10000;
register tetra b= ((y&0xffff)-(z&0xffff))&0x10000;
return y-(z^((y^z)&(b-a-(b>>16))));
}
 
/*:28*//*29:*/
#line 434 "./mmix-arith.w"
 
octa bool_mult ARGS((octa,octa,bool));
octa bool_mult(y,z,xor)
octa y,z;
bool xor;
{
octa o,x;
register tetra a,b,c;
register int k;
for(k= 0,o= y,x= zero_octa;o.h||o.l;k++,o= shift_right(o,8,1))
if(o.l&0xff){
a= ((z.h>>k)&0x01010101)*0xff;
b= ((z.l>>k)&0x01010101)*0xff;
c= (o.l&0xff)*0x01010101;
if(xor)x.h^= a&c,x.l^= b&c;
else x.h|= a&c,x.l|= b&c;
}
return x;
}
 
/*:29*//*31:*/
#line 503 "./mmix-arith.w"
 
octa fpack ARGS((octa,int,char,int));
octa fpack(f,e,s,r)
octa f;
int e;
char s;
int r;
{
octa o;
if(e> 0x7fd)e= 0x7ff,o= zero_octa;
else{
if(e<0){
if(e<-54)o.h= 0,o.l= 1;
else{octa oo;
o= shift_right(f,-e,1);
oo= shift_left(o,-e);
if(oo.l!=f.l||oo.h!=f.h)o.l|= 1;
 
}
e= 0;
}else o= f;
}
/*33:*/
#line 533 "./mmix-arith.w"
 
if(o.l&3)exceptions|= X_BIT;
switch(r){
case ROUND_DOWN:if(s=='-')o= incr(o,3);break;
case ROUND_UP:if(s!='-')o= incr(o,3);
case ROUND_OFF:break;
case ROUND_NEAR:o= incr(o,o.l&4?2:1);break;
}
o= shift_right(o,2,1);
o.h+= e<<20;
if(o.h>=0x7ff00000)exceptions|= O_BIT+X_BIT;
else if(o.h<0x100000)exceptions|= U_BIT;
if(s=='-')o.h|= sign_bit;
return o;
 
/*:33*/
#line 525 "./mmix-arith.w"
;
}
 
/*:31*//*34:*/
#line 551 "./mmix-arith.w"
 
tetra sfpack ARGS((octa,int,char,int));
tetra sfpack(f,e,s,r)
octa f;
int e;
char s;
int r;
{
register tetra o;
if(e> 0x47d)e= 0x47f,o= 0;
else{
o= shift_left(f,3).h;
if(f.l&0x1fffffff)o|= 1;
if(e<0x380){
if(e<0x380-25)o= 1;
else{register tetra o0,oo;
o0= o;
o= o>>(0x380-e);
oo= o<<(0x380-e);
if(oo!=o0)o|= 1;
 
}
e= 0x380;
}
}
/*35:*/
#line 579 "./mmix-arith.w"
 
if(o&3)exceptions|= X_BIT;
switch(r){
case ROUND_DOWN:if(s=='-')o+= 3;break;
case ROUND_UP:if(s!='-')o+= 3;
case ROUND_OFF:break;
case ROUND_NEAR:o+= (o&4?2:1);break;
}
o= o>>2;
o+= (e-0x380)<<23;
if(o>=0x7f800000)exceptions|= O_BIT+X_BIT;
else if(o<0x100000)exceptions|= U_BIT;
if(s=='-')o|= sign_bit;
return o;
 
/*:35*/
#line 576 "./mmix-arith.w"
;
}
 
/*:34*//*37:*/
#line 608 "./mmix-arith.w"
 
ftype funpack ARGS((octa,octa*,int*,char*));
ftype funpack(x,f,e,s)
octa x;
octa*f;
int*e;
char*s;
{
register int ee;
exceptions= 0;
*s= (x.h&sign_bit?'-':'+');
*f= shift_left(x,2);
f->h&= 0x3fffff;
ee= (x.h>>20)&0x7ff;
if(ee){
*e= ee-1;
f->h|= 0x400000;
return(ee<0x7ff?num:f->h==0x400000&&!f->l?inf:nan);
}
if(!x.l&&!f->h){
*e= zero_exponent;return zro;
}
do{ee--;*f= shift_left(*f,1);}while(!(f->h&0x400000));
*e= ee;return num;
}
 
/*:37*//*38:*/
#line 634 "./mmix-arith.w"
 
ftype sfunpack ARGS((tetra,octa*,int*,char*));
ftype sfunpack(x,f,e,s)
tetra x;
octa*f;
int*e;
char*s;
{
register int ee;
exceptions= 0;
*s= (x&sign_bit?'-':'+');
f->h= (x>>1)&0x3fffff,f->l= x<<31;
ee= (x>>23)&0xff;
if(ee){
*e= ee+0x380-1;
f->h|= 0x400000;
return(ee<0xff?num:(x&0x7fffffff)==0x7f800000?inf:nan);
}
if(!(x&0x7fffffff)){
*e= zero_exponent;return zro;
}
do{ee--;*f= shift_left(*f,1);}while(!(f->h&0x400000));
*e= ee+0x380;return num;
}
 
/*:38*//*39:*/
#line 663 "./mmix-arith.w"
 
octa load_sf ARGS((tetra));
octa load_sf(z)
tetra z;
{
octa f,x;int e;char s;ftype t;
t= sfunpack(z,&f,&e,&s);
switch(t){
case zro:x= zero_octa;break;
case num:return fpack(f,e,s,ROUND_OFF);
case inf:x= inf_octa;break;
case nan:x= shift_right(f,2,1);x.h|= 0x7ff00000;break;
}
if(s=='-')x.h|= sign_bit;
return x;
}
 
/*:39*//*40:*/
#line 680 "./mmix-arith.w"
 
tetra store_sf ARGS((octa));
tetra store_sf(x)
octa x;
{
octa f;tetra z;int e;char s;ftype t;
t= funpack(x,&f,&e,&s);
switch(t){
case zro:z= 0;break;
case num:return sfpack(f,e,s,cur_round);
case inf:z= 0x7f800000;break;
case nan:if(!(f.h&0x200000)){
f.h|= 0x200000;exceptions|= I_BIT;
}
z= 0x7f800000|(f.h<<1)|(f.l>>31);break;
}
if(s=='-')z|= sign_bit;
return z;
}
 
/*:40*//*41:*/
#line 705 "./mmix-arith.w"
 
octa fmult ARGS((octa,octa));
octa fmult(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa x,xf,yf,zf;
register int xe;
register char xs;
yt= funpack(y,&yf,&ye,&ys);
zt= funpack(z,&zf,&ze,&zs);
xs= ys+zs-'+';
switch(4*yt+zt){
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4*nan+nan:if(!(y.h&0x80000))exceptions|= I_BIT;
case 4*zro+nan:case 4*num+nan:case 4*inf+nan:
if(!(z.h&0x80000))exceptions|= I_BIT,z.h|= 0x80000;
return z;
case 4*nan+zro:case 4*nan+num:case 4*nan+inf:
if(!(y.h&0x80000))exceptions|= I_BIT,y.h|= 0x80000;
return y;
 
/*:42*/
#line 720 "./mmix-arith.w"
;
case 4*zro+zro:case 4*zro+num:case 4*num+zro:x= zero_octa;break;
case 4*num+inf:case 4*inf+num:case 4*inf+inf:x= inf_octa;break;
case 4*zro+inf:case 4*inf+zro:x= standard_NaN;
exceptions|= I_BIT;break;
case 4*num+num:/*43:*/
#line 740 "./mmix-arith.w"
 
xe= ye+ze-0x3fd;
x= omult(yf,shift_left(zf,9));
if(aux.h>=0x400000)xf= aux;
else xf= shift_left(aux,1),xe--;
if(x.h||x.l)xf.l|= 1;
return fpack(xf,xe,xs,cur_round);
 
/*:43*/
#line 725 "./mmix-arith.w"
;
}
if(xs=='-')x.h|= sign_bit;
return x;
}
 
/*:41*//*44:*/
#line 748 "./mmix-arith.w"
 
octa fdivide ARGS((octa,octa));
octa fdivide(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa x,xf,yf,zf;
register int xe;
register char xs;
yt= funpack(y,&yf,&ye,&ys);
zt= funpack(z,&zf,&ze,&zs);
xs= ys+zs-'+';
switch(4*yt+zt){
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4*nan+nan:if(!(y.h&0x80000))exceptions|= I_BIT;
case 4*zro+nan:case 4*num+nan:case 4*inf+nan:
if(!(z.h&0x80000))exceptions|= I_BIT,z.h|= 0x80000;
return z;
case 4*nan+zro:case 4*nan+num:case 4*nan+inf:
if(!(y.h&0x80000))exceptions|= I_BIT,y.h|= 0x80000;
return y;
 
/*:42*/
#line 763 "./mmix-arith.w"
;
case 4*zro+inf:case 4*zro+num:case 4*num+inf:x= zero_octa;break;
case 4*num+zro:exceptions|= Z_BIT;
case 4*inf+num:case 4*inf+zro:x= inf_octa;break;
case 4*zro+zro:case 4*inf+inf:x= standard_NaN;
exceptions|= I_BIT;break;
case 4*num+num:/*45:*/
#line 775 "./mmix-arith.w"
 
xe= ye-ze+0x3fd;
xf= odiv(yf,zero_octa,shift_left(zf,9));
if(xf.h>=0x800000){
aux.l|= xf.l&1;
xf= shift_right(xf,1,1);
xe++;
}
if(aux.h||aux.l)xf.l|= 1;
return fpack(xf,xe,xs,cur_round);
 
/*:45*/
#line 769 "./mmix-arith.w"
;
}
if(xs=='-')x.h|= sign_bit;
return x;
}
 
/*:44*//*46:*/
#line 790 "./mmix-arith.w"
 
octa fplus ARGS((octa,octa));
octa fplus(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa x,xf,yf,zf;
register int xe,d;
register char xs;
yt= funpack(y,&yf,&ye,&ys);
zt= funpack(z,&zf,&ze,&zs);
switch(4*yt+zt){
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4*nan+nan:if(!(y.h&0x80000))exceptions|= I_BIT;
case 4*zro+nan:case 4*num+nan:case 4*inf+nan:
if(!(z.h&0x80000))exceptions|= I_BIT,z.h|= 0x80000;
return z;
case 4*nan+zro:case 4*nan+num:case 4*nan+inf:
if(!(y.h&0x80000))exceptions|= I_BIT,y.h|= 0x80000;
return y;
 
/*:42*/
#line 804 "./mmix-arith.w"
;
case 4*zro+num:return fpack(zf,ze,zs,ROUND_OFF);break;
case 4*num+zro:return fpack(yf,ye,ys,ROUND_OFF);break;
case 4*inf+inf:if(ys!=zs){
exceptions|= I_BIT;x= standard_NaN;xs= zs;break;
}
case 4*num+inf:case 4*zro+inf:x= inf_octa;xs= zs;break;
case 4*inf+num:case 4*inf+zro:x= inf_octa;xs= ys;break;
case 4*num+num:if(y.h!=(z.h^0x80000000)||y.l!=z.l)
/*47:*/
#line 821 "./mmix-arith.w"
 
{octa o,oo;
if(ye<ze||(ye==ze&&(yf.h<zf.h||(yf.h==zf.h&&yf.l<zf.l))))
/*48:*/
#line 839 "./mmix-arith.w"
 
{
o= yf,yf= zf,zf= o;
d= ye,ye= ze,ze= d;
d= ys,ys= zs,zs= d;
}
 
/*:48*/
#line 824 "./mmix-arith.w"
;
d= ye-ze;
xs= ys,xe= ye;
if(d)/*49:*/
#line 859 "./mmix-arith.w"
 
{
if(d<=2)zf= shift_right(zf,d,1);
else if(d> 53)zf.h= 0,zf.l= 1;
else{
if(ys!=zs)d--,xe--,yf= shift_left(yf,1);
o= zf;
zf= shift_right(o,d,1);
oo= shift_left(zf,d);
if(oo.l!=o.l||oo.h!=o.h)zf.l|= 1;
}
}
 
/*:49*/
#line 827 "./mmix-arith.w"
;
if(ys==zs){
xf= oplus(yf,zf);
if(xf.h>=0x800000)xe++,d= xf.l&1,xf= shift_right(xf,1,1),xf.l|= d;
}else{
xf= ominus(yf,zf);
if(xf.h>=0x800000)xe++,d= xf.l&1,xf= shift_right(xf,1,1),xf.l|= d;
else while(xf.h<0x400000)xe--,xf= shift_left(xf,1);
}
return fpack(xf,xe,xs,cur_round);
}
 
/*:47*/
#line 813 "./mmix-arith.w"
;
case 4*zro+zro:x= zero_octa;
xs= (ys==zs?ys:cur_round==ROUND_DOWN?'-':'+');break;
}
if(xs=='-')x.h|= sign_bit;
return x;
}
 
/*:46*//*50:*/
#line 883 "./mmix-arith.w"
 
int fepscomp ARGS((octa,octa,octa,int));
int fepscomp(y,z,e,s)
octa y,z,e;
int s;
{
octa yf,zf,ef,o,oo;
int ye,ze,ee;
char ys,zs,es;
register int yt,zt,et,d;
et= funpack(e,&ef,&ee,&es);
if(es=='-')return 2;
switch(et){
case nan:return 2;
case inf:ee= 10000;
case num:case zro:break;
}
yt= funpack(y,&yf,&ye,&ys);
zt= funpack(z,&zf,&ze,&zs);
switch(4*yt+zt){
case 4*nan+nan:case 4*nan+inf:case 4*nan+num:case 4*nan+zro:
case 4*inf+nan:case 4*num+nan:case 4*zro+nan:return 2;
case 4*inf+inf:return(ys==zs||ee>=1023);
case 4*inf+num:case 4*inf+zro:case 4*num+inf:case 4*zro+inf:
return(s&&ee>=1022);
case 4*zro+zro:return 1;
case 4*zro+num:case 4*num+zro:if(!s)return 0;
case 4*num+num:break;
}
/*51:*/
#line 919 "./mmix-arith.w"
 
/*52:*/
#line 934 "./mmix-arith.w"
 
if(ye<0&&yt!=zro)yf= shift_left(y,2),ye= 0;
if(ze<0&&zt!=zro)zf= shift_left(z,2),ze= 0;
 
/*:52*/
#line 920 "./mmix-arith.w"
;
if(ye<ze||(ye==ze&&(yf.h<zf.h||(yf.h==zf.h&&yf.l<zf.l))))
/*48:*/
#line 839 "./mmix-arith.w"
 
{
o= yf,yf= zf,zf= o;
d= ye,ye= ze,ze= d;
d= ys,ys= zs,zs= d;
}
 
/*:48*/
#line 922 "./mmix-arith.w"
;
if(ze==zero_exponent)ze= ye;
d= ye-ze;
if(!s)ee-= d;
if(ee>=1023)return 1;
/*53:*/
#line 956 "./mmix-arith.w"
 
if(d> 54)o= zero_octa,oo= zf;
else o= shift_right(zf,d,1),oo= shift_left(o,d);
if(oo.h!=zf.h||oo.l!=zf.l){
if(ee<1020)return 0;
o= incr(o,ys==zs?0:1);
}
o= (ys==zs?ominus(yf,o):oplus(yf,o));
 
/*:53*/
#line 927 "./mmix-arith.w"
;
if(!o.h&&!o.l)return 1;
if(ee<968)return 0;
if(ee>=1021)ef= shift_left(ef,ee-1021);
else ef= shift_right(ef,1021-ee,1);
return o.h<ef.h||(o.h==ef.h&&o.l<=ef.l);
 
/*:51*/
#line 912 "./mmix-arith.w"
;
}
 
/*:50*//*54:*/
#line 972 "./mmix-arith.w"
 
static void bignum_times_ten ARGS((bignum*));
static void bignum_dec ARGS((bignum*,bignum*,tetra));
static int bignum_compare ARGS((bignum*,bignum*));
void print_float ARGS((octa));
void print_float(x)
octa x;
{
/*56:*/
#line 1035 "./mmix-arith.w"
 
octa f,g;
register int e;
register int j,k;
 
/*:56*//*66:*/
#line 1281 "./mmix-arith.w"
 
bignum ff,gg;
bignum tt;
char s[18];
register char*p;
 
/*:66*/
#line 980 "./mmix-arith.w"
;
if(x.h&sign_bit)printf("-");
/*55:*/
#line 1019 "./mmix-arith.w"
 
f= shift_left(x,1);
e= f.h>>21;
f.h&= 0x1fffff;
if(!f.h&&!f.l)/*57:*/
#line 1045 "./mmix-arith.w"
 
{
if(!e){
printf("0.");return;
}
if(e==0x7ff){
printf("Inf");return;
}
e--;
f.h= 0x3fffff,f.l= 0xffffffff;
g.h= 0x400000,g.l= 2;
}
 
/*:57*/
#line 1023 "./mmix-arith.w"
 
else{
g= incr(f,1);
f= incr(f,-1);
if(!e)e= 1;
else if(e==0x7ff){
printf("NaN");
if(g.h==0x100000&&g.l==1)return;
e= 0x3ff;
}else f.h|= 0x200000,g.h|= 0x200000;
}
 
/*:55*/
#line 983 "./mmix-arith.w"
;
/*63:*/
#line 1195 "./mmix-arith.w"
 
k= (magic_offset-e)/28;
ff.dat[k-1]= shift_right(f,magic_offset+28-e-28*k,1).l&0xfffffff;
gg.dat[k-1]= shift_right(g,magic_offset+28-e-28*k,1).l&0xfffffff;
ff.dat[k]= shift_right(f,magic_offset-e-28*k,1).l&0xfffffff;
gg.dat[k]= shift_right(g,magic_offset-e-28*k,1).l&0xfffffff;
ff.dat[k+1]= shift_left(f,e+28*k-(magic_offset-28)).l&0xfffffff;
gg.dat[k+1]= shift_left(g,e+28*k-(magic_offset-28)).l&0xfffffff;
ff.a= (ff.dat[k-1]?k-1:k);
ff.b= (ff.dat[k+1]?k+1:k);
gg.a= (gg.dat[k-1]?k-1:k);
gg.b= (gg.dat[k+1]?k+1:k);
 
/*:63*/
#line 984 "./mmix-arith.w"
;
/*64:*/
#line 1223 "./mmix-arith.w"
 
if(e> 0x401)/*65:*/
#line 1254 "./mmix-arith.w"
 
{register int open= x.l&1;
tt.dat[origin]= 10;
tt.a= tt.b= origin;
for(e= 1;bignum_compare(&gg,&tt)>=open;e++)
bignum_times_ten(&tt);
p= s;
while(1){
bignum_times_ten(&ff);
bignum_times_ten(&gg);
for(j= '0';bignum_compare(&ff,&tt)>=0;j++)
bignum_dec(&ff,&tt,0x10000000),bignum_dec(&gg,&tt,0x10000000);
if(bignum_compare(&gg,&tt)>=open)break;
*p++= j;
if(ff.a==bignum_prec-1&&!open)
goto done;
}
for(k= j;bignum_compare(&gg,&tt)>=open;k++)bignum_dec(&gg,&tt,0x10000000);
*p++= (j+1+k)>>1;
done:;
}
 
/*:65*/
#line 1224 "./mmix-arith.w"
 
else{
if(ff.a> origin)ff.dat[origin]= 0;
for(e= 1,p= s;gg.a> origin||ff.dat[origin]==gg.dat[origin];){
if(gg.a> origin)e--;
else*p++= ff.dat[origin]+'0',ff.dat[origin]= 0,gg.dat[origin]= 0;
bignum_times_ten(&ff);
bignum_times_ten(&gg);
}
*p++= ((ff.dat[origin]+1+gg.dat[origin])>>1)+'0';
}
*p= '\0';
 
/*:64*/
#line 985 "./mmix-arith.w"
;
/*67:*/
#line 1296 "./mmix-arith.w"
 
if(e> 17||e<(int)strlen(s)-17)
printf("%c%s%se%d",s[0],(s[1]?".":""),s+1,e-1);
else if(e<0)printf(".%0*d%s",-e,0,s);
else if(strlen(s)>=e)printf("%.*s.%s",e,s,s+e);
else printf("%s%0*d.",s,e-(int)strlen(s),0);
 
/*:67*/
#line 986 "./mmix-arith.w"
;
}
 
/*:54*//*60:*/
#line 1120 "./mmix-arith.w"
 
static void bignum_times_ten(f)
bignum*f;
{
register tetra*p,*q;register tetra x,carry;
for(p= &f->dat[f->b],q= &f->dat[f->a],carry= 0;p>=q;p--){
x= *p*10+carry;
*p= x&0xfffffff;
carry= x>>28;
}
*p= carry;
if(carry)f->a--;
if(f->dat[f->b]==0&&f->b> f->a)f->b--;
}
 
/*:60*//*61:*/
#line 1138 "./mmix-arith.w"
 
static int bignum_compare(f,g)
bignum*f,*g;
{
register tetra*p,*pp,*q,*qq;
if(f->a!=g->a)return f->a> g->a?-1:1;
pp= &f->dat[f->b],qq= &g->dat[g->b];
for(p= &f->dat[f->a],q= &g->dat[g->a];p<=pp;p++,q++){
if(*p!=*q)return*p<*q?-1:1;
if(q==qq)return p<pp;
}
return-1;
}
 
/*:61*//*62:*/
#line 1155 "./mmix-arith.w"
 
static void bignum_dec(f,g,r)
bignum*f,*g;
tetra r;
{
register tetra*p,*q,*qq;
register int x,borrow;
while(g->b> f->b)f->dat[++f->b]= 0;
qq= &g->dat[g->a];
for(p= &f->dat[g->b],q= &g->dat[g->b],borrow= 0;q>=qq;p--,q--){
x= *p-*q-borrow;
if(x>=0)borrow= 0,*p= x;
else borrow= 1,*p= x+r;
}
for(;borrow;p--)
if(*p)borrow= 0,*p= *p-1;
else*p= r-1;
while(f->dat[f->a]==0){
if(f->a==f->b){
f->a= f->b= bignum_prec-1,f->dat[bignum_prec-1]= 0;
return;
}
f->a++;
}
while(f->dat[f->b]==0)f->b--;
}
 
/*:62*//*68:*/
#line 1340 "./mmix-arith.w"
 
static void bignum_double ARGS((bignum*));
int scan_const ARGS((char*));
int scan_const(s)
char*s;
{
/*70:*/
#line 1363 "./mmix-arith.w"
 
register char*p,*q;
register bool NaN;
int sign;
 
/*:70*//*76:*/
#line 1435 "./mmix-arith.w"
 
register char*dec_pt;
register int exp;
register int zeros;
 
/*:76*//*81:*/
#line 1503 "./mmix-arith.w"
 
register int k,x;
register char*pp;
bignum ff,tt;
 
/*:81*/
#line 1346 "./mmix-arith.w"
;
val.h= val.l= 0;
p= s;
if(*p=='+'||*p=='-')sign= *p++;else sign= '+';
if(strncmp(p,"NaN",3)==0)NaN= true,p+= 3;
else NaN= false;
if((isdigit(*p)&&!NaN)||(*p=='.'&&isdigit(*(p+1))))
/*73:*/
#line 1396 "./mmix-arith.w"
 
{
for(q= buf0,dec_pt= (char*)0;isdigit(*p);p++){
val= oplus(val,shift_left(val,2));
val= incr(shift_left(val,1),*p-'0');
if(q> buf0||*p!='0')
if(q<buf_max)*q++= *p;
else if(*(q-1)=='0')*(q-1)= *p;
}
if(NaN)*q++= '1';
if(*p=='.')/*74:*/
#line 1415 "./mmix-arith.w"
 
{
dec_pt= q;
p++;
for(zeros= 0;isdigit(*p);p++)
if(*p=='0'&&q==buf0)zeros++;
else if(q<buf_max)*q++= *p;
else if(*(q-1)=='0')*(q-1)= *p;
}
 
/*:74*/
#line 1406 "./mmix-arith.w"
;
next_char= p;
if(*p=='e'&&!NaN)/*77:*/
#line 1447 "./mmix-arith.w"
 
{register char exp_sign;
p++;
if(*p=='+'||*p=='-')exp_sign= *p++;else exp_sign= '+';
if(isdigit(*p)){
for(exp= *p++-'0';isdigit(*p);p++)
if(exp<1000)exp= 10*exp+*p-'0';
if(!dec_pt)dec_pt= q,zeros= 0;
if(exp_sign=='-')exp= -exp;
next_char= p;
}
}
 
/*:77*/
#line 1408 "./mmix-arith.w"
 
else exp= 0;
if(dec_pt)/*78:*/
#line 1460 "./mmix-arith.w"
 
{
/*79:*/
#line 1477 "./mmix-arith.w"
 
x= buf+341+zeros-dec_pt-exp;
if(q==buf0||x>=1413){
make_it_zero:exp= -99999;goto packit;
}
if(x<0){
make_it_infinite:exp= 99999;goto packit;
}
ff.a= x/9;
for(p= q;p<q+8;p++)*p= '0';
q= q-1-(q+341+zeros-dec_pt-exp)%9;
for(p= buf0-x%9,k= ff.a;p<=q&&k<=156;p+= 9,k++)
/*80:*/
#line 1497 "./mmix-arith.w"
 
{
for(x= *p-'0',pp= p+1;pp<p+9;pp++)x= 10*x+*pp-'0';
ff.dat[k]= x;
}
 
/*:80*/
#line 1490 "./mmix-arith.w"
;
ff.b= k-1;
for(x= 0;p<=q;p+= 9)if(strncmp(p,"000000000",9)!=0)x= 1;
ff.dat[156]+= x;
 
while(ff.dat[ff.b]==0)ff.b--;
 
/*:79*/
#line 1462 "./mmix-arith.w"
;
/*83:*/
#line 1526 "./mmix-arith.w"
 
val= zero_octa;
if(ff.a> 36){
for(exp= 0x3fe;ff.a> 36;exp--)bignum_double(&ff);
for(k= 54;k;k--){
if(ff.dat[36]){
if(k>=32)val.h|= 1<<(k-32);else val.l|= 1<<k;
ff.dat[36]= 0;
if(ff.b==36)break;
}
bignum_double(&ff);
}
}else{
tt.a= tt.b= 36,tt.dat[36]= 2;
for(exp= 0x3fe;bignum_compare(&ff,&tt)>=0;exp++)bignum_double(&tt);
for(k= 54;k;k--){
bignum_double(&ff);
if(bignum_compare(&ff,&tt)>=0){
if(k>=32)val.h|= 1<<(k-32);else val.l|= 1<<k;
bignum_dec(&ff,&tt,1000000000);
if(ff.a==bignum_prec-1)break;
}
}
}
if(k==0)val.l|= 1;
 
/*:83*/
#line 1463 "./mmix-arith.w"
;
packit:/*84:*/
#line 1559 "./mmix-arith.w"
 
val= fpack(val,exp,sign,ROUND_NEAR);
if(NaN){
if((val.h&0x7fffffff)==0x40000000)val.h|= 0x7fffffff,val.l= 0xffffffff;
else if((val.h&0x7fffffff)==0x3ff00000&&!val.l)val.h|= 0x40000000,val.l= 1;
else val.h|= 0x40000000;
}
 
/*:84*/
#line 1464 "./mmix-arith.w"
;
return 1;
}
 
/*:78*/
#line 1410 "./mmix-arith.w"
;
if(sign=='-')val= ominus(zero_octa,val);
return 0;
}
 
/*:73*/
#line 1353 "./mmix-arith.w"
;
if(NaN)/*71:*/
#line 1368 "./mmix-arith.w"
 
{
next_char= p;
val.h= 0x600000,exp= 0x3fe;
goto packit;
}
 
/*:71*/
#line 1354 "./mmix-arith.w"
;
if(strncmp(p,"Inf",3)==0)/*72:*/
#line 1375 "./mmix-arith.w"
 
{
next_char= p+3;
goto make_it_infinite;
}
 
/*:72*/
#line 1355 "./mmix-arith.w"
;
no_const_found:next_char= s;return-1;
}
 
/*:68*//*82:*/
#line 1511 "./mmix-arith.w"
 
static void bignum_double(f)
bignum*f;
{
register tetra*p,*q;register int x,carry;
for(p= &f->dat[f->b],q= &f->dat[f->a],carry= 0;p>=q;p--){
x= *p+*p+carry;
if(x>=1000000000)carry= 1,*p= x-1000000000;
else carry= 0,*p= x;
}
*p= carry;
if(carry)f->a--;
if(f->dat[f->b]==0&&f->b> f->a)f->b--;
}
 
/*:82*//*85:*/
#line 1575 "./mmix-arith.w"
 
int fcomp ARGS((octa,octa));
int fcomp(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa yf,zf;
register int x;
yt= funpack(y,&yf,&ye,&ys);
zt= funpack(z,&zf,&ze,&zs);
switch(4*yt+zt){
case 4*nan+nan:case 4*zro+nan:case 4*num+nan:case 4*inf+nan:
case 4*nan+zro:case 4*nan+num:case 4*nan+inf:return 2;
case 4*zro+zro:return 0;
case 4*zro+num:case 4*num+zro:case 4*zro+inf:case 4*inf+zro:
case 4*num+num:case 4*num+inf:case 4*inf+num:case 4*inf+inf:
if(ys!=zs)x= 1;
else if(y.h> z.h)x= 1;
else if(y.h<z.h)x= -1;
else if(y.l> z.l)x= 1;
else if(y.l<z.l)x= -1;
else return 0;
break;
}
return(ys=='-'?-x:x);
}
 
/*:85*//*86:*/
#line 1608 "./mmix-arith.w"
 
octa fintegerize ARGS((octa,int));
octa fintegerize(z,r)
octa z;
int r;
{
ftype zt;
int ze;
char zs;
octa xf,zf;
zt= funpack(z,&zf,&ze,&zs);
if(!r)r= cur_round;
switch(zt){
case nan:if(!(z.h&0x80000)){exceptions|= I_BIT;z.h|= 0x80000;}
case inf:case zro:return z;
case num:/*87:*/
#line 1627 "./mmix-arith.w"
 
if(ze>=1074)return fpack(zf,ze,zs,ROUND_OFF);
if(ze<=1020)xf.h= 0,xf.l= 1;
else{octa oo;
xf= shift_right(zf,1074-ze,1);
oo= shift_left(xf,1074-ze);
if(oo.l!=zf.l||oo.h!=zf.h)xf.l|= 1;
 
}
switch(r){
case ROUND_DOWN:if(zs=='-')xf= incr(xf,3);break;
case ROUND_UP:if(zs!='-')xf= incr(xf,3);
case ROUND_OFF:break;
case ROUND_NEAR:xf= incr(xf,xf.l&4?2:1);break;
}
xf.l&= 0xfffffffc;
if(ze>=1022)return fpack(shift_left(xf,1074-ze),ze,zs,ROUND_OFF);
if(xf.l)xf.h= 0x3ff00000,xf.l= 0;
if(zs=='-')xf.h|= sign_bit;
return xf;
 
/*:87*/
#line 1623 "./mmix-arith.w"
;
}
}
 
/*:86*//*88:*/
#line 1650 "./mmix-arith.w"
 
octa fixit ARGS((octa,int));
octa fixit(z,r)
octa z;
int r;
{
ftype zt;
int ze;
char zs;
octa zf,o;
zt= funpack(z,&zf,&ze,&zs);
if(!r)r= cur_round;
switch(zt){
case nan:case inf:exceptions|= I_BIT;return z;
case zro:return zero_octa;
case num:if(funpack(fintegerize(z,r),&zf,&ze,&zs)==zro)return zero_octa;
if(ze<=1076)o= shift_right(zf,1076-ze,1);
else{
if(ze> 1085||(ze==1085&&(zf.h> 0x400000||
(zf.h==0x400000&&(zf.l||zs!='-')))))exceptions|= W_BIT;
if(ze>=1140)return zero_octa;
o= shift_left(zf,ze-1076);
}
return(zs=='-'?ominus(zero_octa,o):o);
}
}
 
/*:88*//*89:*/
#line 1681 "./mmix-arith.w"
 
octa floatit ARGS((octa,int,int,int));
octa floatit(z,r,u,p)
octa z;
int r;
int u;
int p;
{
int e;char s;
register int t;
exceptions= 0;
if(!z.h&&!z.l)return zero_octa;
if(!r)r= cur_round;
if(!u&&(z.h&sign_bit))s= '-',z= ominus(zero_octa,z);else s= '+';
e= 1076;
while(z.h<0x400000)e--,z= shift_left(z,1);
while(z.h>=0x800000){
e++;
t= z.l&1;
z= shift_right(z,1,1);
z.l|= t;
}
if(p)/*90:*/
#line 1707 "./mmix-arith.w"
 
{
register int ex;register tetra t;
t= sfpack(z,e,s,r);
ex= exceptions;
sfunpack(t,&z,&e,&s);
exceptions= ex;
}
 
/*:90*/
#line 1703 "./mmix-arith.w"
;
return fpack(z,e,s,r);
}
 
/*:89*//*91:*/
#line 1718 "./mmix-arith.w"
 
octa froot ARGS((octa,int));
octa froot(z,r)
octa z;
int r;
{
ftype zt;
int ze;
char zs;
octa x,xf,rf,zf;
register int xe,k;
if(!r)r= cur_round;
zt= funpack(z,&zf,&ze,&zs);
if(zs=='-'&&zt!=zro)exceptions|= I_BIT,x= standard_NaN;
else switch(zt){
case nan:if(!(z.h&0x80000))exceptions|= I_BIT,z.h|= 0x80000;
return z;
case inf:case zro:x= z;break;
case num:/*92:*/
#line 1750 "./mmix-arith.w"
 
xf.h= 0,xf.l= 2;
xe= (ze+0x3fe)>>1;
if(ze&1)zf= shift_left(zf,1);
rf.h= 0,rf.l= (zf.h>>22)-1;
for(k= 53;k;k--){
rf= shift_left(rf,2);xf= shift_left(xf,1);
if(k>=43)rf= incr(rf,(zf.h>>(2*(k-43)))&3);
else if(k>=27)rf= incr(rf,(zf.l>>(2*(k-27)))&3);
if((rf.l> xf.l&&rf.h>=xf.h)||rf.h> xf.h){
xf.l++;rf= ominus(rf,xf);xf.l++;
}
}
if(rf.h||rf.l)xf.l++;
return fpack(xf,xe,'+',r);
 
/*:92*/
#line 1736 "./mmix-arith.w"
;
}
if(zs=='-')x.h|= sign_bit;
return x;
}
 
/*:91*//*93:*/
#line 1774 "./mmix-arith.w"
 
octa fremstep ARGS((octa,octa,int));
octa fremstep(y,z,delta)
octa y,z;
int delta;
{
ftype yt,zt;
int ye,ze;
char xs,ys,zs;
octa x,xf,yf,zf;
register int xe,thresh,odd;
yt= funpack(y,&yf,&ye,&ys);
zt= funpack(z,&zf,&ze,&zs);
switch(4*yt+zt){
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4*nan+nan:if(!(y.h&0x80000))exceptions|= I_BIT;
case 4*zro+nan:case 4*num+nan:case 4*inf+nan:
if(!(z.h&0x80000))exceptions|= I_BIT,z.h|= 0x80000;
return z;
case 4*nan+zro:case 4*nan+num:case 4*nan+inf:
if(!(y.h&0x80000))exceptions|= I_BIT,y.h|= 0x80000;
return y;
 
/*:42*/
#line 1788 "./mmix-arith.w"
;
case 4*zro+zro:case 4*num+zro:case 4*inf+zro:
case 4*inf+num:case 4*inf+inf:x= standard_NaN;
exceptions|= I_BIT;break;
case 4*zro+num:case 4*zro+inf:case 4*num+inf:return y;
case 4*num+num:/*94:*/
#line 1809 "./mmix-arith.w"
 
odd= 0;
thresh= ye-delta;
if(thresh<ze)thresh= ze;
while(ye>=thresh)/*95:*/
#line 1830 "./mmix-arith.w"
 
{
if(yf.h==zf.h&&yf.l==zf.l)goto zero_out;
if(yf.h<zf.h||(yf.h==zf.h&&yf.l<zf.l)){
if(ye==ze)goto try_complement;
ye--,yf= shift_left(yf,1);
}
yf= ominus(yf,zf);
if(ye==ze)odd= 1;
while(yf.h<0x400000)ye--,yf= shift_left(yf,1);
}
 
/*:95*/
#line 1815 "./mmix-arith.w"
;
if(ye>=ze){
exceptions|= E_BIT;return fpack(yf,ye,ys,ROUND_OFF);
}
if(ye<ze-1)return fpack(yf,ye,ys,ROUND_OFF);
yf= shift_right(yf,1,1);
try_complement:xf= ominus(zf,yf),xe= ze,xs= '+'+'-'-ys;
if(xf.h> yf.h||(xf.h==yf.h&&(xf.l> yf.l||(xf.l==yf.l&&!odd))))
xf= yf,xs= ys;
while(xf.h<0x400000)xe--,xf= shift_left(xf,1);
return fpack(xf,xe,xs,ROUND_OFF);
 
/*:94*/
#line 1793 "./mmix-arith.w"
;
zero_out:x= zero_octa;
}
if(ys=='-')x.h|= sign_bit;
return x;
}
 
/*:93*/
#line 41 "./mmix-arith.w"
 
 
/*:1*/
/mmix-arith.scn
0,0 → 1,109
\I\X47:Add nonzero numbers and \PB{\&{return}}\X
\U46.
\I\X49:Adjust for difference in exponents\X
\U47.
\I\X14:Check that \PB{$\|x<\|z$}; otherwise give trivial answer\X
\U13.
\I\X51:Compare two numbers with respect to epsilon and \PB{\&{return}}\X
\U50.
\I\X53:Compute the difference of fraction parts, \PB{\|o}\X
\U51.
\I\X65:Compute the significant digits in the large-exponent case\X
\U64.
\I\X64:Compute the significant digits \PB{\|s} and decimal exponent \PB{\|e}\X
\U54.
\I\X90:Convert to short float\X
\U89.
\I\X83:Determine the binary fraction and binary exponent\X
\U78.
\I\X16:Determine the number of significant places \PB{\|n} in the divisor \PB{%
\|v}\X
\U13.
\I\X20:Determine the quotient digit \PB{\|q[\|j]}\X
\U13.
\I\X45:Divide nonzero numbers and \PB{\&{return}}\X
\U44.
\I\X48:Exchange \PB{\|y} with \PB{\|z}\X
\Us47\ET51.
\I\X55:Extract the exponent \PB{\|e} and determine the fraction interval $[f%
\dts g]$ or $(f\dts g)$\X
\U54.
\I\X21:Find the trial quotient, $\hat q$\X
\U20.
\I\X4, 9, 30, 32, 69, 75:Global variables\X
\U1.
\I\X57:Handle the special case when the fraction part is zero\X
\U55.
\I\X23:If the result was negative, decrease $\hat q$ by 1\X
\U20.
\I\X87:Integerize and \PB{\&{return}}\X
\U86.
\I\X56, 66:Local variables for \PB{\\{print\_float}}\X
\U54.
\I\X70, 76, 81:Local variables for \PB{\\{scan\_const}}\X
\U68.
\I\X79:Move the digits from \PB{\\{buf}} to \PB{$\ff$}\X
\U78.
\I\X43:Multiply nonzero numbers and \PB{\&{return}}\X
\U41.
\I\X17:Normalize the divisor\X
\U13.
\I\X36, 59:Other type definitions\X
\U1.
\I\X84:Pack and round the answer\X
\U78.
\I\X19:Pack \PB{\|q} and \PB{\|u} to \PB{\\{acc}} and \PB{\\{aux}}\X
\U13.
\I\X11:Pack \PB{\|w} into the outputs \PB{\\{aux}} and \PB{\\{acc}}\X
\U8.
\I\X67:Print the significant digits with proper context\X
\U54.
\I\X80:Put the 9-digit number \PB{${*}\|p$}\thinspace\dots\thinspace\PB{${*}(%
\|p+\T{8})$} into \PB{$\ff.\\{dat}[\|k]$}\X
\U79.
\I\X95:Reduce \PB{$(\\{ye},\\{yf})$} by a multiple of \PB{\\{zf}}; \PB{\&{goto}
\\{zero\_out}} if the remainder is zero, \PB{\&{goto} \\{try\_complement}} if
appropriate\X
\U94.
\I\X94:Remainderize nonzero numbers and \PB{\&{return}}\X
\U93.
\I\X78:Return a floating point constant\X
\U73.
\I\X72:Return infinity\X
\U68.
\I\X71:Return the standard NaN\X
\U68.
\I\X33:Round and return the result\X
\U31.
\I\X35:Round and return the short result\X
\U34.
\I\X74:Scan a fraction part\X
\U73.
\I\X73:Scan a number and \PB{\&{return}}\X
\U68.
\I\X77:Scan an exponent\X
\U73.
\I\X63:Store $f$ and $g$ as multiprecise integers\X
\U54.
\I\X2:Stuff for \CEE/ preprocessor\X
\U1.
\I\X5, 6, 7, 8, 12, 13, 24, 25, 26, 27, 28, 29, 31, 34, 37, 38, 39, 40, 41, 44,
46, 50, 54, 60, 61, 62, 68, 82, 85, 86, 88, 89, 91, 93:Subroutines\X
\U1.
\I\X22:Subtract $b^j\hat q v$ from \PB{\|u}\X
\U20.
\I\X92:Take the square root and \PB{\&{return}}\X
\U91.
\I\X3:Tetrabyte and octabyte type definitions\X
\U1.
\I\X42:The usual NaN cases\X
\Us41, 44, 46\ETs93.
\I\X18:Unnormalize the remainder\X
\U13.
\I\X15:Unpack the dividend and divisor to \PB{\|u} and \PB{\|v}\X
\U13.
\I\X10:Unpack the multiplier and multiplicand to \PB{\|u} and \PB{\|v}\X
\U8.
\I\X52:Unsubnormalize \PB{\|y} and \PB{\|z}, if they are subnormal\X
\U51.
 
/mmix-arith.idx
0,0 → 1,212
\I\.{\_\_STDC\_\_}, 2.
\I\|{a}, \[28], \[29], \[59].
\I\\{acc}, \[8], 11, \[12], \[13], 19.
\I\.{ARGS}, \[2], \[5], \[6], \[7], \[8], \[12], \[13], \[24], \[25], \[26], %
\[27], \[28], \[29], \[31], \[34], \[37], \[38], \[39], \[40], \[41], \[44], %
\[46], \[50], \[54], \[68], \[85], \[86], \[88], \[89], \[91], \[93].
\I\\{aux}, \[4], 8, \[9], 11, 12, 13, 14, 19, 24, 43, 45.
\I\|{b}, \[28], \[29], \[59].
\I\&{bignum}, 54, \[59], 60, 61, 62, 66, 68, 81, 82.
\I\\{bignum\_compare}, \[54], \[61], 64, 65, 83.
\I\\{bignum\_dec}, \[54], \[62], 65, 83.
\I\\{bignum\_double}, \[68], \[82], 83.
\I\\{bignum\_prec}, \[59], 62, 65, 83.
\I\\{bignum\_times\_ten}, \[54], \[60], 64, 65, 82.
\I{binary-to-decimal conversion}, 54.
\I\&{bool}, \[1], 4, 9, 29, 70.
\I\\{bool\_mult}, \[29].
\I\\{borrow}, \[62].
\I\\{buf}, \[75], 76, 79.
\I\\{buf\_max}, 73, 74, \[75].
\I\\{buf0}, 73, 74, \[75], 79.
\I\\{byte\_diff}, \[27], 28.
\I\|{c}, \[29].
\I\\{carry}, \[60], \[82].
\I\\{count\_bits}, \[26], 28.
\I\\{cur\_round}, \[30], 40, 43, 45, 46, 47, 86, 88, 89, 91.
\I\|{d}, \[13], \[27], \[46], \[50].
\I\.{D\_BIT}, \[31].
\I\\{dat}, \[59], 60, 61, 62, 63, 64, 65, 79, 80, 82, 83.
\I\\{dec\_pt}, 73, 74, \[76], 77, 79.
\I{decimal-to-binary conversion}, 68.
\I\\{delta}, \[6], \[93], 94.
\I\\{done}, \[65].
\I\|{e}, \[31], \[34], \[37], \[38], \[39], \[40], \[50], \[56], \[89].
\I\.{E\_BIT}, \[31], 93, 94.
\I\\{ee}, \[37], \[38], \[50], 51, 53.
\I\\{ef}, \[50], 51, 53.
\I\\{es}, \[50].
\I\\{et}, \[50].
\I\\{ex}, \[90].
\I\\{exceptions}, 31, \[32], 33, 35, 36, 37, 38, 40, 41, 42, 44, 46, 68, 86,
88, 89, 90, 91, 93, 94.
\I\\{exp}, 71, 73, \[76], 77, 79, 83, 84.
\I\\{exp\_sign}, \[77].
\I\|{f}, \[31], \[34], \[37], \[38], \[39], \[40], \[56], \[60], \[61], \[62], %
\[82].
\I\\{false}, 1, 24, 68.
\I\\{fcomp}, \[85].
\I\\{fdivide}, \[44].
\I\\{fepscomp}, \[50].
\I$\ff$, 63, 64, 65, \[66], 79, 80, \[81], 83.
\I\\{fintegerize}, \[86], 88.
\I\\{fixit}, \[88].
\I\\{floatit}, \[89].
\I\\{fmult}, \[41].
\I\\{fpack}, \[31], 34, 36, 39, 43, 45, 46, 47, 49, 84, 87, 89, 92, 94.
\I\\{fplus}, \[46].
\I\\{fremstep}, \[93].
\I\\{froot}, \[91].
\I\&{ftype}, \[36], 37, 38, 39, 40, 41, 44, 46, 85, 86, 88, 91, 93.
\I\\{funpack}, 36, \[37], 40, 41, 44, 46, 50, 85, 86, 88, 91, 93.
\I\|{g}, \[56], \[61], \[62].
\I\\{gg}, 63, 64, 65, \[66].
\I{Gill, Stanley}, 26.
\I{Gillies, Donald Bruce}, 26.
\I\|{h}, \[3].
\I\|{i}, \[8], \[13].
\I\.{I\_BIT}, \[31], 40, 41, 42, 44, 46, 86, 88, 91, 93.
\I\\{incr}, \[6], 33, 53, 55, 73, 87, 92.
\I\\{inf}, \[36], 37, 38, 39, 40, 41, 42, 44, 46, 50, 85, 86, 88, 91, 93.
\I\\{inf\_octa}, \[4], 39, 41, 44, 46.
\I\\{isdigit}, 68, 73, 74, 77.
\I\|{j}, \[8], \[13], \[56].
\I\|{k}, \[8], \[13], \[29], \[56], \[81], \[91].
\I{Knuth, Donald Ervin}, 58.
\I\|{l}, \[3].
\I\\{list}, 2.
\I\\{load\_sf}, \[39].
\I\|{m}, \[27].
\I\\{magic\_offset}, \[63].
\I\\{make\_it\_infinite}, 72, \[79].
\I\\{make\_it\_zero}, \[79].
\I\\{mask}, \[13], 18.
\I{Miller, Jeffrey Charles Percy}, 26.
\I{multiprecision conversion}, 54, 68.
\I{multiprecision division}, 13.
\I{multiprecision multiplication}, 8.
\I\|{n}, \[13].
\I\\{nan}, \[36], 37, 38, 39, 40, 42, 50, 85, 86, 88, 91.
\I\\{NaN}, 68, \[70], 73, 84.
\I\\{neg\_one}, \[4], 24.
\I\\{negate\_q}, \[24].
\I\\{next\_char}, 68, \[69], 71, 72, 73, 77.
\I\\{no\_const\_found}, \[68].
\I\\{num}, \[36], 37, 38, 39, 40, 41, 42, 44, 46, 50, 85, 86, 88, 91, 93.
\I\|{o}, \[29], \[31], \[34], \[47], \[50], \[88].
\I\.{O\_BIT}, \[31], 33, 35.
\I\\{oand}, \[25].
\I\\{oandn}, \[25].
\I\&{octa}, \[3], 4, 5, 6, 7, 8, 9, 12, 13, 24, 25, 29, 31, 34, 37, 38, 39, 40,
41, 44, 46, 47, 50, 54, 56, 69, 85, 86, 87, 88, 89, 91, 93.
\I\\{odd}, \[93], 94, 95.
\I\\{odiv}, \[13], 24, 45.
\I\\{ominus}, \[5], 12, 24, 47, 53, 73, 88, 89, 92, 94, 95.
\I\\{omult}, \[8], 12, 43.
\I\\{oo}, \[31], \[34], \[47], 49, \[50], 53, \[87].
\I\\{open}, \[65].
\I\\{oplus}, \[5], 47, 53, 73.
\I\\{origin}, \[63], 64, 65.
\I\\{overflow}, \[4], \[9], 12, 24.
\I\\{oxor}, \[25].
\I\\{o0}, \[34].
\I\|{p}, \[60], \[61], \[62], \[66], \[70], \[82], \[89].
\I\\{packit}, 71, \[78], 79.
\I\\{pp}, \[61], 80, \[81].
\I\\{print\_float}, \[54], 59.
\I\\{printf}, 54, 55, 57, 67.
\I{prototypes for functions}, 2.
\I\|{q}, \[13], \[24], \[60], \[61], \[62], \[70], \[82].
\I\\{qhat}, \[13], 20, 21, 22, 23.
\I\\{qq}, \[61], \[62].
\I\|{r}, \[31], \[34], \[62], \[86], \[88], \[89], \[91].
\I{radix conversion}, 54, 68.
\I\\{rf}, \[91], 92.
\I\\{rhat}, \[13], 21.
\I{Rossmanith, Peter}, 26.
\I\.{ROUND\_DOWN}, \[30], 33, 35, 46, 87.
\I\.{ROUND\_NEAR}, \[30], 33, 35, 84, 87.
\I\.{ROUND\_OFF}, \[30], 33, 35, 39, 46, 87, 94.
\I\.{ROUND\_UP}, \[30], 33, 35, 87.
\I\|{s}, \[7], \[31], \[34], \[37], \[38], \[39], \[40], \[50], \[66], \[68], %
\[89].
\I\\{scan\_const}, \[68], 69.
\I{Schwoon, Stefan}, 26.
\I\\{sfpack}, \[34], 39, 40, 90.
\I\\{sfunpack}, \[38], 39, 90.
\I\\{shift\_left}, \[7], 31, 34, 37, 38, 43, 45, 47, 49, 51, 52, 53, 55, 63,
73, 87, 88, 89, 92, 94, 95.
\I\\{shift\_right}, \[7], 29, 31, 33, 39, 45, 47, 49, 51, 53, 63, 87, 88, 89,
94.
\I\\{sign}, 68, \[70], 73, 84.
\I\\{sign\_bit}, \[4], 12, 24, 33, 35, 37, 38, 39, 40, 41, 44, 46, 54, 87, 89,
91, 93.
\I\\{signed\_odiv}, \[24].
\I\\{signed\_omult}, \[12].
\I{Singh, Balbir}, 26.
\I\\{standard\_NaN}, \[4], 41, 44, 46, 91, 93.
\I{sticky bit}, 31, 34, 49, 53, 79, 87.
\I\\{store\_sf}, \[40].
\I\\{strlen}, 67.
\I\\{strncmp}, 68, 79.
\I\\{sy}, \[24].
\I{syntax of floating point constants}, 68.
\I{system dependencies}, 3.
\I\\{sz}, \[24].
\I\|{t}, \[8], \[13], \[39], \[40], \[89], \[90].
\I\&{tetra}, \[3], 7, 8, 13, 26, 27, 28, 29, 34, 38, 39, 40, 54, 59, 60, 61,
62, 82, 90.
\I\\{thresh}, \[93], 94.
\I\\{true}, 1, 24, 68.
\I\\{try\_complement}, \[94], 95.
\I\\{tt}, 65, \[66], \[81], 83.
\I\|{u}, \[7], \[8], \[13], \[89].
\I\.{U\_BIT}, \[31], 33, 35.
\I{underflow}, 31.
\I\|{v}, \[8], \[13].
\I\.{V\_BIT}, \[31].
\I\\{val}, 68, \[69], 71, 73, 83, 84.
\I\\{vh}, \[13], 17, 21.
\I\\{vmh}, \[13], 17, 21.
\I\|{w}, \[8].
\I\.{W\_BIT}, \[31], 88.
\I{Wheeler, David John}, 26.
\I{Wilkes, Maurice Vincent}, 26.
\I\\{wyde\_diff}, \[28].
\I\|{x}, \[5], \[6], \[13], \[25], \[26], \[27], \[29], \[37], \[38], \[39], %
\[40], \[41], \[44], \[46], \[54], \[60], \[62], \[81], \[82], \[85], \[91], %
\[93].
\I\.{X\_BIT}, \[31], 33, 35.
\I\\{xe}, \[41], 43, \[44], 45, \[46], 47, 49, \[91], 92, \[93], 94.
\I\\{xf}, \[41], 43, \[44], 45, \[46], 47, \[86], 87, \[91], 92, \[93], 94.
\I\\{xor}, \[29].
\I\\{xs}, \[41], 43, \[44], 45, \[46], 47, \[93], 94.
\I\\{xx}, \[26].
\I\|{y}, \[5], \[6], \[7], \[8], \[12], \[13], \[24], \[25], \[27], \[28], %
\[29], \[41], \[44], \[46], \[50], \[85], \[93].
\I\\{ye}, \[41], 43, \[44], 45, \[46], 47, 48, \[50], 51, 52, \[85], \[93], 94,
95.
\I\\{yf}, \[41], 43, \[44], 45, \[46], 47, 48, 49, \[50], 51, 52, 53, \[85], %
\[93], 94, 95.
\I\\{yhl}, \[7].
\I\\{ylh}, \[7].
\I\\{ys}, \[41], \[44], \[46], 47, 48, 49, \[50], 53, \[85], \[93], 94.
\I\\{yt}, \[41], \[44], \[46], \[50], 52, \[85], \[93].
\I\\{yy}, \[24].
\I\|{z}, \[5], \[8], \[12], \[13], \[24], \[25], \[27], \[28], \[29], \[39], %
\[40], \[41], \[44], \[46], \[50], \[85], \[86], \[88], \[89], \[91], \[93].
\I\.{Z\_BIT}, \[31], 44.
\I\\{ze}, \[41], 43, \[44], 45, \[46], 47, 48, \[50], 51, 52, \[85], \[86], 87,
\[88], \[91], 92, \[93], 94, 95.
\I\\{zero\_exponent}, \[36], 37, 38, 51.
\I\\{zero\_octa}, \[4], 24, 29, 31, 39, 41, 44, 45, 46, 53, 73, 83, 88, 89, 93.
\I\\{zero\_out}, \[93], 95.
\I\\{zeros}, 74, \[76], 77, 79.
\I\\{zf}, \[41], 43, \[44], 45, \[46], 47, 48, 49, \[50], 51, 52, 53, \[85], %
\[86], 87, \[88], \[91], 92, \[93], 94, 95.
\I\\{zro}, \[36], 37, 38, 39, 40, 41, 42, 44, 46, 50, 52, 85, 86, 88, 91, 93.
\I\\{zs}, \[41], \[44], \[46], 47, 48, 49, \[50], 53, \[85], \[86], 87, \[88], %
\[91], \[93].
\I\\{zt}, \[41], \[44], \[46], \[50], 52, \[85], \[86], \[88], \[91], \[93].
\I\\{zz}, \[24].
 
/mmix-arith.w
0,0 → 1,1843
% This file is part of the MMIXware package (c) Donald E Knuth 1999
@i boilerplate.w %<< legal stuff: PLEASE READ IT BEFORE MAKING ANY CHANGES!
 
\def\title{MMIX-ARITH}
 
\def\MMIX{\.{MMIX}}
\def\MMIXAL{\.{MMIXAL}}
\def\Hex#1{\hbox{$^{\scriptscriptstyle\#}$\tt#1}} % experimental hex constant
\def\dts{\mathinner{\ldotp\ldotp}}
\def\<#1>{\hbox{$\langle\,$#1$\,\rangle$}}\let\is=\longrightarrow
\def\ff{\\{ff\kern-.05em}}
@s ff TeX
@s bool normal @q unreserve a C++ keyword @>
@s xor normal @q unreserve a C++ keyword @>
 
@* Introduction. The subroutines below are used to simulate 64-bit \MMIX\
arithmetic on an old-fashioned 32-bit computer---like the one the author
had when he wrote \MMIXAL\ and the first \MMIX\ simulators in 1998 and 1999.
All operations are fabricated from 32-bit arithmetic, including
a full implementation of the IEEE floating point standard,
assuming only that the \CEE/ compiler has a 32-bit unsigned integer type.
 
Some day 64-bit machines will be commonplace and the awkward manipulations of
the present program will look quite archaic. Interested readers who have such
computers will be able to convert the code to a pure 64-bit form without
difficulty, thereby obtaining much faster and simpler routines. Meanwhile,
however, we can simulate the future and hope for continued progress.
 
This program module has a simple structure, intended to make it
suitable for loading with \MMIX\ simulators and assemblers.
 
@c
#include <stdio.h>
#include <string.h>
#include <ctype.h>
@<Stuff for \CEE/ preprocessor@>@;
typedef enum{@+false,true@+} bool;
@<Tetrabyte and octabyte type definitions@>@;
@<Other type definitions@>@;
@<Global variables@>@;
@<Subroutines@>
 
@ Subroutines of this program are declared first with a prototype,
as in {\mc ANSI C}, then with an old-style \CEE/ function definition.
Here are some preprocessor commands that make this work correctly with both
new-style and old-style compilers.
@^prototypes for functions@>
 
@<Stuff for \CEE/ preprocessor@>=
#ifdef __STDC__
#define ARGS(list) list
#else
#define ARGS(list) ()
#endif
 
@ The definition of type \&{tetra} should be changed, if necessary, so that
it represents an unsigned 32-bit integer.
@^system dependencies@>
 
@<Tetra...@>=
typedef unsigned int tetra;
/* for systems conforming to the LP-64 data model */
typedef struct { tetra h,l;} octa; /* two tetrabytes make one octabyte */
 
@ @d sign_bit ((unsigned)0x80000000)
 
@<Glob...@>=
octa zero_octa; /* |zero_octa.h=zero_octa.l=0| */
octa neg_one={-1,-1}; /* |neg_one.h=neg_one.l=-1| */
octa inf_octa={0x7ff00000,0}; /* floating point $+\infty$ */
octa standard_NaN={0x7ff80000,0}; /* floating point NaN(.5) */
octa aux; /* auxiliary output of a subroutine */
bool overflow; /* set by certain subroutines for signed arithmetic */
 
@ It's easy to add and subtract octabytes, if we aren't terribly
worried about speed.
 
@<Subr...@>=
octa oplus @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa oplus(y,z) /* compute $y+z$ */
octa y,z;
{@+ octa x;
x.h=y.h+z.h;@+
x.l=y.l+z.l;
if (x.l<y.l) x.h++;
return x;
}
@#
octa ominus @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa ominus(y,z) /* compute $y-z$ */
octa y,z;
{@+ octa x;
x.h=y.h-z.h;@+
x.l=y.l-z.l;
if (x.l>y.l) x.h--;
return x;
}
 
@ In the following subroutine, |delta| is a signed quantity that is
assumed to fit in a signed tetrabyte.
 
@<Subr...@>=
octa incr @,@,@[ARGS((octa,int))@];@+@t}\6{@>
octa incr(y,delta) /* compute $y+\delta$ */
octa y;
int delta;
{@+ octa x;
x.h=y.h;@+ x.l=y.l+delta;
if (delta>=0) {
if (x.l<y.l) x.h++;
}@+else if (x.l>y.l) x.h--;
return x;
}
 
@ Left and right shifts are only a bit more difficult.
 
@<Subr...@>=
octa shift_left @,@,@[ARGS((octa,int))@];@+@t}\6{@>
octa shift_left(y,s) /* shift left by $s$ bits, where $0\le s\le64$ */
octa y;
int s;
{
while (s>=32) y.h=y.l,y.l=0,s-=32;
if (s) {@+register tetra yhl=y.h<<s,ylh=y.l>>(32-s);
y.h=yhl+ylh;@+ y.l<<=s;
}
return y;
}
@#
octa shift_right @,@,@[ARGS((octa,int,int))@];@+@t}\6{@>
octa shift_right(y,s,u) /* shift right, arithmetically if $u=0$ */
octa y;
int s,u;
{
while (s>=32) y.l=y.h, y.h=(u?0: -(y.h>>31)), s-=32;
if (s) {@+register tetra yhl=y.h<<(32-s),ylh=y.l>>s;
y.h=(u? 0:(-(y.h>>31))<<(32-s))+(y.h>>s);@+ y.l=yhl+ylh;
}
return y;
}
 
@* Multiplication. We need to multiply two unsigned 64-bit integers, obtaining
an unsigned 128-bit product. It is easy to do this on a 32-bit machine
by using Algorithm 4.3.1M of {\sl Seminumerical Algorithms}, with $b=2^{16}$.
@^multiprecision multiplication@>
 
The following subroutine returns the lower half of the product, and
puts the upper half into a global octabyte called |aux|.
 
@<Subr...@>=
octa omult @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa omult(y,z)
octa y,z;
{
register int i,j,k;
tetra u[4],v[4],w[8];
register tetra t;
octa acc;
@<Unpack the multiplier and multiplicand to |u| and |v|@>;
for (j=0;j<4;j++) w[j]=0;
for (j=0;j<4;j++)
if (!v[j]) w[j+4]=0;
else {
for (i=k=0;i<4;i++) {
t=u[i]*v[j]+w[i+j]+k;
w[i+j]=t&0xffff, k=t>>16;
}
w[j+4]=k;
}
@<Pack |w| into the outputs |aux| and |acc|@>;
return acc;
}
 
@ @<Glob...@>=
extern octa aux; /* secondary output of subroutines with multiple outputs */
extern bool overflow;
 
@ @<Unpack the mult...@>=
u[3]=y.h>>16, u[2]=y.h&0xffff, u[1]= y.l>>16, u[0]=y.l&0xffff;
v[3]=z.h>>16, v[2]=z.h&0xffff, v[1]= z.l>>16, v[0]=z.l&0xffff;
 
@ @<Pack |w| into the outputs |aux| and |acc|@>=
aux.h=(w[7]<<16)+w[6], aux.l=(w[5]<<16)+w[4];
acc.h=(w[3]<<16)+w[2], acc.l=(w[1]<<16)+w[0];
 
@ Signed multiplication has the same lower half product as unsigned
multiplication. The signed upper half product is obtained with at most two
further subtractions, after which the result has overflowed if and only if
the upper half is unequal to 64 copies of the sign bit in the lower half.
 
@<Subr...@>=
octa signed_omult @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa signed_omult(y,z)
octa y,z;
{
octa acc;
acc=omult(y,z);
if (y.h&sign_bit) aux=ominus(aux,z);
if (z.h&sign_bit) aux=ominus(aux,y);
overflow=(aux.h!=aux.l || (aux.h^(aux.h>>1)^(acc.h&sign_bit)));
return acc;
}
 
@* Division. Long division of an unsigned 128-bit integer by an unsigned
64-bit integer is, of course, one of the most challenging routines
needed for \MMIX\ arithmetic. The following program, based on
Algorithm 4.3.1D of {\sl Seminumerical Algorithms}, computes
octabytes $q$ and $r$ such that $(2^{64}x+y)=qz+r$ and $0\le r<z$,
given octabytes $x$, $y$, and~$z$, assuming that $x<z$.
(If $x\ge z$, it simply sets $q=x$ and $r=y$.)
The quotient~$q$ is returned by the subroutine;
the remainder~$r$ is stored in |aux|.
@^multiprecision division@>
 
@<Subr...@>=
octa odiv @,@,@[ARGS((octa,octa,octa))@];@+@t}\6{@>
octa odiv(x,y,z)
octa x,y,z;
{
register int i,j,k,n,d;
tetra u[8],v[4],q[4],mask,qhat,rhat,vh,vmh;
register tetra t;
octa acc;
@<Check that |x<z|; otherwise give trivial answer@>;
@<Unpack the dividend and divisor to |u| and |v|@>;
@<Determine the number of significant places |n| in the divisor |v|@>;
@<Normalize the divisor@>;
for (j=3;j>=0;j--) @<Determine the quotient digit |q[j]|@>;
@<Unnormalize the remainder@>;
@<Pack |q| and |u| to |acc| and |aux|@>;
return acc;
}
 
@ @<Check that |x<z|; otherwise give trivial answer@>=
if (x.h>z.h || (x.h==z.h && x.l>=z.l)) {
aux=y;@+ return x;
}
 
@ @<Unpack the div...@>=
u[7]=x.h>>16, u[6]=x.h&0xffff, u[5]=x.l>>16, u[4]=x.l&0xffff;
u[3]=y.h>>16, u[2]=y.h&0xffff, u[1]=y.l>>16, u[0]=y.l&0xffff;
v[3]=z.h>>16, v[2]=z.h&0xffff, v[1]=z.l>>16, v[0]=z.l&0xffff;
 
@ @<Determine the number of significant places |n| in the divisor |v|@>=
for (n=4;v[n-1]==0;n--);
 
@ We shift |u| and |v| left by |d| places, where |d| is chosen to
make $2^{15}\le v_{n-1}<2^{16}$.
 
@<Normalize the divisor@>=
vh=v[n-1];
for (d=0;vh<0x8000;d++,vh<<=1);
for (j=k=0; j<n+4; j++) {
t=(u[j]<<d)+k;
u[j]=t&0xffff, k=t>>16;
}
for (j=k=0; j<n; j++) {
t=(v[j]<<d)+k;
v[j]=t&0xffff, k=t>>16;
}
vh=v[n-1];
vmh=(n>1? v[n-2]: 0);
 
@ @<Unnormalize the remainder@>=
mask=(1<<d)-1;
for (j=3; j>=n; j--) u[j]=0;
for (k=0;j>=0;j--) {
t=(k<<16)+u[j];
u[j]=t>>d, k=t&mask;
}
 
@ @<Pack |q| and |u| to |acc| and |aux|@>=
acc.h=(q[3]<<16)+q[2], acc.l=(q[1]<<16)+q[0];
aux.h=(u[3]<<16)+u[2], aux.l=(u[1]<<16)+u[0];
 
@ @<Determine the quotient digit |q[j]|@>=
{
@<Find the trial quotient, $\hat q$@>;
@<Subtract $b^j\hat q v$ from |u|@>;
@<If the result was negative, decrease $\hat q$ by 1@>;
q[j]=qhat;
}
 
@ @<Find the trial quotient, $\hat q$@>=
t=(u[j+n]<<16)+u[j+n-1];
qhat=t/vh, rhat=t-vh*qhat;
if (n>1) while (qhat==0x10000 || qhat*vmh>(rhat<<16)+u[j+n-2]) {
qhat--, rhat+=vh;
if (rhat>=0x10000) break;
}
 
@ After this step, |u[j+n]| will either equal |k| or |k-1|. The
true value of~|u| would be obtained by subtracting~|k| from |u[j+n]|;
but we don't have to fuss over |u[j+n]|, because it won't be examined later.
 
@<Subtract $b^j\hat q v$ from |u|@>=
for (i=k=0; i<n; i++) {
t=u[i+j]+0xffff0000-k-qhat*v[i];
u[i+j]=t&0xffff, k=0xffff-(t>>16);
}
 
@ The correction here occurs only rarely, but it can be necessary---for
example, when dividing the number \Hex{7fff800100000000} by \Hex{800080020005}.
 
@<If the result was negative, decrease $\hat q$ by 1@>=
if (u[j+n]!=k) {
qhat--;
for (i=k=0; i<n; i++) {
t=u[i+j]+v[i]+k;
u[i+j]=t&0xffff, k=t>>16;
}
}
 
@ Signed division can be reduced to unsigned division in a tedious
but straightforward manner. We assume that the divisor isn't zero.
 
@<Subr...@>=
octa signed_odiv @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa signed_odiv(y,z)
octa y,z;
{
octa yy,zz,q;
register int sy,sz;
if (y.h&sign_bit) sy=2, yy=ominus(zero_octa,y);
else sy=0, yy=y;
if (z.h&sign_bit) sz=1, zz=ominus(zero_octa,z);
else sz=0, zz=z;
q=odiv(zero_octa,yy,zz);
overflow=false;
switch (sy+sz) {
case 2+1: aux=ominus(zero_octa,aux);
if (q.h==sign_bit) overflow=true;
case 0+0: return q;
case 2+0:@+ if (aux.h || aux.l) aux=ominus(zz,aux);
goto negate_q;
case 0+1:@+ if (aux.h || aux.l) aux=ominus(aux,zz);
negate_q:@+ if (aux.h || aux.l) return ominus(neg_one,q);
else return ominus(zero_octa,q);
}
}
 
@* Bit fiddling. The bitwise operators of \MMIX\ are fairly easy to
implement directly, but three of them occur often enough to deserve
packaging as subroutines.
 
@<Subr...@>=
octa oand @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa oand(y,z) /* compute $y\land z$ */
octa y,z;
{@+ octa x;
x.h=y.h&z.h;@+ x.l=y.l&z.l;
return x;
}
@#
octa oandn @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa oandn(y,z) /* compute $y\land\bar z$ */
octa y,z;
{@+ octa x;
x.h=y.h&~z.h;@+ x.l=y.l&~z.l;
return x;
}
@#
octa oxor @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa oxor(y,z) /* compute $y\oplus z$ */
octa y,z;
{@+ octa x;
x.h=y.h^z.h;@+ x.l=y.l^z.l;
return x;
}
 
@ Here's a fun way to count the number of bits in a tetrabyte.
[This classical trick is called the ``Gillies--Miller method
for sideways addition'' in {\sl The Preparation of Programs
for an Electronic Digital Computer\/} by Wilkes, Wheeler, and
Gill, second edition (Reading, Mass.:\ Addison--Wesley, 1957),
191--193. Some of the tricks used here were suggested by
Balbir Singh, Peter Rossmanith, and Stefan Schwoon.]
@^Gillies, Donald Bruce@>
@^Miller, Jeffrey Charles Percy@>
@^Wilkes, Maurice Vincent@>
@^Wheeler, David John@>
@^Gill, Stanley@>
@^Singh, Balbir@>
@^Rossmanith, Peter@>
@^Schwoon, Stefan@>
 
@<Subr...@>=
int count_bits @,@,@[ARGS((tetra))@];@+@t}\6{@>
int count_bits(x)
tetra x;
{
register int xx=x;
xx=xx-((xx>>1)&0x55555555);
xx=(xx&0x33333333)+((xx>>2)&0x33333333);
xx=(xx+(xx>>4))&0x0f0f0f0f;
xx=xx+(xx>>8);
return (xx+(xx>>16)) & 0xff;
}
 
@ To compute the nonnegative byte differences of two given tetrabytes,
we can carry out the following 20-step branchless computation:
 
@<Subr...@>=
tetra byte_diff @,@,@[ARGS((tetra,tetra))@];@+@t}\6{@>
tetra byte_diff(y,z)
tetra y,z;
{
register tetra d=(y&0x00ff00ff)+0x01000100-(z&0x00ff00ff);
register tetra m=d&0x01000100;
register tetra x=d&(m-(m>>8));
d=((y>>8)&0x00ff00ff)+0x01000100-((z>>8)&0x00ff00ff);
m=d&0x01000100;
return x+((d&(m-(m>>8)))<<8);
}
 
@ To compute the nonnegative wyde differences of two tetrabytes,
another trick leads to a 15-step branchless computation.
(Research problem: Can |count_bits|, |byte_diff|, or |wyde_diff| be done
with fewer operations?)
 
@<Subr...@>=
tetra wyde_diff @,@,@[ARGS((tetra,tetra))@];@+@t}\6{@>
tetra wyde_diff(y,z)
tetra y,z;
{
register tetra a=((y>>16)-(z>>16))&0x10000;
register tetra b=((y&0xffff)-(z&0xffff))&0x10000;
return y-(z^((y^z)&(b-a-(b>>16))));
}
 
@ The last bitwise subroutine we need is the most interesting:
It implements \MMIX's \.{MOR} and \.{MXOR} operations.
 
@<Subr...@>=
octa bool_mult @,@,@[ARGS((octa,octa,bool))@];@+@t}\6{@>
octa bool_mult(y,z,xor)
octa y,z; /* the operands */
bool xor; /* do we do xor instead of or? */
{
octa o,x;
register tetra a,b,c;
register int k;
for (k=0,o=y,x=zero_octa;o.h||o.l;k++,o=shift_right(o,8,1))
if (o.l&0xff) {
a=((z.h>>k)&0x01010101)*0xff;
b=((z.l>>k)&0x01010101)*0xff;
c=(o.l&0xff)*0x01010101;
if (xor) x.h^=a&c, x.l^=b&c;
else x.h|=a&c, x.l|=b&c;
}
return x;
}
 
@* Floating point packing and unpacking. Standard IEEE floating binary
numbers pack a sign, exponent, and fraction into a tetrabyte
or octabyte. In this section we consider basic subroutines that
convert between IEEE format and the separate unpacked components.
 
@d ROUND_OFF 1
@d ROUND_UP 2
@d ROUND_DOWN 3
@d ROUND_NEAR 4
 
@<Glob...@>=
int cur_round; /* the current rounding mode */
 
@ The |fpack| routine takes an octabyte $f$, a raw exponent~$e$,
and a sign~|s|, and packs them
into the floating binary number that corresponds to
$\pm2^{e-1076}f$, using a given rounding mode.
The value of $f$ should satisfy $2^{54}\le f\le 2^{55}$.
 
Thus, for example, the floating binary number $+1.0=\Hex{3ff0000000000000}$
is obtained when $f=2^{54}$, $e=\Hex{3fe}$, and |s='+'|.
The raw exponent~$e$ is usually one less than
the final exponent value; the leading bit of~$f$ is essentially added
to the exponent. (This trick works nicely for subnormal numbers, when
$e<0$, or in cases where the value of $f$ is rounded upwards to $2^{55}$.)
 
Exceptional events are noted by oring appropriate bits into
the global variable |exceptions|. Special considerations apply to
underflow, which is not fully specified by Section 7.4 of the IEEE standard:
Implementations of the standard are free to choose between two definitions
of ``tininess'' and two definitions of ``accuracy loss.''
\MMIX\ determines tininess {\it after\/} rounding, hence a result with
$e<0$ is not necessarily tiny; \MMIX\ treats accuracy loss as equivalent
to inexactness. Thus, a result underflows if and only if
it is tiny and either (i)~it is inexact or (ii)~the underflow trap is enabled.
The |fpack| routine sets |U_BIT| in |exceptions| if and only if the result is
tiny, |X_BIT| if and only if the result is inexact.
@^underflow@>
 
@d X_BIT (1<<8) /* floating inexact */
@d Z_BIT (1<<9) /* floating division by zero */
@d U_BIT (1<<10) /* floating underflow */
@d O_BIT (1<<11) /* floating overflow */
@d I_BIT (1<<12) /* floating invalid operation */
@d W_BIT (1<<13) /* float-to-fix overflow */
@d V_BIT (1<<14) /* integer overflow */
@d D_BIT (1<<15) /* integer divide check */
@d E_BIT (1<<18) /* external (dynamic) trap bit */
 
@<Subr...@>=
octa fpack @,@,@[ARGS((octa,int,char,int))@];@+@t}\6{@>
octa fpack(f,e,s,r)
octa f; /* the normalized fraction part */
int e; /* the raw exponent */
char s; /* the sign */
int r; /* the rounding mode */
{
octa o;
if (e>0x7fd) e=0x7ff, o=zero_octa;
else {
if (e<0) {
if (e<-54) o.h=0, o.l=1;
else {@+octa oo;
o=shift_right(f,-e,1);
oo=shift_left(o,-e);
if (oo.l!=f.l || oo.h!=f.h) o.l |= 1; /* sticky bit */
@^sticky bit@>
}
e=0;
}@+else o=f;
}
@<Round and return the result@>;
}
 
@ @<Glob...@>=
int exceptions; /* bits possibly destined for rA */
 
@ Everything falls together so nicely here, it's almost too good to be true!
 
@<Round and return the result@>=
if (o.l&3) exceptions |= X_BIT;
switch (r) {
case ROUND_DOWN:@+ if (s=='-') o=incr(o,3);@+break;
case ROUND_UP:@+ if (s!='-') o=incr(o,3);
case ROUND_OFF: break;
case ROUND_NEAR: o=incr(o, o.l&4? 2: 1);@+break;
}
o = shift_right(o,2,1);
o.h += e<<20;
if (o.h>=0x7ff00000) exceptions |= O_BIT+X_BIT; /* overflow */
else if (o.h<0x100000) exceptions |= U_BIT; /* tininess */
if (s=='-') o.h |= sign_bit;
return o;
 
@ Similarly, |sfpack| packs a short float, from inputs
having the same conventions as |fpack|.
 
@<Subr...@>=
tetra sfpack @,@,@[ARGS((octa,int,char,int))@];@+@t}\6{@>
tetra sfpack(f,e,s,r)
octa f; /* the fraction part */
int e; /* the raw exponent */
char s; /* the sign */
int r; /* the rounding mode */
{
register tetra o;
if (e>0x47d) e=0x47f, o=0;
else {
o=shift_left(f,3).h;
if (f.l&0x1fffffff) o|=1;
if (e<0x380) {
if (e<0x380-25) o=1;
else {@+register tetra o0,oo;
o0 = o;
o = o>>(0x380-e);
oo = o<<(0x380-e);
if (oo!=o0) o |= 1; /* sticky bit */
@^sticky bit@>
}
e=0x380;
}
}
@<Round and return the short result@>;
}
 
@ @<Round and return the short result@>=
if (o&3) exceptions |= X_BIT;
switch (r) {
case ROUND_DOWN:@+ if (s=='-') o+=3;@+break;
case ROUND_UP:@+ if (s!='-') o+=3;
case ROUND_OFF: break;
case ROUND_NEAR: o+=(o&4? 2: 1);@+break;
}
o = o>>2;
o += (e-0x380)<<23;
if (o>=0x7f800000) exceptions |= O_BIT+X_BIT; /* overflow */
else if (o<0x100000) exceptions |= U_BIT; /* tininess */
if (s=='-') o |= sign_bit;
return o;
 
@ The |funpack| routine is, roughly speaking, the opposite of |fpack|.
It takes a given floating point number~$x$ and separates out its
fraction part~$f$, exponent~$e$, and sign~$s$. It clears |exceptions|
to zero. It returns the type of value found: |zro|, |num|, |inf|,
or |nan|. When it returns |num|,
it will have set $f$, $e$, and~$s$
to the values from which |fpack| would produce the original number~$x$
without exceptions.
 
@d zero_exponent (-1000) /* zero is assumed to have this exponent */
 
@<Other type...@>=
typedef enum {@!zro,@!num,@!inf,@!nan}@+ftype;
@ @<Subr...@>=
ftype funpack @,@,@[ARGS((octa,octa*,int*,char*))@];@+@t}\6{@>
ftype funpack(x,f,e,s)
octa x; /* the given floating point value */
octa *f; /* address where the fraction part should be stored */
int *e; /* address where the exponent part should be stored */
char *s; /* address where the sign should be stored */
{
register int ee;
exceptions=0;
*s=(x.h&sign_bit? '-': '+');
*f=shift_left(x,2);
f->h &= 0x3fffff;
ee=(x.h>>20)&0x7ff;
if (ee) {
*e=ee-1;
f->h |= 0x400000;
return (ee<0x7ff? num: f->h==0x400000 && !f->l? inf: nan);
}
if (!x.l && !f->h) {
*e=zero_exponent;@+ return zro;
}
do {@+ ee--;@+ *f=shift_left(*f,1);@+} while (!(f->h&0x400000));
*e=ee;@+ return num;
}
 
@ @<Subr...@>=
ftype sfunpack @,@,@[ARGS((tetra,octa*,int*,char*))@];@+@t}\6{@>
ftype sfunpack(x,f,e,s)
tetra x; /* the given floating point value */
octa *f; /* address where the fraction part should be stored */
int *e; /* address where the exponent part should be stored */
char *s; /* address where the sign should be stored */
{
register int ee;
exceptions=0;
*s=(x&sign_bit? '-': '+');
f->h=(x>>1)&0x3fffff, f->l=x<<31;
ee=(x>>23)&0xff;
if (ee) {
*e=ee+0x380-1;
f->h |= 0x400000;
return (ee<0xff? num: (x&0x7fffffff)==0x7f800000? inf: nan);
}
if (!(x&0x7fffffff)) {
*e=zero_exponent;@+return zro;
}
do {@+ ee--;@+ *f=shift_left(*f,1);@+} while (!(f->h&0x400000));
*e=ee+0x380;@+ return num;
}
 
@ Since \MMIX\ downplays 32-bit operations, it uses |sfpack| and |sfunpack|
only when loading and storing short floats, or when converting
from fixed point to floating point.
 
@<Subr...@>=
octa load_sf @,@,@[ARGS((tetra))@];@+@t}\6{@>
octa load_sf(z)
tetra z; /* 32 bits to be loaded into a 64-bit register */
{
octa f,x;@+int e;@+char s;@+ftype t;
t=sfunpack(z,&f,&e,&s);
switch (t) {
case zro: x=zero_octa;@+break;
case num: return fpack(f,e,s,ROUND_OFF);
case inf: x=inf_octa;@+break;
case nan: x=shift_right(f,2,1);@+x.h|=0x7ff00000;@+break;
}
if (s=='-') x.h|=sign_bit;
return x;
}
 
@ @<Subr...@>=
tetra store_sf @,@,@[ARGS((octa))@];@+@t}\6{@>
tetra store_sf(x)
octa x; /* 64 bits to be loaded into a 32-bit word */
{
octa f;@+tetra z;@+int e;@+char s;@+ftype t;
t=funpack(x,&f,&e,&s);
switch (t) {
case zro: z=0;@+break;
case num: return sfpack(f,e,s,cur_round);
case inf: z=0x7f800000;@+break;
case nan:@+ if (!(f.h&0x200000)) {
f.h|=0x200000;@+exceptions|=I_BIT; /* NaN was signaling */
}
z=0x7f800000|(f.h<<1)|(f.l>>31);@+break;
}
if (s=='-') z|=sign_bit;
return z;
}
 
@* Floating multiplication and division.
The hardest fixed point operations were multiplication and division;
but these two operations are the {\it easiest\/} to implement in floating point
arithmetic, once their fixed point counterparts are available.
 
@<Subr...@>=
octa fmult @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa fmult(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa x,xf,yf,zf;
register int xe;
register char xs;
yt=funpack(y,&yf,&ye,&ys);
zt=funpack(z,&zf,&ze,&zs);
xs=ys+zs-'+'; /* will be |'-'| when the result is negative */
switch (4*yt+zt) {
@t\4@>@<The usual NaN cases@>;
case 4*zro+zro: case 4*zro+num: case 4*num+zro: x=zero_octa;@+break;
case 4*num+inf: case 4*inf+num: case 4*inf+inf: x=inf_octa;@+break;
case 4*zro+inf: case 4*inf+zro: x=standard_NaN;
exceptions|=I_BIT;@+break;
case 4*num+num: @<Multiply nonzero numbers and |return|@>;
}
if (xs=='-') x.h|=sign_bit;
return x;
}
 
@ @<The usual NaN cases@>=
case 4*nan+nan:@+if (!(y.h&0x80000)) exceptions|=I_BIT; /* |y| is signaling */
case 4*zro+nan: case 4*num+nan: case 4*inf+nan:
if (!(z.h&0x80000)) exceptions|=I_BIT, z.h|=0x80000;
return z;
case 4*nan+zro: case 4*nan+num: case 4*nan+inf:
if (!(y.h&0x80000)) exceptions|=I_BIT, y.h|=0x80000;
return y;
 
@ @<Multiply nonzero numbers and |return|@>=
xe=ye+ze-0x3fd; /* the raw exponent */
x=omult(yf,shift_left(zf,9));
if (aux.h>=0x400000) xf=aux;
else xf=shift_left(aux,1), xe--;
if (x.h||x.l) xf.l|=1; /* adjust the sticky bit */
return fpack(xf,xe,xs,cur_round);
 
@ @<Subr...@>=
octa fdivide @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa fdivide(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa x,xf,yf,zf;
register int xe;
register char xs;
yt=funpack(y,&yf,&ye,&ys);
zt=funpack(z,&zf,&ze,&zs);
xs=ys+zs-'+'; /* will be |'-'| when the result is negative */
switch (4*yt+zt) {
@t\4@>@<The usual NaN cases@>;
case 4*zro+inf: case 4*zro+num: case 4*num+inf: x=zero_octa;@+break;
case 4*num+zro: exceptions|=Z_BIT;
case 4*inf+num: case 4*inf+zro: x=inf_octa;@+break;
case 4*zro+zro: case 4*inf+inf: x=standard_NaN;
exceptions|=I_BIT;@+break;
case 4*num+num: @<Divide nonzero numbers and |return|@>;
}
if (xs=='-') x.h|=sign_bit;
return x;
}
 
@ @<Divide nonzero numbers...@>=
xe=ye-ze+0x3fd; /* the raw exponent */
xf=odiv(yf,zero_octa,shift_left(zf,9));
if (xf.h>=0x800000) {
aux.l|=xf.l&1;
xf=shift_right(xf,1,1);
xe++;
}
if (aux.h||aux.l) xf.l|=1; /* adjust the sticky bit */
return fpack(xf,xe,xs,cur_round);
 
@*Floating addition and subtraction. Now for the bread-and-butter
operation, the sum of two floating point numbers.
It is not terribly difficult, but many cases need to be handled carefully.
 
@<Subr...@>=
octa fplus @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
octa fplus(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa x,xf,yf,zf;
register int xe,d;
register char xs;
yt=funpack(y,&yf,&ye,&ys);
zt=funpack(z,&zf,&ze,&zs);
switch (4*yt+zt) {
@t\4@>@<The usual NaN cases@>;
case 4*zro+num: return fpack(zf,ze,zs,ROUND_OFF);@+break; /* may underflow */
case 4*num+zro: return fpack(yf,ye,ys,ROUND_OFF);@+break; /* may underflow */
case 4*inf+inf:@+if (ys!=zs) {
exceptions|=I_BIT;@+x=standard_NaN;@+xs=zs;@+break;
}
case 4*num+inf: case 4*zro+inf: x=inf_octa;@+xs=zs;@+break;
case 4*inf+num: case 4*inf+zro: x=inf_octa;@+xs=ys;@+break;
case 4*num+num:@+ if (y.h!=(z.h^0x80000000) || y.l!=z.l)
@<Add nonzero numbers and |return|@>;
case 4*zro+zro: x=zero_octa;
xs=(ys==zs? ys: cur_round==ROUND_DOWN? '-': '+');@+break;
}
if (xs=='-') x.h|=sign_bit;
return x;
}
 
@ @<Add nonzero numbers...@>=
{@+octa o,oo;
if (ye<ze || (ye==ze && (yf.h<zf.h || (yf.h==zf.h && yf.l<zf.l))))
@<Exchange |y| with |z|@>;
d=ye-ze;
xs=ys, xe=ye;
if (d) @<Adjust for difference in exponents@>;
if (ys==zs) {
xf=oplus(yf,zf);
if (xf.h>=0x800000) xe++, d=xf.l&1, xf=shift_right(xf,1,1), xf.l|=d;
}@+else {
xf=ominus(yf,zf);
if (xf.h>=0x800000) xe++, d=xf.l&1, xf=shift_right(xf,1,1), xf.l|=d;
else@+ while (xf.h<0x400000) xe--, xf=shift_left(xf,1);
}
return fpack(xf,xe,xs,cur_round);
}
 
@ @<Exchange |y| with |z|@>=
{
o=yf, yf=zf, zf=o;
d=ye, ye=ze, ze=d;
d=ys, ys=zs, zs=d;
}
 
@ Proper rounding requires two bits to the right of the fraction delivered
to~|fpack|. The first is the true next bit of the result;
the other is a ``sticky'' bit, which is nonzero if any further bits of the
true result are nonzero. Sticky rounding to an integer takes
$x$ into the number $\lfloor x/2\rfloor+\lceil x/2\rceil$.
@^sticky bit@>
 
Some subtleties need to be observed here, in order to
prevent the sticky bit from being shifted left. If we did not
shift |yf| left~1 before shifting |zf| to the right, an incorrect
answer would be obtained in certain cases---for example, if
$|yf|=2^{54}$, $|zf|=2^{54}+2^{53}-1$, $d=52$.
 
@<Adjust for difference in exponents@>=
{
if (d<=2) zf=shift_right(zf,d,1); /* exact result */
else if (d>53) zf.h=0, zf.l=1; /* tricky but OK */
else {
if (ys!=zs) d--,xe--,yf=shift_left(yf,1);
o=zf;
zf=shift_right(o,d,1);
oo=shift_left(zf,d);
if (oo.l!=o.l || oo.h!=o.h) zf.l|=1;
}
}
 
@ The comparison of floating point numbers with respect to $\epsilon$
shares some of the characteristics of floating point addition/subtraction.
In some ways it is simpler, and in other ways it is more difficult;
we might as well deal with it now. % anyways
 
Subroutine |fepscomp(y,z,e,s)| returns 2 if |y|, |z|, or |e| is a NaN
or |e| is negative. It returns 1 if |s=0| and $y\approx z\ (e)$ or if
|s!=0| and $y\sim z\ (e)$,
as defined in Section~4.2.2 of {\sl Seminumerical Algorithms\/};
otherwise it returns~0.
 
@<Subr...@>=
int fepscomp @,@,@[ARGS((octa,octa,octa,int))@];@+@t}\6{@>
int fepscomp(y,z,e,s)
octa y,z,e; /* the operands */
int s; /* test similarity? */
{
octa yf,zf,ef,o,oo;
int ye,ze,ee;
char ys,zs,es;
register int yt,zt,et,d;
et=funpack(e,&ef,&ee,&es);
if (es=='-') return 2;
switch (et) {
case nan: return 2;
case inf: ee=10000;
case num: case zro: break;
}
yt=funpack(y,&yf,&ye,&ys);
zt=funpack(z,&zf,&ze,&zs);
switch (4*yt+zt) {
case 4*nan+nan: case 4*nan+inf: case 4*nan+num: case 4*nan+zro:
case 4*inf+nan: case 4*num+nan: case 4*zro+nan: return 2;
case 4*inf+inf: return (ys==zs || ee>=1023);
case 4*inf+num: case 4*inf+zro: case 4*num+inf: case 4*zro+inf:
return (s && ee>=1022);
case 4*zro+zro: return 1;
case 4*zro+num: case 4*num+zro:@+ if (!s) return 0;
case 4*num+num: break;
}
@<Compare two numbers with respect to epsilon and |return|@>;
}
 
@ The relation $y\approx z\ (\epsilon)$ reduces to
$y\sim z\ (\epsilon/2^d)$, if $d$~is the difference between the
larger and smaller exponents of $y$ and~$z$.
 
@<Compare two numbers with respect to epsilon and |return|@>=
@<Unsubnormalize |y| and |z|, if they are subnormal@>;
if (ye<ze || (ye==ze && (yf.h<zf.h || (yf.h==zf.h && yf.l<zf.l))))
@<Exchange |y| with |z|@>;
if (ze==zero_exponent) ze=ye;
d=ye-ze;
if (!s) ee-=d;
if (ee>=1023) return 1; /* if $\epsilon\ge2$, $z\in N_\epsilon(y)$ */
@<Compute the difference of fraction parts, |o|@>;
if (!o.h && !o.l) return 1;
if (ee<968) return 0; /* if $y\ne z$ and $\epsilon<2^{-54}$, $y\not\sim z$ */
if (ee>=1021) ef=shift_left(ef,ee-1021);
else ef=shift_right(ef,1021-ee,1);
return o.h<ef.h || (o.h==ef.h && o.l<=ef.l);
 
@ @<Unsubnormalize |y| and |z|, if they are subnormal@>=
if (ye<0 && yt!=zro) yf=shift_left(y,2), ye=0;
if (ze<0 && zt!=zro) zf=shift_left(z,2), ze=0;
 
@ At this point $y\sim z$ if and only if
$$|yf|+(-1)^{[ys=zs]}|zf|/2^d\le 2^{ee-1021}|ef|=2^{55}\epsilon.$$
We need to evaluate this relation without overstepping the bounds of
our simulated 64-bit registers.
 
When $d>2$, the difference of fraction parts might not fit exactly
in an octabyte;
in that case the numbers are not similar unless $\epsilon>3/8$,
and we replace the difference by the ceiling of the
true result. When $\epsilon<1/8$, our program essentially replaces
$2^{55}\epsilon$ by $\lfloor2^{55}\epsilon\rfloor$. These
truncations are not needed simultaneously. Therefore the logic
is justified by the facts that, if $n$ is an integer, we have
$x\le n$ if and only if $\lceil x\rceil\le n$;
$n\le x$ if and only if $n\le\lfloor x\rfloor$. (Notice that the
concept of ``sticky bit'' is {\it not\/} appropriate here.)
@^sticky bit@>
 
@<Compute the difference of fraction parts, |o|@>=
if (d>54) o=zero_octa,oo=zf;
else o=shift_right(zf,d,1),oo=shift_left(o,d);
if (oo.h!=zf.h || oo.l!=zf.l) { /* truncated result, hence $d>2$ */
if (ee<1020) return 0; /* difference is too large for similarity */
o=incr(o,ys==zs? 0: 1); /* adjust for ceiling */
}
o=(ys==zs? ominus(yf,o): oplus(yf,o));
 
@*Floating point output conversion.
The |print_float| routine converts an octabyte to a floating decimal
representation that will be input as precisely the same value.
@^binary-to-decimal conversion@>
@^radix conversion@>
@^multiprecision conversion@>
 
@<Subr...@>=
static void bignum_times_ten @,@,@[ARGS((bignum*))@];
static void bignum_dec @,@,@[ARGS((bignum*,bignum*,tetra))@];
static int bignum_compare @,@,@[ARGS((bignum*,bignum*))@];
void print_float @,@,@[ARGS((octa))@];@+@t}\6{@>
void print_float(x)
octa x;
{
@<Local variables for |print_float|@>;
if (x.h&sign_bit) printf("-");
@<Extract the exponent |e| and determine the
fraction interval $[f\dts g]$ or $(f\dts g)$@>;
@<Store $f$ and $g$ as multiprecise integers@>;
@<Compute the significant digits |s| and decimal exponent |e|@>;
@<Print the significant digits with proper context@>;
}
 
@ One way to visualize the problem being solved here is to consider
the vastly simpler case in which there are only 2-bit exponents
and 2-bit fractions. Then the sixteen possible 4-bit combinations
have the following interpretations:
$$\def\\{\;\dts\;}
\vbox{\halign{#\qquad&$#$\hfil\cr
0000&[0\\0.125]\cr
0001&(0.125\\0.375)\cr
0010&[0.375\\0.625]\cr
0011&(0.625\\0.875)\cr
0100&[0.875\\1.125]\cr
0101&(1.125\\1.375)\cr
0110&[1.375\\1.625]\cr
0111&(1.625\\1.875)\cr
1000&[1.875\\2.25]\cr
1001&(2.25\\2.75)\cr
1010&[2.75\\3.25]\cr
1011&(3.25\\3.75)\cr
1100&[3.75\\\infty]\cr
1101&\rm NaN(0\\0.375)\cr
1110&\rm NaN[0.375\\0.625]\cr
1111&\rm NaN(0.625\\1)\cr}}$$
Notice that the interval is closed, $[f\dts g]$, when the fraction part
is even; it is open, $(f\dts g)$, when the fraction part is odd.
The printed outputs for these sixteen values, if we actually were
dealing with such short exponents and fractions, would be
\.{0.}, \.{.2}, \.{.5}, \.{.7}, \.{1.}, \.{1.2}, \.{1.5}, \.{1.7},
\.{2.}, \.{2.5}, \.{3.}, \.{3.5}, \.{Inf}, \.{NaN.2}, \.{NaN}, \.{NaN.8},
respectively.
 
@<Extract the exponent |e|...@>=
f=shift_left(x,1);
e=f.h>>21;
f.h&=0x1fffff;
if (!f.h && !f.l) @<Handle the special case when the fraction part is zero@>@;
else {
g=incr(f,1);
f=incr(f,-1);
if (!e) e=1; /* subnormal */
else if (e==0x7ff) {
printf("NaN");
if (g.h==0x100000 && g.l==1) return; /* the ``standard'' NaN */
e=0x3ff; /* extreme NaNs come out OK even without adjusting |f| or |g| */
}@+else f.h|=0x200000, g.h|=0x200000;
}
 
@ @<Local variables for |print_float|@>=
octa f,g; /* lower and upper bounds on the fraction part */
register int e; /* exponent part */
register int j,k; /* all purpose indices */
 
@ The transition points between exponents correspond to powers of~2. At
such points the interval extends only half as far to the left of that
power of~2 as it does to the right. For example, in the 4-bit minifloat numbers
considered above, case 1000 corresponds to the interval $[1.875\;\dts\;2.25]$.
 
@<Handle the special case when the fraction part is zero@>=
{
if (!e) {
printf("0.");@+return;
}
if (e==0x7ff) {
printf("Inf");@+return;
}
e--;
f.h=0x3fffff, f.l=0xffffffff;
g.h=0x400000, g.l=2;
}
 
@ We want to find the ``simplest'' value in the interval corresponding
to the given number, in the sense that it has fewest significant
digits when expressed in decimal notation. Thus, for example,
if the floating point number can be described by a relatively
short string such as `\.{.1}' or `\.{37e100}', we want to discover that
representation.
 
The basic idea is to generate the decimal representations of the
two endpoints of the interval, outputting the leading digits where
both endpoints agree, then making a final decision at the first place where
they disagree.
 
The ``simplest'' value is not always unique. For example, in the
case of 4-bit minifloat numbers we could represent the bit pattern 0001 as
either \.{.2} or \.{.3}, and we could represent 1001 in five equally short
ways: \.{2.3} or \.{2.4} or \.{2.5} or \.{2.6} or \.{2.7}. The
algorithm below tries to choose the middle possibility in such cases.
 
[A solution to the analogous problem for fixed-point representations,
without the additional complication of round-to-even, was used by
the author in the program for \TeX; see {\sl Beauty is Our Business\/}
(Springer, 1990), 233--242.]
@^Knuth, Donald Ervin@>
 
Suppose we are given two fractions $f$ and $g$, where $0\le f<g<1$, and
we want to compute the shortest decimal in the closed interval $[f\dts g]$.
If $f=0$, we are done. Otherwise let $10f=d+f'$ and $10g=e+g'$, where
$0\le f'<1$ and $0\le g'<1$. If $d<e$, we can terminate by outputting
any of the digits $d+1$, \dots,~$e$; otherwise we output the
common digit $d=e$, and repeat the process on the fractions $0\le f'<g'<1$.
A similar procedure works with respect to the open interval $(f\dts g)$.
 
@ The program below carries out the stated algorithm by using multiprecision
arithmetic on 77-place integers with 28 bits each. This choice
facilitates multiplication by~10, and allows us to deal with the whole range of
floating binary numbers using fixed point arithmetic. We keep track of
the leading and trailing digit positions so that trivial operations on
zeros are avoided.
 
If |f| points to a \&{bignum}, its radix-$2^{28}$ digits are
|f->dat[0]| through |f->dat[76]|, from most significant to least significant.
We assume that all digit positions are zero unless they lie in the
subarray between indices |f->a| and |f->b|, inclusive.
Furthermore, both |f->dat[f->a]| and |f->dat[f->b]| are nonzero,
unless |f->a=f->b=bignum_prec-1|.
 
The \&{bignum} data type can be used with any radix less than
$2^{32}$; we will use it later with radix~$10^9$. The |dat| array
is made large enough to accommodate both applications.
 
@d bignum_prec 157 /* would be 77 if we cared only about |print_float| */
 
@<Other type...@>=
typedef struct {
int a; /* index of the most significant digit */
int b; /* index of the least significant digit; must be $\ge a$ */
tetra dat[bignum_prec]; /* the digits; undefined except between |a| and |b| */
} bignum;
 
@ Here, for example, is how we go from $f$ to $10f$, assuming that
overflow will not occur and that the radix is $2^{28}$:
 
@<Subr...@>=
static void bignum_times_ten(f)
bignum *f;
{
register tetra *p,*q; register tetra x,carry;
for (p=&f->dat[f->b],q=&f->dat[f->a],carry=0; p>=q; p--) {
x=*p*10+carry;
*p=x&0xfffffff;
carry=x>>28;
}
*p=carry;
if (carry) f->a--;
if (f->dat[f->b]==0 && f->b>f->a) f->b--;
}
 
@ And here is how we test whether $f<g$, $f=g$, or $f>g$, using any
radix whatever:
 
@<Subr...@>=
static int bignum_compare(f,g)
bignum *f,*g;
{
register tetra *p,*pp,*q,*qq;
if (f->a!=g->a) return f->a > g->a? -1: 1;
pp=&f->dat[f->b], qq=&g->dat[g->b];
for (p=&f->dat[f->a],q=&g->dat[g->a]; p<=pp; p++,q++) {
if (*p!=*q) return *p<*q? -1: 1;
if (q==qq) return p<pp;
}
return -1;
}
 
@ The following subroutine subtracts $g$ from~$f$, assuming that
$f\ge g>0$ and using a given radix.
 
@<Subr...@>=
static void bignum_dec(f,g,r)
bignum *f,*g;
tetra r; /* the radix */
{
register tetra *p,*q,*qq;
register int x,borrow;
while (g->b>f->b) f->dat[++f->b]=0;
qq=&g->dat[g->a];
for (p=&f->dat[g->b],q=&g->dat[g->b],borrow=0;q>=qq;p--,q--) {
x=*p - *q - borrow;
if (x>=0) borrow=0, *p=x;
else borrow=1, *p=x+r;
}
for (;borrow;p--)
if (*p) borrow=0, *p=*p-1;
else *p=r-1;
while (f->dat[f->a]==0) {
if (f->a==f->b) { /* the result is zero */
f->a=f->b=bignum_prec-1, f->dat[bignum_prec-1]=0;
return;
}
f->a++;
}
while (f->dat[f->b]==0) f->b--;
}
 
@ Armed with these subroutines, we are ready to solve the problem.
The first task is to put the numbers into \&{bignum} form.
If the exponent is |e|, the number destined for digit |dat[k]| will
consist of the rightmost 28 bits of the given fraction after it has
been shifted right $c-e-28k$ bits, for some constant~$c$.
We choose $c$ so that,
when $e$ has its maximum value \Hex{7ff}, the leading digit will
go into position |dat[1]|, and so that when the number to be printed
is exactly~1 the integer part of~$g$ will also be exactly~1.
 
@d magic_offset 2112 /* the constant $c$ that makes it work */
@d origin 37 /* the radix point follows |dat[37]| */
 
@<Store $f$ and $g$ as multiprecise integers@>=
k=(magic_offset-e)/28;
ff.dat[k-1]=shift_right(f,magic_offset+28-e-28*k,1).l&0xfffffff;
gg.dat[k-1]=shift_right(g,magic_offset+28-e-28*k,1).l&0xfffffff;
ff.dat[k]=shift_right(f,magic_offset-e-28*k,1).l&0xfffffff;
gg.dat[k]=shift_right(g,magic_offset-e-28*k,1).l&0xfffffff;
ff.dat[k+1]=shift_left(f,e+28*k-(magic_offset-28)).l&0xfffffff;
gg.dat[k+1]=shift_left(g,e+28*k-(magic_offset-28)).l&0xfffffff;
ff.a=(ff.dat[k-1]? k-1: k);
ff.b=(ff.dat[k+1]? k+1: k);
gg.a=(gg.dat[k-1]? k-1: k);
gg.b=(gg.dat[k+1]? k+1: k);
 
@ If $e$ is sufficiently small, the fractions $f$ and $g$ will be less than~1,
and we can use the stated algorithm directly. Of course, if $e$ is
extremely small, a lot of leading zeros need to be lopped off; in the
worst case, we may have to multiply $f$ and~$g$ by~10 more than 300 times.
But hey, we don't need to do that extremely often, and computers are
pretty fast nowadays.
 
In the small-exponent case, the computation always terminates before
$f$ becomes zero, because the interval endpoints are fractions with
denominator $2^t$ for some $t>50$.
 
The invariant relations |ff.dat[ff.a]!=0| and |gg.dat[gg.a]!=0| are
not maintained by the computation here, when |ff.a=origin| or |gg.a=origin|.
But no harm is done, because |bignum_compare| is not used.
 
@<Compute the significant digits |s|...@>=
if (e>0x401) @<Compute the significant digits in the large-exponent case@>@;
else@+{ /* if |e<=0x401| we have |gg.a>=origin| and |gg.dat[origin]<=8| */
if (ff.a>origin) ff.dat[origin]=0;
for (e=1, p=s; gg.a>origin || ff.dat[origin]==gg.dat[origin]; ) {
if (gg.a>origin) e--;
else *p++=ff.dat[origin]+'0', ff.dat[origin]=0, gg.dat[origin]=0;
bignum_times_ten(&ff);
bignum_times_ten(&gg);
}
*p++=((ff.dat[origin]+1+gg.dat[origin])>>1)+'0'; /* the middle digit */
}
*p='\0'; /* terminate the string |s| */
 
@ When |e| is large, we use the stated algorithm by considering $f$ and
$g$ to be fractions whose denominator is a power of~10.
 
An interesting case arises when the number to be converted is
\Hex{44ada56a4b0835bf}, since the interval turns out to be
$$ (69999999999999991611392\ \ \dts\ \ 70000000000000000000000).$$
If this were a closed interval, we could simply give the answer
\.{7e22}; but the number \.{7e22} actually corresponds to
\Hex{44ada56a4b0835c0}
because of the round-to-even rule. Therefore the correct answer is, say,
\.{6.9999999999999995e22}. This example shows that we need a slightly
different strategy in the case of open intervals; we cannot simply
look at the first position in which the endpoints have different
decimal digits. Therefore we change the invariant relation to $0\le f<g\le 1$,
when open intervals are involved,
and we do not terminate the process when $f=0$ or $g=1$.
 
@<Compute the significant digits in the large-exponent case@>=
{@+register int open=x.l&1;
tt.dat[origin]=10;
tt.a=tt.b=origin;
for (e=1;bignum_compare(&gg,&tt)>=open;e++)
bignum_times_ten(&tt);
p=s;
while (1) {
bignum_times_ten(&ff);
bignum_times_ten(&gg);
for (j='0';bignum_compare(&ff,&tt)>=0;j++)
bignum_dec(&ff,&tt,0x10000000),bignum_dec(&gg,&tt,0x10000000);
if (bignum_compare(&gg,&tt)>=open) break;
*p++=j;
if (ff.a==bignum_prec-1 && !open)
goto done; /* $f=0$ in a closed interval */
}
for (k=j;bignum_compare(&gg,&tt)>=open;k++) bignum_dec(&gg,&tt,0x10000000);
*p++=(j+1+k)>>1; /* the middle digit */
done:;
}
 
@ The length of string~|s| will be at most 17. For if $f$ and $g$
agree to 17 places, we have $g/f<1+10^{-16}$; but the
ratio $g/f$ is always $\ge(1+2^{-52}+2^{-53})/(1+2^{-52}-2^{-53})
>1+2\times10^{-16}$.
 
@<Local variables for |print_float|@>=
bignum ff,gg; /* fractions or numerators of fractions */
bignum tt; /* power of ten (used as the denominator) */
char s[18];
register char *p;
 
@ At this point the significant digits are in string |s|, and |s[0]!='0'|.
If we put a decimal point at the left of~|s|, the result should
be multiplied by $10^e$.
 
We prefer the output `\.{300.}' to the form `\.{3e2}', and we prefer
`\.{.03}' to `\.{3e-2}'. In general, the output will use an
explicit exponent only if the alternative would take more than
18~characters.
 
@<Print the significant digits with proper context@>=
if (e>17 || e<(int)strlen(s)-17)
printf("%c%s%se%d",s[0],(s[1]? ".": ""),s+1,e-1);
else if (e<0) printf(".%0*d%s",-e,0,s);
else if (strlen(s)>=e) printf("%.*s.%s",e,s,s+e);
else printf("%s%0*d.",s,e-(int)strlen(s),0);
 
@*Floating point input conversion. Going the other way, we want to
be able to convert a given decimal number into its floating binary
@^decimal-to-binary conversion@>
@^radix conversion@>
@^multiprecision conversion@>
equivalent. The following syntax is supported:
$$\vbox{\halign{$#$\hfil\cr
\<digit>\is\.0\mid\.1\mid\.2\mid\.3\mid\.4\mid
\.5\mid\.6\mid\.7\mid\.8\mid\.9\cr
\<digit string>\is\<digit>\mid\<digit string>\<digit>\cr
\<decimal string>\is\<digit string>\..\mid\..\<digit string>\mid
\<digit string>\..\<digit string>\cr
\<optional sign>\is\<empty>\mid\.+\mid\.-\cr
\<exponent>\is\.e\<optional sign>\<digit string>\cr
\<optional exponent>\is\<empty>\mid\<exponent>\cr
\<floating magnitude>\is\<digit string>\<exponent>\mid
\<decimal string>\<optional exponent>\mid\cr
\hskip12em \.{Inf}\mid\.{NaN}\mid\.{NaN.}\<digit string>\cr
\<floating constant>\is\<optional sign>\<floating magnitude>\cr
\<decimal constant>\is\<optional sign>\<digit string>\cr
}}$$
For example, `\.{-3.}' is the floating constant \Hex{c008000000000000}\thinspace;
`\.{1e3}' and `\.{1000}' are both equivalent to \Hex{408f400000000000}\thinspace;
`\.{NaN}' and `\.{+NaN.5}' are both equivalent to \Hex{7ff8000000000000}.
 
The |scan_const| routine looks at a given string and finds the
longest initial substring that matches the syntax of either \<decimal
constant> or \<floating constant>. It puts the corresponding value
into the global octabyte variable~|val|; it also puts the position of the first
unscanned character in the global pointer variable |next_char|.
It returns 1 if a floating constant was found, 0~if a decimal constant
was found, $-1$ if nothing was found. A decimal constant that doesn't
fit in an octabyte is computed modulo~$2^{64}$.
@^syntax of floating point constants@>
 
The value of |exceptions| set by |scan_const| is not necessarily correct.
 
@<Subr...@>=
static void bignum_double @,@,@[ARGS((bignum*))@];
int scan_const @,@,@[ARGS((char*))@];@+@t}\6{@>
int scan_const(s)
char *s;
{
@<Local variables for |scan_const|@>;
val.h=val.l=0;
p=s;
if (*p=='+' || *p=='-') sign=*p++;@+else sign='+';
if (strncmp(p,"NaN",3)==0) NaN=true, p+=3;
else NaN=false;
if ((isdigit(*p)&&!NaN) || (*p=='.' && isdigit(*(p+1))))
@<Scan a number and |return|@>;
if (NaN) @<Return the standard NaN@>;
if (strncmp(p,"Inf",3)==0) @<Return infinity@>;
no_const_found: next_char=s;@+return -1;
}
 
@ @<Glob...@>=
octa val; /* value returned by |scan_const| */
char *next_char; /* pointer returned by |scan_const| */
 
@ @<Local variables for |scan_const|@>=
register char *p,*q; /* for string manipulations */
register bool NaN; /* are we processing a NaN? */
int sign; /* |'+'| or |'-'| */
 
@ @<Return the standard NaN@>=
{
next_char=p;
val.h=0x600000, exp=0x3fe;
goto packit;
}
 
@ @<Return infinity@>=
{
next_char=p+3;
goto make_it_infinite;
}
 
@ We saw above that a string of at most 17 digits is enough to characterize
a floating point number, for purposes of output. But a much longer buffer
for digits is needed when we're doing input. For example, consider the
borderline quantity $(1+2^{-53})/2^{1022}$; its decimal expansion, when
written out exactly, is a number with more than 750 significant digits:
\.{2.2250738585...8125e-308}.
If {\it any one\/} of those digits is increased, or if
additional nonzero digits are added as in
\.{2.2250738585...81250000001e-308},
the rounded value is supposed to change from \Hex{0010000000000000}
to \Hex{0010000000000001}.
 
We assume here that the user prefers a perfectly correct answer to
a speedy almost-correct one, so we implement the most general case.
 
@<Scan a number...@>=
{
for (q=buf0,dec_pt=(char*)0;isdigit(*p);p++) {
val=oplus(val,shift_left(val,2)); /* multiply by 5 */
val=incr(shift_left(val,1),*p-'0');
if (q>buf0 || *p!='0')
if (q<buf_max) *q++=*p;
else if (*(q-1)=='0') *(q-1)=*p;
}
if (NaN) *q++='1';
if (*p=='.') @<Scan a fraction part@>;
next_char=p;
if (*p=='e' && !NaN) @<Scan an exponent@>@;
else exp=0;
if (dec_pt) @<Return a floating point constant@>;
if (sign=='-') val=ominus(zero_octa,val);
return 0;
}
 
@ @<Scan a fraction part@>=
{
dec_pt=q;
p++;
for (zeros=0;isdigit(*p);p++)
if (*p=='0' && q==buf0) zeros++;
else if (q<buf_max) *q++=*p;
else if (*(q-1)=='0') *(q-1)=*p;
}
 
@ The buffer needs room for eight digits of padding at the left, followed
by up to $1022+53-307$ significant digits, followed by a ``sticky'' digit
at position |buf_max-1|, and eight more digits of padding.
 
@d buf0 (buf+8)
@d buf_max (buf+777)
 
@<Glob...@>=
static char buf[785]="00000000"; /* where we put significant input digits */
 
@ @<Local variables for |scan_const|@>=
register char* dec_pt; /* position of decimal point in |buf| */
register int exp; /* scanned exponent; later used for raw binary exponent */
register int zeros; /* leading zeros removed after decimal point */
 
@ Here we don't advance |next_char| and force a decimal point until we
know that a syntactically correct exponent exists.
 
The code here will convert extra-large inputs like
`\.{9e+9999999999999999}' into $\infty$ and extra-small inputs into zero.
Strange inputs like `\.{-00.0e9999999}' must also be accommodated.
 
@<Scan an exponent@>=
{@+register char exp_sign;
p++;
if (*p=='+' || *p=='-') exp_sign=*p++;@+else exp_sign='+';
if (isdigit(*p)) {
for (exp=*p++ -'0';isdigit(*p);p++)
if (exp<1000) exp = 10*exp + *p - '0';
if (!dec_pt) dec_pt=q, zeros=0;
if (exp_sign=='-') exp=-exp;
next_char=p;
}
}
 
@ @<Return a floating point constant@>=
{
@<Move the digits from |buf| to |ff|@>;
@<Determine the binary fraction and binary exponent@>;
packit: @<Pack and round the answer@>;
return 1;
}
 
@ Now we get ready to compute the binary fraction bits, by putting the
scanned input digits into a multiprecision fixed-point
accumulator |ff| that spans the full necessary range.
After this step, the number that we want to convert to floating binary
will appear in |ff.dat[ff.a]|, |ff.dat[ff.a+1]|, \dots,
|ff.dat[ff.b]|.
The radix-$10^9$ digit in ${\it ff}[36-k]$ is understood to be multiplied
by $10^{9k}$, for $36\ge k\ge-120$.
 
@<Move the digits from |buf| to |ff|@>=
x=buf+341+zeros-dec_pt-exp;
if (q==buf0 || x>=1413) {
make_it_zero: exp=-99999;@+ goto packit;
}
if (x<0) {
make_it_infinite: exp=99999;@+ goto packit;
}
ff.a=x/9;
for (p=q;p<q+8;p++) *p='0'; /* pad with trailing zeros */
q=q-1-(q+341+zeros-dec_pt-exp)%9; /* compute stopping place in |buf| */
for (p=buf0-x%9,k=ff.a;p<=q && k<=156; p+=9, k++)
@<Put the 9-digit number |*p|\thinspace\dots\thinspace|*(p+8)|
into |ff.dat[k]|@>;
ff.b=k-1;
for (x=0;p<=q;p+=9) if (strncmp(p,"000000000",9)!=0) x=1;
ff.dat[156]+=x; /* nonzero digits that fall off the right are sticky */
@^sticky bit@>
while (ff.dat[ff.b]==0) ff.b--;
 
@ @<Put the 9-digit number...@>=
{
for (x=*p-'0',pp=p+1;pp<p+9;pp++) x=10*x + *pp - '0';
ff.dat[k]=x;
}
 
@ @<Local variables for |scan_const|@>=
register int k,x;
register char *pp;
bignum ff,tt;
 
@ Here's a subroutine that is dual to |bignum_times_ten|. It changes $f$
to~$2f$, assuming that overflow will not occur and that the radix is $10^9$.
 
@<Subr...@>=
static void bignum_double(f)
bignum *f;
{
register tetra *p,*q; register int x,carry;
for (p=&f->dat[f->b],q=&f->dat[f->a],carry=0; p>=q; p--) {
x = *p + *p + carry;
if (x>=1000000000) carry=1, *p=x-1000000000;
else carry=0, *p=x;
}
*p=carry;
if (carry) f->a--;
if (f->dat[f->b]==0 && f->b>f->a) f->b--;
}
 
@ @<Determine the binary fraction and binary exponent@>=
val=zero_octa;
if (ff.a>36) {
for (exp=0x3fe;ff.a>36;exp--) bignum_double(&ff);
for (k=54;k;k--) {
if (ff.dat[36]) {
if (k>=32) val.h |= 1<<(k-32);@+else val.l |= 1<<k;
ff.dat[36]=0;
if (ff.b==36) break; /* break if |ff| now zero */
}
bignum_double(&ff);
}
}@+else {
tt.a=tt.b=36, tt.dat[36]=2;
for (exp=0x3fe;bignum_compare(&ff,&tt)>=0;exp++) bignum_double(&tt);
for (k=54;k;k--) {
bignum_double(&ff);
if (bignum_compare(&ff,&tt)>=0) {
if (k>=32) val.h |= 1<<(k-32);@+else val.l |= 1<<k;
bignum_dec(&ff,&tt,1000000000);
if (ff.a==bignum_prec-1) break; /* break if |ff| now zero */
}
}
}
if (k==0) val.l |= 1; /* add sticky bit if |ff| nonzero */
 
@ We need to be careful that the input `\.{NaN.999999999999999999999}' doesn't
get rounded up; it is supposed to yield \Hex{7fffffffffffffff}.
 
Although the input `\.{NaN.0}' is illegal, strictly speaking, we silently
convert it to \Hex{7ff0000000000001}---a number that would be
output as `\.{NaN.0000000000000002}'.
 
@<Pack and round the answer@>=
val=fpack(val,exp,sign,ROUND_NEAR);
if (NaN) {
if ((val.h&0x7fffffff)==0x40000000) val.h |= 0x7fffffff, val.l=0xffffffff;
else if ((val.h&0x7fffffff)==0x3ff00000 && !val.l) val.h|=0x40000000,val.l=1;
else val.h |= 0x40000000;
}
 
@*Floating point remainders. In this section we implement the remainder
of the floating point operations---one of which happens to be the
operation of taking the remainder.
 
The easiest task remaining is to compare two floating point quantities.
Routine |fcomp| returns $-1$~if~$y<z$, 0~if~$y=z$, $+1$~if~$y>z$, and
$+2$~if $y$ and~$z$ are unordered.
 
@<Subr...@>=
int fcomp @,@,@[ARGS((octa,octa))@];@+@t}\6{@>
int fcomp(y,z)
octa y,z;
{
ftype yt,zt;
int ye,ze;
char ys,zs;
octa yf,zf;
register int x;
yt=funpack(y,&yf,&ye,&ys);
zt=funpack(z,&zf,&ze,&zs);
switch (4*yt+zt) {
case 4*nan+nan: case 4*zro+nan: case 4*num+nan: case 4*inf+nan:
case 4*nan+zro: case 4*nan+num: case 4*nan+inf: return 2;
case 4*zro+zro: return 0;
case 4*zro+num: case 4*num+zro: case 4*zro+inf: case 4*inf+zro:
case 4*num+num: case 4*num+inf: case 4*inf+num: case 4*inf+inf:
if (ys!=zs) x=1;
else if (y.h>z.h) x=1;
else if (y.h<z.h) x=-1;
else if (y.l>z.l) x=1;
else if (y.l<z.l) x=-1;
else return 0;
break;
}
return (ys=='-'? -x: x);
}
 
@ Several \MMIX\ operations act on a single floating point number and
accept an arbitrary rounding mode. For example, consider the
operation of rounding to the nearest floating point integer:
 
@<Subr...@>=
octa fintegerize @,@,@[ARGS((octa,int))@];@+@t}\6{@>
octa fintegerize(z,r)
octa z; /* the operand */
int r; /* the rounding mode */
{
ftype zt;
int ze;
char zs;
octa xf,zf;
zt=funpack(z,&zf,&ze,&zs);
if (!r) r=cur_round;
switch (zt) {
case nan:@+if (!(z.h&0x80000)) {@+exceptions|=I_BIT;@+z.h|=0x80000;@+}
case inf: case zro: return z;
case num: @<Integerize and |return|@>;
}
}
 
@ @<Integerize...@>=
if (ze>=1074) return fpack(zf,ze,zs,ROUND_OFF); /* already an integer */
if (ze<=1020) xf.h=0,xf.l=1;
else {@+octa oo;
xf=shift_right(zf,1074-ze,1);
oo=shift_left(xf,1074-ze);
if (oo.l!=zf.l || oo.h!=zf.h) xf.l|=1; /* sticky bit */
@^sticky bit@>
}
switch (r) {
case ROUND_DOWN:@+ if (zs=='-') xf=incr(xf,3);@+break;
case ROUND_UP:@+ if (zs!='-') xf=incr(xf,3);
case ROUND_OFF: break;
case ROUND_NEAR: xf=incr(xf, xf.l&4? 2: 1);@+break;
}
xf.l&=0xfffffffc;
if (ze>=1022) return fpack(shift_left(xf,1074-ze),ze,zs,ROUND_OFF);
if (xf.l) xf.h=0x3ff00000, xf.l=0;
if (zs=='-') xf.h|=sign_bit;
return xf;
 
@ To convert floating point to fixed point, we use |fixit|.
 
@<Subr...@>=
octa fixit @,@,@[ARGS((octa,int))@];@+@t}\6{@>
octa fixit(z,r)
octa z; /* the operand */
int r; /* the rounding mode */
{
ftype zt;
int ze;
char zs;
octa zf,o;
zt=funpack(z,&zf,&ze,&zs);
if (!r) r=cur_round;
switch (zt) {
case nan: case inf: exceptions|=I_BIT;@+return z;
case zro: return zero_octa;
case num:@+if (funpack(fintegerize(z,r),&zf,&ze,&zs)==zro) return zero_octa;
if (ze<=1076) o=shift_right(zf,1076-ze,1);
else {
if (ze>1085 || (ze==1085 && (zf.h>0x400000 || @|
(zf.h==0x400000 && (zf.l || zs!='-'))))) exceptions|=W_BIT;
if (ze>=1140) return zero_octa;
o=shift_left(zf,ze-1076);
}
return (zs=='-'? ominus(zero_octa,o): o);
}
}
 
@ Going the other way, we can specify not only a rounding mode but whether
the given fixed point octabyte is signed or unsigned, and whether the
result should be rounded to short precision.
 
@<Subr...@>=
octa floatit @,@,@[ARGS((octa,int,int,int))@];@+@t}\6{@>
octa floatit(z,r,u,p)
octa z; /* octabyte to float */
int r; /* rounding mode */
int u; /* unsigned? */
int p; /* short precision? */
{
int e;@+char s;
register int t;
exceptions=0;
if (!z.h && !z.l) return zero_octa;
if (!r) r=cur_round;
if (!u && (z.h&sign_bit)) s='-', z=ominus(zero_octa,z);@+ else s='+';
e=1076;
while (z.h<0x400000) e--,z=shift_left(z,1);
while (z.h>=0x800000) {
e++;
t=z.l&1;
z=shift_right(z,1,1);
z.l|=t;
}
if (p) @<Convert to short float@>;
return fpack(z,e,s,r);
}
 
@ @<Convert to short float@>=
{
register int ex;@+register tetra t;
t=sfpack(z,e,s,r);
ex=exceptions;
sfunpack(t,&z,&e,&s);
exceptions=ex;
}
 
@ The square root operation is more interesting.
 
@<Subr...@>=
octa froot @,@,@[ARGS((octa,int))@];@+@t}\6{@>
octa froot(z,r)
octa z; /* the operand */
int r; /* the rounding mode */
{
ftype zt;
int ze;
char zs;
octa x,xf,rf,zf;
register int xe,k;
if (!r) r=cur_round;
zt=funpack(z,&zf,&ze,&zs);
if (zs=='-' && zt!=zro) exceptions|=I_BIT, x=standard_NaN;
else@+switch (zt) {
case nan:@+ if (!(z.h&0x80000)) exceptions|=I_BIT, z.h|=0x80000;
return z;
case inf: case zro: x=z;@+break;
case num: @<Take the square root and |return|@>;
}
if (zs=='-') x.h|=sign_bit;
return x;
}
 
@ The square root can be found by an adaptation of the old pencil-and-paper
method. If $n=\lfloor\sqrt s\rfloor$, where $s$ is an integer,
we have $s=n^2+r$ where $0\le r\le2n$;
this invariant can be maintained if we replace $s$ by $4s+(0,1,2,3)$
and $n$ by $2n+(0,1)$. The following code implements this idea with
$2n$ in~|xf| and $r$ in~|rf|. (It could easily be made to run about
twice as fast.)
 
@<Take the square root and |return|@>=
xf.h=0, xf.l=2;
xe=(ze+0x3fe)>>1;
if (ze&1) zf=shift_left(zf,1);
rf.h=0, rf.l=(zf.h>>22)-1;
for (k=53;k;k--) {
rf=shift_left(rf,2);@+ xf=shift_left(xf,1);
if (k>=43) rf=incr(rf,(zf.h>>(2*(k-43)))&3);
else if (k>=27) rf=incr(rf,(zf.l>>(2*(k-27)))&3);
if ((rf.l>xf.l && rf.h>=xf.h) || rf.h>xf.h) {
xf.l++;@+rf=ominus(rf,xf);@+xf.l++;
}
}
if (rf.h || rf.l) xf.l++; /* sticky bit */
return fpack(xf,xe,'+',r);
 
@ And finally, the genuine floating point remainder. Subroutine |fremstep|
either calculates $y\,{\rm rem}\,z$ or reduces $y$ to a smaller number
having the same remainder with respect to~$z$. In the latter case
the |E_BIT| is set in |exceptions|. A third parameter, |delta|,
gives a decrease in exponent that is acceptable for incomplete results;
if |delta| is sufficiently large, say 2500, the correct result will
always be obtained in one step of |fremstep|.
 
@<Subr...@>=
octa fremstep @,@,@[ARGS((octa,octa,int))@];@+@t}\6{@>
octa fremstep(y,z,delta)
octa y,z;
int delta;
{
ftype yt,zt;
int ye,ze;
char xs,ys,zs;
octa x,xf,yf,zf;
register int xe,thresh,odd;
yt=funpack(y,&yf,&ye,&ys);
zt=funpack(z,&zf,&ze,&zs);
switch (4*yt+zt) {
@t\4@>@<The usual NaN cases@>;
case 4*zro+zro: case 4*num+zro: case 4*inf+zro:
case 4*inf+num: case 4*inf+inf: x=standard_NaN;
exceptions|=I_BIT;@+break;
case 4*zro+num: case 4*zro+inf: case 4*num+inf: return y;
case 4*num+num: @<Remainderize nonzero numbers and |return|@>;
zero_out: x=zero_octa;
}
if (ys=='-') x.h|=sign_bit;
return x;
}
 
@ If there's a huge difference in exponents and the remainder is nonzero,
this computation will take a long time. One could compute
$(2^ny)\,{\rm rem}\,z$ much more quickly for large~$n$ by using $O(\log n)$
multiplications modulo~$z$, but the floating remainder operation isn't
important enough to justify such expensive hardware.
 
Results of floating remainder are always exact, so the rounding mode
is immaterial.
 
@<Remainderize...@>=
odd=0; /* will be 1 if we've subtracted an odd multiple of~$z$ from $y$ */
thresh=ye-delta;
if (thresh<ze) thresh=ze;
while (ye>=thresh) @<Reduce |(ye,yf)| by a multiple of |zf|;
|goto zero_out| if the remainder is zero,
|goto try_complement| if appropriate@>;
if (ye>=ze) {
exceptions|=E_BIT;@+return fpack(yf,ye,ys,ROUND_OFF);
}
if (ye<ze-1) return fpack(yf,ye,ys,ROUND_OFF);
yf=shift_right(yf,1,1);
try_complement: xf=ominus(zf,yf), xe=ze, xs='+' + '-' - ys;
if (xf.h>yf.h || (xf.h==yf.h && (xf.l>yf.l || (xf.l==yf.l && !odd))))
xf=yf, xs=ys;
while (xf.h<0x400000) xe--, xf=shift_left(xf,1);
return fpack(xf,xe,xs,ROUND_OFF);
 
@ Here we are careful not to change the sign of |y|, because a remainder
of~0 is supposed to inherit the original sign of~|y|.
 
@<Reduce |(ye,yf)| by a multiple of |zf|...@>=
{
if (yf.h==zf.h && yf.l==zf.l) goto zero_out;
if (yf.h<zf.h || (yf.h==zf.h && yf.l<zf.l)) {
if (ye==ze) goto try_complement;
ye--, yf=shift_left(yf,1);
}
yf=ominus(yf,zf);
if (ye==ze) odd=1;
while (yf.h<0x400000) ye--, yf=shift_left(yf,1);
}
 
@* Index.
 
/fp.c
0,0 → 1,2216
#define sign_bit ((unsigned) 0x80000000) \
 
#define ROUND_OFF 1
#define ROUND_UP 2
#define ROUND_DOWN 3
#define ROUND_NEAR 4 \
 
#define X_BIT (1<<8)
#define Z_BIT (1<<9)
#define U_BIT (1<<10)
#define O_BIT (1<<11)
#define I_BIT (1<<12)
#define W_BIT (1<<13)
#define V_BIT (1<<14)
#define D_BIT (1<<15)
#define E_BIT (1<<18) \
 
#define zero_exponent (-1000) \
 
#define bignum_prec 157 \
 
#define magic_offset 2112
#define origin 37 \
 
#define buf0 (buf+8)
#define buf_max (buf+777) \
 
/*1:*/
#line 32 "./mmix-arith.w"
 
#include <stdio.h>
#include <string.h>
#include <ctype.h>
/*2:*/
#line 49 "./mmix-arith.w"
 
#ifdef __STDC__
#define ARGS(list) list
#else
#define ARGS(list) ()
#endif
 
/*:2*/
#line 36 "./mmix-arith.w"
 
typedef enum
{ false, true } bool;
/*3:*/
#line 60 "./mmix-arith.w"
 
typedef unsigned int tetra;
 
typedef struct
{
tetra h, l;
} octa;
 
/*:3*/
#line 38 "./mmix-arith.w"
 
/*36:*/
#line 605 "./mmix-arith.w"
 
typedef enum
{ zro, num, inf, nan } ftype;
 
/*:36*//*59: */
#line 1110 "./mmix-arith.w"
 
typedef struct
{
int a;
int b;
tetra dat[bignum_prec];
} bignum;
 
/*:59*/
#line 39 "./mmix-arith.w"
 
/*4:*/
#line 67 "./mmix-arith.w"
 
octa zero_octa;
octa neg_one = { -1, -1 };
octa inf_octa = { 0x7ff00000, 0 };
octa standard_NaN = { 0x7ff80000, 0 };
octa aux;
bool overflow;
 
/*:4*//*9: */
#line 174 "./mmix-arith.w"
 
extern octa aux;
extern bool overflow;
 
/*:9*//*30: */
#line 464 "./mmix-arith.w"
 
int cur_round;
 
/*:30*//*32: */
#line 528 "./mmix-arith.w"
 
int exceptions;
 
/*:32*//*69: */
#line 1359 "./mmix-arith.w"
 
octa val;
char *next_char;
 
/*:69*//*75: */
#line 1432 "./mmix-arith.w"
 
static char buf[785] = "00000000";
 
/*:75*/
#line 40 "./mmix-arith.w"
 
/*5:*/
#line 78 "./mmix-arith.w"
 
octa oplus ARGS ((octa, octa));
octa
oplus (y, z)
octa y, z;
{
octa x;
x.h = y.h + z.h;
x.l = y.l + z.l;
if (x.l < y.l)
x.h++;
return x;
}
 
octa ominus ARGS ((octa, octa));
octa
ominus (y, z)
octa y, z;
{
octa x;
x.h = y.h - z.h;
x.l = y.l - z.l;
if (x.l > y.l)
x.h--;
return x;
}
 
/*:5*//*6: */
#line 102 "./mmix-arith.w"
 
octa incr ARGS ((octa, int));
octa
incr (y, delta)
octa y;
int delta;
{
octa x;
x.h = y.h;
x.l = y.l + delta;
if (delta >= 0)
{
if (x.l < y.l)
x.h++;
}
else if (x.l > y.l)
x.h--;
return x;
}
 
/*:6*//*7: */
#line 117 "./mmix-arith.w"
 
octa shift_left ARGS ((octa, int));
octa
shift_left (y, s)
octa y;
int s;
{
while (s >= 32)
y.h = y.l, y.l = 0, s -= 32;
if (s)
{
register tetra yhl = y.h << s, ylh = y.l >> (32 - s);
y.h = yhl + ylh;
y.l <<= s;
}
return y;
}
 
octa shift_right ARGS ((octa, int, int));
octa
shift_right (y, s, u)
octa y;
int s, u;
{
while (s >= 32)
y.l = y.h, y.h = (u ? 0 : -(y.h >> 31)), s -= 32;
if (s)
{
register tetra yhl = y.h << (32 - s), ylh = y.l >> s;
y.h = (u ? 0 : (-(y.h >> 31)) << (32 - s)) + (y.h >> s);
y.l = yhl + ylh;
}
return y;
}
 
/*:7*//*8: */
#line 150 "./mmix-arith.w"
 
octa omult ARGS ((octa, octa));
octa
omult (y, z)
octa y, z;
{
register int i, j, k;
tetra u[4], v[4], w[8];
register tetra t;
octa acc;
/*10:*/
#line 178 "./mmix-arith.w"
 
u[3] = y.h >> 16, u[2] = y.h & 0xffff, u[1] = y.l >> 16, u[0] =
y.l & 0xffff;
v[3] = z.h >> 16, v[2] = z.h & 0xffff, v[1] = z.l >> 16, v[0] =
z.l & 0xffff;
 
/*:10*/
#line 159 "./mmix-arith.w"
;
for (j = 0; j < 4; j++)
w[j] = 0;
for (j = 0; j < 4; j++)
if (!v[j])
w[j + 4] = 0;
else
{
for (i = k = 0; i < 4; i++)
{
t = u[i] * v[j] + w[i + j] + k;
w[i + j] = t & 0xffff, k = t >> 16;
}
w[j + 4] = k;
}
/*11:*/
#line 182 "./mmix-arith.w"
 
aux.h = (w[7] << 16) + w[6], aux.l = (w[5] << 16) + w[4];
acc.h = (w[3] << 16) + w[2], acc.l = (w[1] << 16) + w[0];
 
/*:11*/
#line 170 "./mmix-arith.w"
;
return acc;
}
 
/*:8*//*12: */
#line 191 "./mmix-arith.w"
 
octa signed_omult ARGS ((octa, octa));
octa
signed_omult (y, z)
octa y, z;
{
octa acc;
acc = omult (y, z);
if (y.h & sign_bit)
aux = ominus (aux, z);
if (z.h & sign_bit)
aux = ominus (aux, y);
overflow = (aux.h != aux.l || (aux.h ^ (aux.h >> 1) ^ (acc.h & sign_bit)));
return acc;
}
 
/*:12*//*13: */
#line 215 "./mmix-arith.w"
 
octa odiv ARGS ((octa, octa, octa));
octa
odiv (x, y, z)
octa x, y, z;
{
register int i, j, k, n, d;
tetra u[8], v[4], q[4], mask, qhat, rhat, vh, vmh;
register tetra t;
octa acc;
/*14:*/
#line 234 "./mmix-arith.w"
 
if (x.h > z.h || (x.h == z.h && x.l >= z.l))
{
aux = y;
return x;
}
 
/*:14*/
#line 224 "./mmix-arith.w"
;
/*15:*/
#line 239 "./mmix-arith.w"
 
u[7] = x.h >> 16, u[6] = x.h & 0xffff, u[5] = x.l >> 16, u[4] =
x.l & 0xffff;
u[3] = y.h >> 16, u[2] = y.h & 0xffff, u[1] = y.l >> 16, u[0] =
y.l & 0xffff;
v[3] = z.h >> 16, v[2] = z.h & 0xffff, v[1] = z.l >> 16, v[0] =
z.l & 0xffff;
 
/*:15*/
#line 225 "./mmix-arith.w"
;
/*16:*/
#line 244 "./mmix-arith.w"
 
for (n = 4; v[n - 1] == 0; n--);
 
/*:16*/
#line 226 "./mmix-arith.w"
;
/*17:*/
#line 250 "./mmix-arith.w"
 
vh = v[n - 1];
for (d = 0; vh < 0x8000; d++, vh <<= 1);
for (j = k = 0; j < n + 4; j++)
{
t = (u[j] << d) + k;
u[j] = t & 0xffff, k = t >> 16;
}
for (j = k = 0; j < n; j++)
{
t = (v[j] << d) + k;
v[j] = t & 0xffff, k = t >> 16;
}
vh = v[n - 1];
vmh = (n > 1 ? v[n - 2] : 0);
 
/*:17*/
#line 227 "./mmix-arith.w"
;
for (j = 3; j >= 0; j--) /*20: */
#line 276 "./mmix-arith.w"
 
{
/*21:*/
#line 284 "./mmix-arith.w"
 
t = (u[j + n] << 16) + u[j + n - 1];
qhat = t / vh, rhat = t - vh * qhat;
if (n > 1)
while (qhat == 0x10000 || qhat * vmh > (rhat << 16) + u[j + n - 2])
{
qhat--, rhat += vh;
if (rhat >= 0x10000)
break;
}
 
/*:21*/
#line 278 "./mmix-arith.w"
;
/*22:*/
#line 296 "./mmix-arith.w"
 
for (i = k = 0; i < n; i++)
{
t = u[i + j] + 0xffff0000 - k - qhat * v[i];
u[i + j] = t & 0xffff, k = 0xffff - (t >> 16);
}
 
/*:22*/
#line 279 "./mmix-arith.w"
;
/*23:*/
#line 305 "./mmix-arith.w"
 
if (u[j + n] != k)
{
qhat--;
for (i = k = 0; i < n; i++)
{
t = u[i + j] + v[i] + k;
u[i + j] = t & 0xffff, k = t >> 16;
}
}
 
/*:23*/
#line 280 "./mmix-arith.w"
;
q[j] = qhat;
}
 
/*:20*/
#line 228 "./mmix-arith.w"
;
/*18:*/
#line 264 "./mmix-arith.w"
 
mask = (1 << d) - 1;
for (j = 3; j >= n; j--)
u[j] = 0;
for (k = 0; j >= 0; j--)
{
t = (k << 16) + u[j];
u[j] = t >> d, k = t & mask;
}
 
/*:18*/
#line 229 "./mmix-arith.w"
;
/*19:*/
#line 272 "./mmix-arith.w"
 
acc.h = (q[3] << 16) + q[2], acc.l = (q[1] << 16) + q[0];
aux.h = (u[3] << 16) + u[2], aux.l = (u[1] << 16) + u[0];
 
/*:19*/
#line 230 "./mmix-arith.w"
;
return acc;
}
 
/*:13*//*24: */
#line 317 "./mmix-arith.w"
 
octa signed_odiv ARGS ((octa, octa));
octa
signed_odiv (y, z)
octa y, z;
{
octa yy, zz, q;
register int sy, sz;
if (y.h & sign_bit)
sy = 2, yy = ominus (zero_octa, y);
else
sy = 0, yy = y;
if (z.h & sign_bit)
sz = 1, zz = ominus (zero_octa, z);
else
sz = 0, zz = z;
q = odiv (zero_octa, yy, zz);
overflow = false;
switch (sy + sz)
{
case 2 + 1:
aux = ominus (zero_octa, aux);
if (q.h == sign_bit)
overflow = true;
case 0 + 0:
return q;
case 2 + 0:
if (aux.h || aux.l)
aux = ominus (zz, aux);
goto negate_q;
case 0 + 1:
if (aux.h || aux.l)
aux = ominus (aux, zz);
negate_q:if (aux.h || aux.l)
return ominus (neg_one, q);
else
return ominus (zero_octa, q);
}
}
 
/*:24*//*25: */
#line 346 "./mmix-arith.w"
 
octa oand ARGS ((octa, octa));
octa
oand (y, z)
octa y, z;
{
octa x;
x.h = y.h & z.h;
x.l = y.l & z.l;
return x;
}
 
octa oandn ARGS ((octa, octa));
octa
oandn (y, z)
octa y, z;
{
octa x;
x.h = y.h & ~z.h;
x.l = y.l & ~z.l;
return x;
}
 
octa oxor ARGS ((octa, octa));
octa
oxor (y, z)
octa y, z;
{
octa x;
x.h = y.h ^ z.h;
x.l = y.l ^ z.l;
return x;
}
 
/*:25*//*26: */
#line 387 "./mmix-arith.w"
 
int count_bits ARGS ((tetra));
int
count_bits (x)
tetra x;
{
register int xx = x;
xx = xx - ((xx >> 1) & 0x55555555);
xx = (xx & 0x33333333) + ((xx >> 2) & 0x33333333);
xx = (xx + (xx >> 4)) & 0x0f0f0f0f;
xx = xx + (xx >> 8);
return (xx + (xx >> 16)) & 0xff;
}
 
/*:26*//*27: */
#line 403 "./mmix-arith.w"
 
tetra byte_diff ARGS ((tetra, tetra));
tetra
byte_diff (y, z)
tetra y, z;
{
register tetra d = (y & 0x00ff00ff) + 0x01000100 - (z & 0x00ff00ff);
register tetra m = d & 0x01000100;
register tetra x = d & (m - (m >> 8));
d = ((y >> 8) & 0x00ff00ff) + 0x01000100 - ((z >> 8) & 0x00ff00ff);
m = d & 0x01000100;
return x + ((d & (m - (m >> 8))) << 8);
}
 
/*:27*//*28: */
#line 421 "./mmix-arith.w"
 
tetra wyde_diff ARGS ((tetra, tetra));
tetra
wyde_diff (y, z)
tetra y, z;
{
register tetra a = ((y >> 16) - (z >> 16)) & 0x10000;
register tetra b = ((y & 0xffff) - (z & 0xffff)) & 0x10000;
return y - (z ^ ((y ^ z) & (b - a - (b >> 16))));
}
 
/*:28*//*29: */
#line 434 "./mmix-arith.w"
 
octa bool_mult ARGS ((octa, octa, bool));
octa
bool_mult (y, z, xor)
octa y, z;
bool xor;
{
octa o, x;
register tetra a, b, c;
register int k;
for (k = 0, o = y, x = zero_octa; o.h || o.l;
k++, o = shift_right (o, 8, 1))
if (o.l & 0xff)
{
a = ((z.h >> k) & 0x01010101) * 0xff;
b = ((z.l >> k) & 0x01010101) * 0xff;
c = (o.l & 0xff) * 0x01010101;
if (xor)
x.h ^= a & c, x.l ^= b & c;
else
x.h |= a & c, x.l |= b & c;
}
return x;
}
 
/*:29*//*31: */
#line 503 "./mmix-arith.w"
 
octa fpack ARGS ((octa, int, char, int));
octa
fpack (f, e, s, r)
octa f;
int e;
char s;
int r;
{
octa o;
if (e > 0x7fd)
e = 0x7ff, o = zero_octa;
else
{
if (e < 0)
{
if (e < -54)
o.h = 0, o.l = 1;
else
{
octa oo;
o = shift_right (f, -e, 1);
oo = shift_left (o, -e);
if (oo.l != f.l || oo.h != f.h)
o.l |= 1;
 
}
e = 0;
}
else
o = f;
}
/*33:*/
#line 533 "./mmix-arith.w"
 
if (o.l & 3)
exceptions |= X_BIT;
switch (r)
{
case ROUND_DOWN:
if (s == '-')
o = incr (o, 3);
break;
case ROUND_UP:
if (s != '-')
o = incr (o, 3);
case ROUND_OFF:
break;
case ROUND_NEAR:
o = incr (o, o.l & 4 ? 2 : 1);
break;
}
o = shift_right (o, 2, 1);
o.h += e << 20;
if (o.h >= 0x7ff00000)
exceptions |= O_BIT + X_BIT;
else if (o.h < 0x100000)
exceptions |= U_BIT;
if (s == '-')
o.h |= sign_bit;
return o;
 
/*:33*/
#line 525 "./mmix-arith.w"
;
}
 
/*:31*//*34: */
#line 551 "./mmix-arith.w"
 
tetra sfpack ARGS ((octa, int, char, int));
tetra
sfpack (f, e, s, r)
octa f;
int e;
char s;
int r;
{
register tetra o;
if (e > 0x47d)
e = 0x47f, o = 0;
else
{
o = shift_left (f, 3).h;
if (f.l & 0x1fffffff)
o |= 1;
if (e < 0x380)
{
if (e < 0x380 - 25)
o = 1;
else
{
register tetra o0, oo;
o0 = o;
o = o >> (0x380 - e);
oo = o << (0x380 - e);
if (oo != o0)
o |= 1;
 
}
e = 0x380;
}
}
/*35:*/
#line 579 "./mmix-arith.w"
 
if (o & 3)
exceptions |= X_BIT;
switch (r)
{
case ROUND_DOWN:
if (s == '-')
o += 3;
break;
case ROUND_UP:
if (s != '-')
o += 3;
case ROUND_OFF:
break;
case ROUND_NEAR:
o += (o & 4 ? 2 : 1);
break;
}
o = o >> 2;
o += (e - 0x380) << 23;
if (o >= 0x7f800000)
exceptions |= O_BIT + X_BIT;
else if (o < 0x100000)
exceptions |= U_BIT;
if (s == '-')
o |= sign_bit;
return o;
 
/*:35*/
#line 576 "./mmix-arith.w"
;
}
 
/*:34*//*37: */
#line 608 "./mmix-arith.w"
 
ftype funpack ARGS ((octa, octa *, int *, char *));
ftype
funpack (x, f, e, s)
octa x;
octa *f;
int *e;
char *s;
{
register int ee;
exceptions = 0;
*s = (x.h & sign_bit ? '-' : '+');
*f = shift_left (x, 2);
f->h &= 0x3fffff;
ee = (x.h >> 20) & 0x7ff;
if (ee)
{
*e = ee - 1;
f->h |= 0x400000;
return (ee < 0x7ff ? num : f->h == 0x400000 && !f->l ? inf : nan);
}
if (!x.l && !f->h)
{
*e = zero_exponent;
return zro;
}
do
{
ee--;
*f = shift_left (*f, 1);
}
while (!(f->h & 0x400000));
*e = ee;
return num;
}
 
/*:37*//*38: */
#line 634 "./mmix-arith.w"
 
ftype sfunpack ARGS ((tetra, octa *, int *, char *));
ftype
sfunpack (x, f, e, s)
tetra x;
octa *f;
int *e;
char *s;
{
register int ee;
exceptions = 0;
*s = (x & sign_bit ? '-' : '+');
f->h = (x >> 1) & 0x3fffff, f->l = x << 31;
ee = (x >> 23) & 0xff;
if (ee)
{
*e = ee + 0x380 - 1;
f->h |= 0x400000;
return (ee < 0xff ? num : (x & 0x7fffffff) == 0x7f800000 ? inf : nan);
}
if (!(x & 0x7fffffff))
{
*e = zero_exponent;
return zro;
}
do
{
ee--;
*f = shift_left (*f, 1);
}
while (!(f->h & 0x400000));
*e = ee + 0x380;
return num;
}
 
/*:38*//*39: */
#line 663 "./mmix-arith.w"
 
octa load_sf ARGS ((tetra));
octa
load_sf (z)
tetra z;
{
octa f, x;
int e;
char s;
ftype t;
t = sfunpack (z, &f, &e, &s);
switch (t)
{
case zro:
x = zero_octa;
break;
case num:
return fpack (f, e, s, ROUND_OFF);
case inf:
x = inf_octa;
break;
case nan:
x = shift_right (f, 2, 1);
x.h |= 0x7ff00000;
break;
}
if (s == '-')
x.h |= sign_bit;
return x;
}
 
/*:39*//*40: */
#line 680 "./mmix-arith.w"
 
tetra store_sf ARGS ((octa));
tetra
store_sf (x)
octa x;
{
octa f;
tetra z;
int e;
char s;
ftype t;
t = funpack (x, &f, &e, &s);
switch (t)
{
case zro:
z = 0;
break;
case num:
return sfpack (f, e, s, cur_round);
case inf:
z = 0x7f800000;
break;
case nan:
if (!(f.h & 0x200000))
{
f.h |= 0x200000;
exceptions |= I_BIT;
}
z = 0x7f800000 | (f.h << 1) | (f.l >> 31);
break;
}
if (s == '-')
z |= sign_bit;
return z;
}
 
/*:40*//*41: */
#line 705 "./mmix-arith.w"
 
octa fmult ARGS ((octa, octa));
octa
fmult (y, z)
octa y, z;
{
ftype yt, zt;
int ye, ze;
char ys, zs;
octa x, xf, yf, zf;
register int xe;
register char xs;
yt = funpack (y, &yf, &ye, &ys);
zt = funpack (z, &zf, &ze, &zs);
xs = ys + zs - '+';
switch (4 * yt + zt)
{
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4 * nan + nan:
if (!(y.h & 0x80000))
exceptions |= I_BIT;
case 4 * zro + nan:
case 4 * num + nan:
case 4 * inf + nan:
if (!(z.h & 0x80000))
exceptions |= I_BIT, z.h |= 0x80000;
return z;
case 4 * nan + zro:
case 4 * nan + num:
case 4 * nan + inf:
if (!(y.h & 0x80000))
exceptions |= I_BIT, y.h |= 0x80000;
return y;
 
/*:42*/
#line 720 "./mmix-arith.w"
;
case 4 * zro + zro:
case 4 * zro + num:
case 4 * num + zro:
x = zero_octa;
break;
case 4 * num + inf:
case 4 * inf + num:
case 4 * inf + inf:
x = inf_octa;
break;
case 4 * zro + inf:
case 4 * inf + zro:
x = standard_NaN;
exceptions |= I_BIT;
break;
case 4 * num + num: /*43: */
#line 740 "./mmix-arith.w"
 
xe = ye + ze - 0x3fd;
x = omult (yf, shift_left (zf, 9));
if (aux.h >= 0x400000)
xf = aux;
else
xf = shift_left (aux, 1), xe--;
if (x.h || x.l)
xf.l |= 1;
return fpack (xf, xe, xs, cur_round);
 
/*:43*/
#line 725 "./mmix-arith.w"
;
}
if (xs == '-')
x.h |= sign_bit;
return x;
}
 
/*:41*//*44: */
#line 748 "./mmix-arith.w"
 
octa fdivide ARGS ((octa, octa));
octa
fdivide (y, z)
octa y, z;
{
ftype yt, zt;
int ye, ze;
char ys, zs;
octa x, xf, yf, zf;
register int xe;
register char xs;
yt = funpack (y, &yf, &ye, &ys);
zt = funpack (z, &zf, &ze, &zs);
xs = ys + zs - '+';
switch (4 * yt + zt)
{
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4 * nan + nan:
if (!(y.h & 0x80000))
exceptions |= I_BIT;
case 4 * zro + nan:
case 4 * num + nan:
case 4 * inf + nan:
if (!(z.h & 0x80000))
exceptions |= I_BIT, z.h |= 0x80000;
return z;
case 4 * nan + zro:
case 4 * nan + num:
case 4 * nan + inf:
if (!(y.h & 0x80000))
exceptions |= I_BIT, y.h |= 0x80000;
return y;
 
/*:42*/
#line 763 "./mmix-arith.w"
;
case 4 * zro + inf:
case 4 * zro + num:
case 4 * num + inf:
x = zero_octa;
break;
case 4 * num + zro:
exceptions |= Z_BIT;
case 4 * inf + num:
case 4 * inf + zro:
x = inf_octa;
break;
case 4 * zro + zro:
case 4 * inf + inf:
x = standard_NaN;
exceptions |= I_BIT;
break;
case 4 * num + num: /*45: */
#line 775 "./mmix-arith.w"
 
xe = ye - ze + 0x3fd;
xf = odiv (yf, zero_octa, shift_left (zf, 9));
if (xf.h >= 0x800000)
{
aux.l |= xf.l & 1;
xf = shift_right (xf, 1, 1);
xe++;
}
if (aux.h || aux.l)
xf.l |= 1;
return fpack (xf, xe, xs, cur_round);
 
/*:45*/
#line 769 "./mmix-arith.w"
;
}
if (xs == '-')
x.h |= sign_bit;
return x;
}
 
/*:44*//*46: */
#line 790 "./mmix-arith.w"
 
octa fplus ARGS ((octa, octa));
octa
fplus (y, z)
octa y, z;
{
ftype yt, zt;
int ye, ze;
char ys, zs;
octa x, xf, yf, zf;
register int xe, d;
register char xs;
yt = funpack (y, &yf, &ye, &ys);
zt = funpack (z, &zf, &ze, &zs);
switch (4 * yt + zt)
{
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4 * nan + nan:
if (!(y.h & 0x80000))
exceptions |= I_BIT;
case 4 * zro + nan:
case 4 * num + nan:
case 4 * inf + nan:
if (!(z.h & 0x80000))
exceptions |= I_BIT, z.h |= 0x80000;
return z;
case 4 * nan + zro:
case 4 * nan + num:
case 4 * nan + inf:
if (!(y.h & 0x80000))
exceptions |= I_BIT, y.h |= 0x80000;
return y;
 
/*:42*/
#line 804 "./mmix-arith.w"
;
case 4 * zro + num:
return fpack (zf, ze, zs, ROUND_OFF);
break;
case 4 * num + zro:
return fpack (yf, ye, ys, ROUND_OFF);
break;
case 4 * inf + inf:
if (ys != zs)
{
exceptions |= I_BIT;
x = standard_NaN;
xs = zs;
break;
}
case 4 * num + inf:
case 4 * zro + inf:
x = inf_octa;
xs = zs;
break;
case 4 * inf + num:
case 4 * inf + zro:
x = inf_octa;
xs = ys;
break;
case 4 * num + num:
if (y.h != (z.h ^ 0x80000000) || y.l != z.l)
/*47:*/
#line 821 "./mmix-arith.w"
 
{
octa o, oo;
if (ye < ze
|| (ye == ze && (yf.h < zf.h || (yf.h == zf.h && yf.l < zf.l))))
/*48:*/
#line 839 "./mmix-arith.w"
 
{
o = yf, yf = zf, zf = o;
d = ye, ye = ze, ze = d;
d = ys, ys = zs, zs = d;
}
 
/*:48*/
#line 824 "./mmix-arith.w"
;
d = ye - ze;
xs = ys, xe = ye;
if (d) /*49: */
#line 859 "./mmix-arith.w"
 
{
if (d <= 2)
zf = shift_right (zf, d, 1);
else if (d > 53)
zf.h = 0, zf.l = 1;
else
{
if (ys != zs)
d--, xe--, yf = shift_left (yf, 1);
o = zf;
zf = shift_right (o, d, 1);
oo = shift_left (zf, d);
if (oo.l != o.l || oo.h != o.h)
zf.l |= 1;
}
}
 
/*:49*/
#line 827 "./mmix-arith.w"
;
if (ys == zs)
{
xf = oplus (yf, zf);
if (xf.h >= 0x800000)
xe++, d = xf.l & 1, xf = shift_right (xf, 1, 1), xf.l |= d;
}
else
{
xf = ominus (yf, zf);
if (xf.h >= 0x800000)
xe++, d = xf.l & 1, xf = shift_right (xf, 1, 1), xf.l |= d;
else
while (xf.h < 0x400000)
xe--, xf = shift_left (xf, 1);
}
return fpack (xf, xe, xs, cur_round);
}
 
/*:47*/
#line 813 "./mmix-arith.w"
;
case 4 * zro + zro:
x = zero_octa;
xs = (ys == zs ? ys : cur_round == ROUND_DOWN ? '-' : '+');
break;
}
if (xs == '-')
x.h |= sign_bit;
return x;
}
 
/*:46*//*50: */
#line 883 "./mmix-arith.w"
 
int fepscomp ARGS ((octa, octa, octa, int));
int
fepscomp (y, z, e, s)
octa y, z, e;
int s;
{
octa yf, zf, ef, o, oo;
int ye, ze, ee;
char ys, zs, es;
register int yt, zt, et, d;
et = funpack (e, &ef, &ee, &es);
if (es == '-')
return 2;
switch (et)
{
case nan:
return 2;
case inf:
ee = 10000;
case num:
case zro:
break;
}
yt = funpack (y, &yf, &ye, &ys);
zt = funpack (z, &zf, &ze, &zs);
switch (4 * yt + zt)
{
case 4 * nan + nan:
case 4 * nan + inf:
case 4 * nan + num:
case 4 * nan + zro:
case 4 * inf + nan:
case 4 * num + nan:
case 4 * zro + nan:
return 2;
case 4 * inf + inf:
return (ys == zs || ee >= 1023);
case 4 * inf + num:
case 4 * inf + zro:
case 4 * num + inf:
case 4 * zro + inf:
return (s && ee >= 1022);
case 4 * zro + zro:
return 1;
case 4 * zro + num:
case 4 * num + zro:
if (!s)
return 0;
case 4 * num + num:
break;
}
/*51:*/
#line 919 "./mmix-arith.w"
 
/*52:*/
#line 934 "./mmix-arith.w"
 
if (ye < 0 && yt != zro)
yf = shift_left (y, 2), ye = 0;
if (ze < 0 && zt != zro)
zf = shift_left (z, 2), ze = 0;
 
/*:52*/
#line 920 "./mmix-arith.w"
;
if (ye < ze || (ye == ze && (yf.h < zf.h || (yf.h == zf.h && yf.l < zf.l))))
/*48:*/
#line 839 "./mmix-arith.w"
 
{
o = yf, yf = zf, zf = o;
d = ye, ye = ze, ze = d;
d = ys, ys = zs, zs = d;
}
 
/*:48*/
#line 922 "./mmix-arith.w"
;
if (ze == zero_exponent)
ze = ye;
d = ye - ze;
if (!s)
ee -= d;
if (ee >= 1023)
return 1;
/*53:*/
#line 956 "./mmix-arith.w"
 
if (d > 54)
o = zero_octa, oo = zf;
else
o = shift_right (zf, d, 1), oo = shift_left (o, d);
if (oo.h != zf.h || oo.l != zf.l)
{
if (ee < 1020)
return 0;
o = incr (o, ys == zs ? 0 : 1);
}
o = (ys == zs ? ominus (yf, o) : oplus (yf, o));
 
/*:53*/
#line 927 "./mmix-arith.w"
;
if (!o.h && !o.l)
return 1;
if (ee < 968)
return 0;
if (ee >= 1021)
ef = shift_left (ef, ee - 1021);
else
ef = shift_right (ef, 1021 - ee, 1);
return o.h < ef.h || (o.h == ef.h && o.l <= ef.l);
 
/*:51*/
#line 912 "./mmix-arith.w"
;
}
 
/*:50*//*54: */
#line 972 "./mmix-arith.w"
 
static void bignum_times_ten ARGS ((bignum *));
static void bignum_dec ARGS ((bignum *, bignum *, tetra));
static int bignum_compare ARGS ((bignum *, bignum *));
void print_float ARGS ((octa));
void
print_float (x)
octa x;
{
/*56:*/
#line 1035 "./mmix-arith.w"
 
octa f, g;
register int e;
register int j, k;
 
/*:56*//*66: */
#line 1281 "./mmix-arith.w"
 
bignum ff, gg;
bignum tt;
char s[18];
register char *p;
 
/*:66*/
#line 980 "./mmix-arith.w"
;
if (x.h & sign_bit)
printf ("-");
/*55:*/
#line 1019 "./mmix-arith.w"
 
f = shift_left (x, 1);
e = f.h >> 21;
f.h &= 0x1fffff;
if (!f.h && !f.l) /*57: */
#line 1045 "./mmix-arith.w"
 
{
if (!e)
{
printf ("0.");
return;
}
if (e == 0x7ff)
{
printf ("Inf");
return;
}
e--;
f.h = 0x3fffff, f.l = 0xffffffff;
g.h = 0x400000, g.l = 2;
}
 
/*:57*/
#line 1023 "./mmix-arith.w"
 
else
{
g = incr (f, 1);
f = incr (f, -1);
if (!e)
e = 1;
else if (e == 0x7ff)
{
printf ("NaN");
if (g.h == 0x100000 && g.l == 1)
return;
e = 0x3ff;
}
else
f.h |= 0x200000, g.h |= 0x200000;
}
 
/*:55*/
#line 983 "./mmix-arith.w"
;
/*63:*/
#line 1195 "./mmix-arith.w"
 
k = (magic_offset - e) / 28;
ff.dat[k - 1] =
shift_right (f, magic_offset + 28 - e - 28 * k, 1).l & 0xfffffff;
gg.dat[k - 1] =
shift_right (g, magic_offset + 28 - e - 28 * k, 1).l & 0xfffffff;
ff.dat[k] = shift_right (f, magic_offset - e - 28 * k, 1).l & 0xfffffff;
gg.dat[k] = shift_right (g, magic_offset - e - 28 * k, 1).l & 0xfffffff;
ff.dat[k + 1] =
shift_left (f, e + 28 * k - (magic_offset - 28)).l & 0xfffffff;
gg.dat[k + 1] =
shift_left (g, e + 28 * k - (magic_offset - 28)).l & 0xfffffff;
ff.a = (ff.dat[k - 1] ? k - 1 : k);
ff.b = (ff.dat[k + 1] ? k + 1 : k);
gg.a = (gg.dat[k - 1] ? k - 1 : k);
gg.b = (gg.dat[k + 1] ? k + 1 : k);
 
/*:63*/
#line 984 "./mmix-arith.w"
;
/*64:*/
#line 1223 "./mmix-arith.w"
 
if (e > 0x401) /*65: */
#line 1254 "./mmix-arith.w"
 
{
register int open = x.l & 1;
tt.dat[origin] = 10;
tt.a = tt.b = origin;
for (e = 1; bignum_compare (&gg, &tt) >= open; e++)
bignum_times_ten (&tt);
p = s;
while (1)
{
bignum_times_ten (&ff);
bignum_times_ten (&gg);
for (j = '0'; bignum_compare (&ff, &tt) >= 0; j++)
bignum_dec (&ff, &tt, 0x10000000), bignum_dec (&gg, &tt,
0x10000000);
if (bignum_compare (&gg, &tt) >= open)
break;
*p++ = j;
if (ff.a == bignum_prec - 1 && !open)
goto done;
}
for (k = j; bignum_compare (&gg, &tt) >= open; k++)
bignum_dec (&gg, &tt, 0x10000000);
*p++ = (j + 1 + k) >> 1;
done:;
}
 
/*:65*/
#line 1224 "./mmix-arith.w"
 
else
{
if (ff.a > origin)
ff.dat[origin] = 0;
for (e = 1, p = s; gg.a > origin || ff.dat[origin] == gg.dat[origin];)
{
if (gg.a > origin)
e--;
else
*p++ = ff.dat[origin] + '0', ff.dat[origin] = 0, gg.dat[origin] =
0;
bignum_times_ten (&ff);
bignum_times_ten (&gg);
}
*p++ = ((ff.dat[origin] + 1 + gg.dat[origin]) >> 1) + '0';
}
*p = '\0';
 
/*:64*/
#line 985 "./mmix-arith.w"
;
/*67:*/
#line 1296 "./mmix-arith.w"
 
if (e > 17 || e < (int) strlen (s) - 17)
printf ("%c%s%se%d", s[0], (s[1] ? "." : ""), s + 1, e - 1);
else if (e < 0)
printf (".%0*d%s", -e, 0, s);
else if (strlen (s) >= e)
printf ("%.*s.%s", e, s, s + e);
else
printf ("%s%0*d.", s, e - (int) strlen (s), 0);
 
/*:67*/
#line 986 "./mmix-arith.w"
;
}
 
/*:54*//*60: */
#line 1120 "./mmix-arith.w"
 
static void
bignum_times_ten (f)
bignum *f;
{
register tetra *p, *q;
register tetra x, carry;
for (p = &f->dat[f->b], q = &f->dat[f->a], carry = 0; p >= q; p--)
{
x = *p * 10 + carry;
*p = x & 0xfffffff;
carry = x >> 28;
}
*p = carry;
if (carry)
f->a--;
if (f->dat[f->b] == 0 && f->b > f->a)
f->b--;
}
 
/*:60*//*61: */
#line 1138 "./mmix-arith.w"
 
static int
bignum_compare (f, g)
bignum *f, *g;
{
register tetra *p, *pp, *q, *qq;
if (f->a != g->a)
return f->a > g->a ? -1 : 1;
pp = &f->dat[f->b], qq = &g->dat[g->b];
for (p = &f->dat[f->a], q = &g->dat[g->a]; p <= pp; p++, q++)
{
if (*p != *q)
return *p < *q ? -1 : 1;
if (q == qq)
return p < pp;
}
return -1;
}
 
/*:61*//*62: */
#line 1155 "./mmix-arith.w"
 
static void
bignum_dec (f, g, r)
bignum *f, *g;
tetra r;
{
register tetra *p, *q, *qq;
register int x, borrow;
while (g->b > f->b)
f->dat[++f->b] = 0;
qq = &g->dat[g->a];
for (p = &f->dat[g->b], q = &g->dat[g->b], borrow = 0; q >= qq; p--, q--)
{
x = *p - *q - borrow;
if (x >= 0)
borrow = 0, *p = x;
else
borrow = 1, *p = x + r;
}
for (; borrow; p--)
if (*p)
borrow = 0, *p = *p - 1;
else
*p = r - 1;
while (f->dat[f->a] == 0)
{
if (f->a == f->b)
{
f->a = f->b = bignum_prec - 1, f->dat[bignum_prec - 1] = 0;
return;
}
f->a++;
}
while (f->dat[f->b] == 0)
f->b--;
}
 
/*:62*//*68: */
#line 1340 "./mmix-arith.w"
 
static void bignum_double ARGS ((bignum *));
int scan_const ARGS ((char *));
int
scan_const (s)
char *s;
{
/*70:*/
#line 1363 "./mmix-arith.w"
 
register char *p, *q;
register bool NaN;
int sign;
 
/*:70*//*76: */
#line 1435 "./mmix-arith.w"
 
register char *dec_pt;
register int exp;
register int zeros;
 
/*:76*//*81: */
#line 1503 "./mmix-arith.w"
 
register int k, x;
register char *pp;
bignum ff, tt;
 
/*:81*/
#line 1346 "./mmix-arith.w"
;
val.h = val.l = 0;
p = s;
if (*p == '+' || *p == '-')
sign = *p++;
else
sign = '+';
if (strncmp (p, "NaN", 3) == 0)
NaN = true, p += 3;
else
NaN = false;
if ((isdigit (*p) && !NaN) || (*p == '.' && isdigit (*(p + 1))))
/*73:*/
#line 1396 "./mmix-arith.w"
 
{
for (q = buf0, dec_pt = (char *) 0; isdigit (*p); p++)
{
val = oplus (val, shift_left (val, 2));
val = incr (shift_left (val, 1), *p - '0');
if (q > buf0 || *p != '0')
if (q < buf_max)
*q++ = *p;
else if (*(q - 1) == '0')
*(q - 1) = *p;
}
if (NaN)
*q++ = '1';
if (*p == '.') /*74: */
#line 1415 "./mmix-arith.w"
 
{
dec_pt = q;
p++;
for (zeros = 0; isdigit (*p); p++)
if (*p == '0' && q == buf0)
zeros++;
else if (q < buf_max)
*q++ = *p;
else if (*(q - 1) == '0')
*(q - 1) = *p;
}
 
/*:74*/
#line 1406 "./mmix-arith.w"
;
next_char = p;
if (*p == 'e' && !NaN) /*77: */
#line 1447 "./mmix-arith.w"
 
{
register char exp_sign;
p++;
if (*p == '+' || *p == '-')
exp_sign = *p++;
else
exp_sign = '+';
if (isdigit (*p))
{
for (exp = *p++ - '0'; isdigit (*p); p++)
if (exp < 1000)
exp = 10 * exp + *p - '0';
if (!dec_pt)
dec_pt = q, zeros = 0;
if (exp_sign == '-')
exp = -exp;
next_char = p;
}
}
 
/*:77*/
#line 1408 "./mmix-arith.w"
 
else
exp = 0;
if (dec_pt) /*78: */
#line 1460 "./mmix-arith.w"
 
{
/*79:*/
#line 1477 "./mmix-arith.w"
 
x = buf + 341 + zeros - dec_pt - exp;
if (q == buf0 || x >= 1413)
{
make_it_zero:exp = -99999;
goto packit;
}
if (x < 0)
{
make_it_infinite:exp = 99999;
goto packit;
}
ff.a = x / 9;
for (p = q; p < q + 8; p++)
*p = '0';
q = q - 1 - (q + 341 + zeros - dec_pt - exp) % 9;
for (p = buf0 - x % 9, k = ff.a; p <= q && k <= 156; p += 9, k++)
/*80:*/
#line 1497 "./mmix-arith.w"
 
{
for (x = *p - '0', pp = p + 1; pp < p + 9; pp++)
x = 10 * x + *pp - '0';
ff.dat[k] = x;
}
 
/*:80*/
#line 1490 "./mmix-arith.w"
;
ff.b = k - 1;
for (x = 0; p <= q; p += 9)
if (strncmp (p, "000000000", 9) != 0)
x = 1;
ff.dat[156] += x;
 
while (ff.dat[ff.b] == 0)
ff.b--;
 
/*:79*/
#line 1462 "./mmix-arith.w"
;
/*83:*/
#line 1526 "./mmix-arith.w"
 
val = zero_octa;
if (ff.a > 36)
{
for (exp = 0x3fe; ff.a > 36; exp--)
bignum_double (&ff);
for (k = 54; k; k--)
{
if (ff.dat[36])
{
if (k >= 32)
val.h |= 1 << (k - 32);
else
val.l |= 1 << k;
ff.dat[36] = 0;
if (ff.b == 36)
break;
}
bignum_double (&ff);
}
}
else
{
tt.a = tt.b = 36, tt.dat[36] = 2;
for (exp = 0x3fe; bignum_compare (&ff, &tt) >= 0; exp++)
bignum_double (&tt);
for (k = 54; k; k--)
{
bignum_double (&ff);
if (bignum_compare (&ff, &tt) >= 0)
{
if (k >= 32)
val.h |= 1 << (k - 32);
else
val.l |= 1 << k;
bignum_dec (&ff, &tt, 1000000000);
if (ff.a == bignum_prec - 1)
break;
}
}
}
if (k == 0)
val.l |= 1;
 
/*:83*/
#line 1463 "./mmix-arith.w"
;
packit: /*84: */
#line 1559 "./mmix-arith.w"
 
val = fpack (val, exp, sign, ROUND_NEAR);
if (NaN)
{
if ((val.h & 0x7fffffff) == 0x40000000)
val.h |= 0x7fffffff, val.l = 0xffffffff;
else if ((val.h & 0x7fffffff) == 0x3ff00000 && !val.l)
val.h |= 0x40000000, val.l = 1;
else
val.h |= 0x40000000;
}
 
/*:84*/
#line 1464 "./mmix-arith.w"
;
return 1;
}
 
/*:78*/
#line 1410 "./mmix-arith.w"
;
if (sign == '-')
val = ominus (zero_octa, val);
return 0;
}
 
/*:73*/
#line 1353 "./mmix-arith.w"
;
if (NaN) /*71: */
#line 1368 "./mmix-arith.w"
 
{
next_char = p;
val.h = 0x600000, exp = 0x3fe;
goto packit;
}
 
/*:71*/
#line 1354 "./mmix-arith.w"
;
if (strncmp (p, "Inf", 3) == 0) /*72: */
#line 1375 "./mmix-arith.w"
 
{
next_char = p + 3;
goto make_it_infinite;
}
 
/*:72*/
#line 1355 "./mmix-arith.w"
;
no_const_found:next_char = s;
return -1;
}
 
/*:68*//*82: */
#line 1511 "./mmix-arith.w"
 
static void
bignum_double (f)
bignum *f;
{
register tetra *p, *q;
register int x, carry;
for (p = &f->dat[f->b], q = &f->dat[f->a], carry = 0; p >= q; p--)
{
x = *p + *p + carry;
if (x >= 1000000000)
carry = 1, *p = x - 1000000000;
else
carry = 0, *p = x;
}
*p = carry;
if (carry)
f->a--;
if (f->dat[f->b] == 0 && f->b > f->a)
f->b--;
}
 
/*:82*//*85: */
#line 1575 "./mmix-arith.w"
 
int fcomp ARGS ((octa, octa));
int
fcomp (y, z)
octa y, z;
{
ftype yt, zt;
int ye, ze;
char ys, zs;
octa yf, zf;
register int x;
yt = funpack (y, &yf, &ye, &ys);
zt = funpack (z, &zf, &ze, &zs);
switch (4 * yt + zt)
{
case 4 * nan + nan:
case 4 * zro + nan:
case 4 * num + nan:
case 4 * inf + nan:
case 4 * nan + zro:
case 4 * nan + num:
case 4 * nan + inf:
return 2;
case 4 * zro + zro:
return 0;
case 4 * zro + num:
case 4 * num + zro:
case 4 * zro + inf:
case 4 * inf + zro:
case 4 * num + num:
case 4 * num + inf:
case 4 * inf + num:
case 4 * inf + inf:
if (ys != zs)
x = 1;
else if (y.h > z.h)
x = 1;
else if (y.h < z.h)
x = -1;
else if (y.l > z.l)
x = 1;
else if (y.l < z.l)
x = -1;
else
return 0;
break;
}
return (ys == '-' ? -x : x);
}
 
/*:85*//*86: */
#line 1608 "./mmix-arith.w"
 
octa fintegerize ARGS ((octa, int));
octa
fintegerize (z, r)
octa z;
int r;
{
ftype zt;
int ze;
char zs;
octa xf, zf;
zt = funpack (z, &zf, &ze, &zs);
if (!r)
r = cur_round;
switch (zt)
{
case nan:
if (!(z.h & 0x80000))
{
exceptions |= I_BIT;
z.h |= 0x80000;
}
case inf:
case zro:
return z;
case num: /*87: */
#line 1627 "./mmix-arith.w"
 
if (ze >= 1074)
return fpack (zf, ze, zs, ROUND_OFF);
if (ze <= 1020)
xf.h = 0, xf.l = 1;
else
{
octa oo;
xf = shift_right (zf, 1074 - ze, 1);
oo = shift_left (xf, 1074 - ze);
if (oo.l != zf.l || oo.h != zf.h)
xf.l |= 1;
 
}
switch (r)
{
case ROUND_DOWN:
if (zs == '-')
xf = incr (xf, 3);
break;
case ROUND_UP:
if (zs != '-')
xf = incr (xf, 3);
case ROUND_OFF:
break;
case ROUND_NEAR:
xf = incr (xf, xf.l & 4 ? 2 : 1);
break;
}
xf.l &= 0xfffffffc;
if (ze >= 1022)
return fpack (shift_left (xf, 1074 - ze), ze, zs, ROUND_OFF);
if (xf.l)
xf.h = 0x3ff00000, xf.l = 0;
if (zs == '-')
xf.h |= sign_bit;
return xf;
 
/*:87*/
#line 1623 "./mmix-arith.w"
;
}
}
 
/*:86*//*88: */
#line 1650 "./mmix-arith.w"
 
octa fixit ARGS ((octa, int));
octa
fixit (z, r)
octa z;
int r;
{
ftype zt;
int ze;
char zs;
octa zf, o;
zt = funpack (z, &zf, &ze, &zs);
if (!r)
r = cur_round;
switch (zt)
{
case nan:
case inf:
exceptions |= I_BIT;
return z;
case zro:
return zero_octa;
case num:
if (funpack (fintegerize (z, r), &zf, &ze, &zs) == zro)
return zero_octa;
if (ze <= 1076)
o = shift_right (zf, 1076 - ze, 1);
else
{
if (ze > 1085 || (ze == 1085 && (zf.h > 0x400000 ||
(zf.h == 0x400000
&& (zf.l || zs != '-')))))
exceptions |= W_BIT;
if (ze >= 1140)
return zero_octa;
o = shift_left (zf, ze - 1076);
}
return (zs == '-' ? ominus (zero_octa, o) : o);
}
}
 
/*:88*//*89: */
#line 1681 "./mmix-arith.w"
 
octa floatit ARGS ((octa, int, int, int));
octa
floatit (z, r, u, p)
octa z;
int r;
int u;
int p;
{
int e;
char s;
register int t;
exceptions = 0;
if (!z.h && !z.l)
return zero_octa;
if (!r)
r = cur_round;
if (!u && (z.h & sign_bit))
s = '-', z = ominus (zero_octa, z);
else
s = '+';
e = 1076;
while (z.h < 0x400000)
e--, z = shift_left (z, 1);
while (z.h >= 0x800000)
{
e++;
t = z.l & 1;
z = shift_right (z, 1, 1);
z.l |= t;
}
if (p) /*90: */
#line 1707 "./mmix-arith.w"
 
{
register int ex;
register tetra t;
t = sfpack (z, e, s, r);
ex = exceptions;
sfunpack (t, &z, &e, &s);
exceptions = ex;
}
 
/*:90*/
#line 1703 "./mmix-arith.w"
;
return fpack (z, e, s, r);
}
 
/*:89*//*91: */
#line 1718 "./mmix-arith.w"
 
octa froot ARGS ((octa, int));
octa
froot (z, r)
octa z;
int r;
{
ftype zt;
int ze;
char zs;
octa x, xf, rf, zf;
register int xe, k;
if (!r)
r = cur_round;
zt = funpack (z, &zf, &ze, &zs);
if (zs == '-' && zt != zro)
exceptions |= I_BIT, x = standard_NaN;
else
switch (zt)
{
case nan:
if (!(z.h & 0x80000))
exceptions |= I_BIT, z.h |= 0x80000;
return z;
case inf:
case zro:
x = z;
break;
case num: /*92: */
#line 1750 "./mmix-arith.w"
 
xf.h = 0, xf.l = 2;
xe = (ze + 0x3fe) >> 1;
if (ze & 1)
zf = shift_left (zf, 1);
rf.h = 0, rf.l = (zf.h >> 22) - 1;
for (k = 53; k; k--)
{
rf = shift_left (rf, 2);
xf = shift_left (xf, 1);
if (k >= 43)
rf = incr (rf, (zf.h >> (2 * (k - 43))) & 3);
else if (k >= 27)
rf = incr (rf, (zf.l >> (2 * (k - 27))) & 3);
if ((rf.l > xf.l && rf.h >= xf.h) || rf.h > xf.h)
{
xf.l++;
rf = ominus (rf, xf);
xf.l++;
}
}
if (rf.h || rf.l)
xf.l++;
return fpack (xf, xe, '+', r);
 
/*:92*/
#line 1736 "./mmix-arith.w"
;
}
if (zs == '-')
x.h |= sign_bit;
return x;
}
 
/*:91*//*93: */
#line 1774 "./mmix-arith.w"
 
octa fremstep ARGS ((octa, octa, int));
octa
fremstep (y, z, delta)
octa y, z;
int delta;
{
ftype yt, zt;
int ye, ze;
char xs, ys, zs;
octa x, xf, yf, zf;
register int xe, thresh, odd;
yt = funpack (y, &yf, &ye, &ys);
zt = funpack (z, &zf, &ze, &zs);
switch (4 * yt + zt)
{
/*42:*/
#line 731 "./mmix-arith.w"
 
case 4 * nan + nan:
if (!(y.h & 0x80000))
exceptions |= I_BIT;
case 4 * zro + nan:
case 4 * num + nan:
case 4 * inf + nan:
if (!(z.h & 0x80000))
exceptions |= I_BIT, z.h |= 0x80000;
return z;
case 4 * nan + zro:
case 4 * nan + num:
case 4 * nan + inf:
if (!(y.h & 0x80000))
exceptions |= I_BIT, y.h |= 0x80000;
return y;
 
/*:42*/
#line 1788 "./mmix-arith.w"
;
case 4 * zro + zro:
case 4 * num + zro:
case 4 * inf + zro:
case 4 * inf + num:
case 4 * inf + inf:
x = standard_NaN;
exceptions |= I_BIT;
break;
case 4 * zro + num:
case 4 * zro + inf:
case 4 * num + inf:
return y;
case 4 * num + num: /*94: */
#line 1809 "./mmix-arith.w"
 
odd = 0;
thresh = ye - delta;
if (thresh < ze)
thresh = ze;
while (ye >= thresh) /*95: */
#line 1830 "./mmix-arith.w"
 
{
if (yf.h == zf.h && yf.l == zf.l)
goto zero_out;
if (yf.h < zf.h || (yf.h == zf.h && yf.l < zf.l))
{
if (ye == ze)
goto try_complement;
ye--, yf = shift_left (yf, 1);
}
yf = ominus (yf, zf);
if (ye == ze)
odd = 1;
while (yf.h < 0x400000)
ye--, yf = shift_left (yf, 1);
}
 
/*:95*/
#line 1815 "./mmix-arith.w"
;
if (ye >= ze)
{
exceptions |= E_BIT;
return fpack (yf, ye, ys, ROUND_OFF);
}
if (ye < ze - 1)
return fpack (yf, ye, ys, ROUND_OFF);
yf = shift_right (yf, 1, 1);
try_complement:xf = ominus (zf, yf), xe = ze, xs = '+' + '-' - ys;
if (xf.h > yf.h
|| (xf.h == yf.h && (xf.l > yf.l || (xf.l == yf.l && !odd))))
xf = yf, xs = ys;
while (xf.h < 0x400000)
xe--, xf = shift_left (xf, 1);
return fpack (xf, xe, xs, ROUND_OFF);
 
/*:94*/
#line 1793 "./mmix-arith.w"
;
zero_out:x = zero_octa;
}
if (ys == '-')
x.h |= sign_bit;
return x;
}
 
/*:93*/
#line 41 "./mmix-arith.w"
 
 
/*:1*/
/boilerplate.w
0,0 → 1,27
% This material goes at the beginning of all MMIXware CWEB files
 
\def\topofcontents{
\leftline{\sc\today\ at \hours}\bigskip\bigskip
\centerline{\titlefont\title}}
 
\font\ninett=cmtt9
\def\botofcontents{\vskip 0pt plus 1filll
\ninerm\baselineskip10pt
\noindent\copyright\ 1999 Donald E. Knuth
\bigskip\noindent
This file may be freely copied and distributed, provided that
no changes whatsoever are made. All users are asked to help keep
the {\ninett MMIX}ware files consistent and ``uncorrupted,''
identical everywhere in the world. Changes are permissible only
if the modified file is given a new name, different from the names of
existing files in the {\ninett MMIX}ware package,
and only if the modified file is clearly identified
as not being part of that package.
(The {\ninett CWEB} system has a ``change file'' facility by
which users can easily make minor alterations without modifying
the master source files in any way. Everybody is supposed to use
change files instead of changing the files.)
The author has tried his best to produce correct and useful programs,
in order to help promote computer science research,
but no warranty of any kind should be assumed.}
 
/mmix-arith.tex
0,0 → 1,2631
\input cwebmac
% This file is part of the MMIXware package (c) Donald E Knuth 1999
% This material goes at the beginning of all MMIXware CWEB files
 
\def\topofcontents{
\leftline{\sc\today\ at \hours}\bigskip\bigskip
\centerline{\titlefont\title}}
 
\font\ninett=cmtt9
\def\botofcontents{\vskip 0pt plus 1filll
\ninerm\baselineskip10pt
\noindent\copyright\ 1999 Donald E. Knuth
\bigskip\noindent
This file may be freely copied and distributed, provided that
no changes whatsoever are made. All users are asked to help keep
the {\ninett MMIX}ware files consistent and ``uncorrupted,''
identical everywhere in the world. Changes are permissible only
if the modified file is given a new name, different from the names of
existing files in the {\ninett MMIX}ware package,
and only if the modified file is clearly identified
as not being part of that package.
(The {\ninett CWEB} system has a ``change file'' facility by
which users can easily make minor alterations without modifying
the master source files in any way. Everybody is supposed to use
change files instead of changing the files.)
The author has tried his best to produce correct and useful programs,
in order to help promote computer science research,
but no warranty of any kind should be assumed.}
 
 
\def\title{MMIX-ARITH}
 
\def\MMIX{\.{MMIX}}
\def\MMIXAL{\.{MMIXAL}}
\def\Hex#1{\hbox{$^{\scriptscriptstyle\#}$\tt#1}} % experimental hex constant
\def\dts{\mathinner{\ldotp\ldotp}}
\def\<#1>{\hbox{$\langle\,$#1$\,\rangle$}}\let\is=\longrightarrow
\def\ff{\\{ff\kern-.05em}}
 
 
 
 
\N{1}{1}Introduction. The subroutines below are used to simulate 64-bit \MMIX\
arithmetic on an old-fashioned 32-bit computer---like the one the author
had when he wrote \MMIXAL\ and the first \MMIX\ simulators in 1998 and 1999.
All operations are fabricated from 32-bit arithmetic, including
a full implementation of the IEEE floating point standard,
assuming only that the \CEE/ compiler has a 32-bit unsigned integer type.
 
Some day 64-bit machines will be commonplace and the awkward manipulations of
the present program will look quite archaic. Interested readers who have such
computers will be able to convert the code to a pure 64-bit form without
difficulty, thereby obtaining much faster and simpler routines. Meanwhile,
however, we can simulate the future and hope for continued progress.
 
This program module has a simple structure, intended to make it
suitable for loading with \MMIX\ simulators and assemblers.
 
\Y\B\8\#\&{include} \.{<stdio.h>}\6
\8\#\&{include} \.{<string.h>}\6
\8\#\&{include} \.{<ctype.h>}\6
\X2:Stuff for \CEE/ preprocessor\X\7
\&{typedef} \&{enum} ${}\{{}$\5
\1${}\\{false},\39{}$\\{true}\5
\2${}\}{}$ \&{bool};\7
\X3:Tetrabyte and octabyte type definitions\X\6
\X36:Other type definitions\X\6
\X4:Global variables\X\6
\X5:Subroutines\X\par
\fi
 
\M{2}Subroutines of this program are declared first with a prototype,
as in {\mc ANSI C}, then with an old-style \CEE/ function definition.
Here are some preprocessor commands that make this work correctly with both
new-style and old-style compilers.
 
\Y\B\4\X2:Stuff for \CEE/ preprocessor\X${}\E{}$\6
\8\#\&{ifdef} \.{\_\_STDC\_\_}\6
\8\#\&{define} \.{ARGS}(\\{list}) \5\\{list}\6
\8\#\&{else}\6
\8\#\&{define} \.{ARGS}(\\{list}) \5(\,)\6
\8\#\&{endif}\par
\U1.\fi
 
\M{3}The definition of type \&{tetra} should be changed, if necessary, so that
it represents an unsigned 32-bit integer.
 
\Y\B\4\X3:Tetrabyte and octabyte type definitions\X${}\E{}$\6
\&{typedef} \&{unsigned} \&{int} \&{tetra};\C{ for systems conforming to the
LP-64 data model }\6
\&{typedef} \&{struct} ${}\{{}$\1\6
\&{tetra} \|h${},{}$ \|l;\2\6
${}\}{}$ \&{octa};\C{ two tetrabytes make one octabyte }\par
\U1.\fi
 
\M{4}\B\D$\\{sign\_bit}$ \5
((\&{unsigned}) \T{\^80000000})\par
\Y\B\4\X4:Global variables\X${}\E{}$\6
\&{octa} \\{zero\_octa};\C{ \PB{$\\{zero\_octa}.\|h\K\\{zero\_octa}.\|l\K%
\T{0}$} }\6
\&{octa} \\{neg\_one}${}\K\{{-}\T{1},\39{-}\T{1}\}{}$;\C{ \PB{$\\{neg\_one}.\|h%
\K\\{neg\_one}.\|l\K{-}\T{1}$} }\6
\&{octa} \\{inf\_octa}${}\K\{\T{\^7ff00000},\39\T{0}\}{}$;\C{ floating point $+%
\infty$ }\6
\&{octa} \\{standard\_NaN}${}\K\{\T{\^7ff80000},\39\T{0}\}{}$;\C{ floating
point NaN(.5) }\6
\&{octa} \\{aux};\C{ auxiliary output of a subroutine }\6
\&{bool} \\{overflow};\C{ set by certain subroutines for signed arithmetic }\par
\As9, 30, 32, 69\ETs75.
\U1.\fi
 
\M{5}It's easy to add and subtract octabytes, if we aren't terribly
worried about speed.
 
\Y\B\4\X5:Subroutines\X${}\E{}$\6
\&{octa} \\{oplus}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{oplus}(\|y,\39\|z{}$)\C{ compute $y+z$ }\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\5
\1\&{octa} \|x;\7
${}\|x.\|h\K\|y.\|h+\|z.\|h{}$;\5
${}\|x.\|l\K\|y.\|l+\|z.\|l;{}$\6
\&{if} ${}(\|x.\|l<\|y.\|l){}$\1\5
${}\|x.\|h\PP;{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\7
\&{octa} \\{ominus}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{ominus}(\|y,\39\|z{}$)\C{ compute $y-z$ }\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\5
\1\&{octa} \|x;\7
${}\|x.\|h\K\|y.\|h-\|z.\|h{}$;\5
${}\|x.\|l\K\|y.\|l-\|z.\|l;{}$\6
\&{if} ${}(\|x.\|l>\|y.\|l){}$\1\5
${}\|x.\|h\MM;{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\As6, 7, 8, 12, 13, 24, 25, 26, 27, 28, 29, 31, 34, 37, 38, 39, 40, 41, 44, 46,
50, 54, 60, 61, 62, 68, 82, 85, 86, 88, 89, 91\ETs93.
\U1.\fi
 
\M{6}In the following subroutine, \PB{\\{delta}} is a signed quantity that is
assumed to fit in a signed tetrabyte.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{incr}\,\,${}\.{ARGS}((\&{octa},\39\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{incr}(\|y,\39\\{delta}{}$)\C{ compute $y+\delta$ }\1%
\1\6
\&{octa} \|y;\6
\&{int} \\{delta};\2\2\6
${}\{{}$\5
\1\&{octa} \|x;\7
${}\|x.\|h\K\|y.\|h{}$;\5
${}\|x.\|l\K\|y.\|l+\\{delta};{}$\6
\&{if} ${}(\\{delta}\G\T{0}){}$\5
${}\{{}$\1\6
\&{if} ${}(\|x.\|l<\|y.\|l){}$\1\5
${}\|x.\|h\PP;{}$\2\6
\4${}\}{}$\5
\2\&{else} \&{if} ${}(\|x.\|l>\|y.\|l){}$\1\5
${}\|x.\|h\MM;{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{7}Left and right shifts are only a bit more difficult.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{shift\_left}\,\,${}\.{ARGS}((\&{octa},\39\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{shift\_left}(\|y,\39\|s{}$)\C{ shift left by $s$
bits, where $0\le s\le64$ }\1\1\6
\&{octa} \|y;\6
\&{int} \|s;\2\2\6
${}\{{}$\1\6
\&{while} ${}(\|s\G\T{32}){}$\1\5
${}\|y.\|h\K\|y.\|l,\39\|y.\|l\K\T{0},\39\|s\MRL{-{\K}}\T{32};{}$\2\6
\&{if} (\|s)\5
${}\{{}$\5
\1\&{register} \&{tetra} \\{yhl}${}\K\|y.\|h\LL\|s,{}$ \\{ylh}${}\K\|y.\|l\GG(%
\T{32}-\|s);{}$\7
${}\|y.\|h\K\\{yhl}+\\{ylh}{}$;\5
${}\|y.\|l\MRL{{\LL}{\K}}\|s;{}$\6
\4${}\}{}$\2\6
\&{return} \|y;\6
\4${}\}{}$\2\7
\&{octa} \\{shift\_right}\,\,${}\.{ARGS}((\&{octa},\39\&{int},\39\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{shift\_right}(\|y,\39\|s,\39\|u{}$)\C{ shift right,
arithmetically if $u=0$ }\1\1\6
\&{octa} \|y;\6
\&{int} \|s${},{}$ \|u;\2\2\6
${}\{{}$\1\6
\&{while} ${}(\|s\G\T{32}){}$\1\5
${}\|y.\|l\K\|y.\|h,\39\|y.\|h\K(\|u\?\T{0}:{-}(\|y.\|h\GG\T{31})),\39\|s%
\MRL{-{\K}}\T{32};{}$\2\6
\&{if} (\|s)\5
${}\{{}$\5
\1\&{register} \&{tetra} \\{yhl}${}\K\|y.\|h\LL(\T{32}-\|s),{}$ \\{ylh}${}\K%
\|y.\|l\GG\|s;{}$\7
${}\|y.\|h\K(\|u\?\T{0}:({-}(\|y.\|h\GG\T{31}))\LL(\T{32}-\|s))+(\|y.\|h\GG%
\|s){}$;\5
${}\|y.\|l\K\\{yhl}+\\{ylh};{}$\6
\4${}\}{}$\2\6
\&{return} \|y;\6
\4${}\}{}$\2\par
\fi
 
\N{1}{8}Multiplication. We need to multiply two unsigned 64-bit integers,
obtaining
an unsigned 128-bit product. It is easy to do this on a 32-bit machine
by using Algorithm 4.3.1M of {\sl Seminumerical Algorithms}, with $b=2^{16}$.
 
The following subroutine returns the lower half of the product, and
puts the upper half into a global octabyte called \PB{\\{aux}}.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{omult}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{omult}(\|y,\39\|z){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{register} \&{int} \|i${},{}$ \|j${},{}$ \|k;\6
\&{tetra} \|u[\T{4}]${},{}$ \|v[\T{4}]${},{}$ \|w[\T{8}];\6
\&{register} \&{tetra} \|t;\6
\&{octa} \\{acc};\7
\X10:Unpack the multiplier and multiplicand to \PB{\|u} and \PB{\|v}\X;\6
\&{for} ${}(\|j\K\T{0};{}$ ${}\|j<\T{4};{}$ ${}\|j\PP){}$\1\5
${}\|w[\|j]\K\T{0};{}$\2\6
\&{for} ${}(\|j\K\T{0};{}$ ${}\|j<\T{4};{}$ ${}\|j\PP){}$\1\6
\&{if} ${}(\R\|v[\|j]){}$\1\5
${}\|w[\|j+\T{4}]\K\T{0};{}$\2\6
\&{else}\5
${}\{{}$\1\6
\&{for} ${}(\|i\K\|k\K\T{0};{}$ ${}\|i<\T{4};{}$ ${}\|i\PP){}$\5
${}\{{}$\1\6
${}\|t\K\|u[\|i]*\|v[\|j]+\|w[\|i+\|j]+\|k;{}$\6
${}\|w[\|i+\|j]\K\|t\AND\T{\^ffff},\39\|k\K\|t\GG\T{16};{}$\6
\4${}\}{}$\2\6
${}\|w[\|j+\T{4}]\K\|k;{}$\6
\4${}\}{}$\2\2\6
\X11:Pack \PB{\|w} into the outputs \PB{\\{aux}} and \PB{\\{acc}}\X;\6
\&{return} \\{acc};\6
\4${}\}{}$\2\par
\fi
 
\M{9}\B\X4:Global variables\X${}\mathrel+\E{}$\6
\&{extern} \&{octa} \\{aux};\C{ secondary output of subroutines with multiple
outputs }\6
\&{extern} \&{bool} \\{overflow};\par
\fi
 
\M{10}\B\X10:Unpack the multiplier and multiplicand to \PB{\|u} and \PB{\|v}%
\X${}\E{}$\6
$\|u[\T{3}]\K\|y.\|h\GG\T{16},\39\|u[\T{2}]\K\|y.\|h\AND\T{\^ffff},\39\|u[%
\T{1}]\K\|y.\|l\GG\T{16},\39\|u[\T{0}]\K\|y.\|l\AND\T{\^ffff};{}$\6
${}\|v[\T{3}]\K\|z.\|h\GG\T{16},\39\|v[\T{2}]\K\|z.\|h\AND\T{\^ffff},\39\|v[%
\T{1}]\K\|z.\|l\GG\T{16},\39\|v[\T{0}]\K\|z.\|l\AND\T{\^ffff}{}$;\par
\U8.\fi
 
\M{11}\B\X11:Pack \PB{\|w} into the outputs \PB{\\{aux}} and \PB{\\{acc}}\X${}%
\E{}$\6
$\\{aux}.\|h\K(\|w[\T{7}]\LL\T{16})+\|w[\T{6}],\39\\{aux}.\|l\K(\|w[\T{5}]\LL%
\T{16})+\|w[\T{4}];{}$\6
${}\\{acc}.\|h\K(\|w[\T{3}]\LL\T{16})+\|w[\T{2}],\39\\{acc}.\|l\K(\|w[\T{1}]\LL%
\T{16})+\|w[\T{0}]{}$;\par
\U8.\fi
 
\M{12}Signed multiplication has the same lower half product as unsigned
multiplication. The signed upper half product is obtained with at most two
further subtractions, after which the result has overflowed if and only if
the upper half is unequal to 64 copies of the sign bit in the lower half.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{signed\_omult}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{signed\_omult}(\|y,\39\|z){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{octa} \\{acc};\7
${}\\{acc}\K\\{omult}(\|y,\39\|z);{}$\6
\&{if} ${}(\|y.\|h\AND\\{sign\_bit}){}$\1\5
${}\\{aux}\K\\{ominus}(\\{aux},\39\|z);{}$\2\6
\&{if} ${}(\|z.\|h\AND\\{sign\_bit}){}$\1\5
${}\\{aux}\K\\{ominus}(\\{aux},\39\|y);{}$\2\6
${}\\{overflow}\K(\\{aux}.\|h\I\\{aux}.\|l\V(\\{aux}.\|h\XOR(\\{aux}.\|h\GG%
\T{1})\XOR(\\{acc}.\|h\AND\\{sign\_bit})));{}$\6
\&{return} \\{acc};\6
\4${}\}{}$\2\par
\fi
 
\N{1}{13}Division. Long division of an unsigned 128-bit integer by an unsigned
64-bit integer is, of course, one of the most challenging routines
needed for \MMIX\ arithmetic. The following program, based on
Algorithm 4.3.1D of {\sl Seminumerical Algorithms}, computes
octabytes $q$ and $r$ such that $(2^{64}x+y)=qz+r$ and $0\le r<z$,
given octabytes $x$, $y$, and~$z$, assuming that $x<z$.
(If $x\ge z$, it simply sets $q=x$ and $r=y$.)
The quotient~$q$ is returned by the subroutine;
the remainder~$r$ is stored in \PB{\\{aux}}.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{odiv}\,\,${}\.{ARGS}((\&{octa},\39\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{odiv}(\|x,\39\|y,\39\|z){}$\1\1\6
\&{octa} \|x${},{}$ \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{register} \&{int} \|i${},{}$ \|j${},{}$ \|k${},{}$ \|n${},{}$ \|d;\6
\&{tetra} \|u[\T{8}]${},{}$ \|v[\T{4}]${},{}$ \|q[\T{4}]${},{}$ \\{mask}${},{}$
\\{qhat}${},{}$ \\{rhat}${},{}$ \\{vh}${},{}$ \\{vmh};\6
\&{register} \&{tetra} \|t;\6
\&{octa} \\{acc};\7
\X14:Check that \PB{$\|x<\|z$}; otherwise give trivial answer\X;\6
\X15:Unpack the dividend and divisor to \PB{\|u} and \PB{\|v}\X;\6
\X16:Determine the number of significant places \PB{\|n} in the divisor \PB{%
\|v}\X;\6
\X17:Normalize the divisor\X;\6
\&{for} ${}(\|j\K\T{3};{}$ ${}\|j\G\T{0};{}$ ${}\|j\MM){}$\1\5
\X20:Determine the quotient digit \PB{\|q[\|j]}\X;\2\6
\X18:Unnormalize the remainder\X;\6
\X19:Pack \PB{\|q} and \PB{\|u} to \PB{\\{acc}} and \PB{\\{aux}}\X;\6
\&{return} \\{acc};\6
\4${}\}{}$\2\par
\fi
 
\M{14}\B\X14:Check that \PB{$\|x<\|z$}; otherwise give trivial answer\X${}\E{}$%
\6
\&{if} ${}(\|x.\|h>\|z.\|h\V(\|x.\|h\E\|z.\|h\W\|x.\|l\G\|z.\|l)){}$\5
${}\{{}$\1\6
${}\\{aux}\K\|y{}$;\5
\&{return} \|x;\6
\4${}\}{}$\2\par
\U13.\fi
 
\M{15}\B\X15:Unpack the dividend and divisor to \PB{\|u} and \PB{\|v}\X${}\E{}$%
\6
$\|u[\T{7}]\K\|x.\|h\GG\T{16},\39\|u[\T{6}]\K\|x.\|h\AND\T{\^ffff},\39\|u[%
\T{5}]\K\|x.\|l\GG\T{16},\39\|u[\T{4}]\K\|x.\|l\AND\T{\^ffff};{}$\6
${}\|u[\T{3}]\K\|y.\|h\GG\T{16},\39\|u[\T{2}]\K\|y.\|h\AND\T{\^ffff},\39\|u[%
\T{1}]\K\|y.\|l\GG\T{16},\39\|u[\T{0}]\K\|y.\|l\AND\T{\^ffff};{}$\6
${}\|v[\T{3}]\K\|z.\|h\GG\T{16},\39\|v[\T{2}]\K\|z.\|h\AND\T{\^ffff},\39\|v[%
\T{1}]\K\|z.\|l\GG\T{16},\39\|v[\T{0}]\K\|z.\|l\AND\T{\^ffff}{}$;\par
\U13.\fi
 
\M{16}\B\X16:Determine the number of significant places \PB{\|n} in the divisor
\PB{\|v}\X${}\E{}$\6
\&{for} ${}(\|n\K\T{4};{}$ ${}\|v[\|n-\T{1}]\E\T{0};{}$ ${}\|n\MM){}$\1\5
;\2\par
\U13.\fi
 
\M{17}We shift \PB{\|u} and \PB{\|v} left by \PB{\|d} places, where \PB{\|d} is
chosen to
make $2^{15}\le v_{n-1}<2^{16}$.
 
\Y\B\4\X17:Normalize the divisor\X${}\E{}$\6
$\\{vh}\K\|v[\|n-\T{1}];{}$\6
\&{for} ${}(\|d\K\T{0};{}$ ${}\\{vh}<\T{\^8000};{}$ ${}\|d\PP,\39\\{vh}\MRL{{%
\LL}{\K}}\T{1}){}$\1\5
;\2\6
\&{for} ${}(\|j\K\|k\K\T{0};{}$ ${}\|j<\|n+\T{4};{}$ ${}\|j\PP){}$\5
${}\{{}$\1\6
${}\|t\K(\|u[\|j]\LL\|d)+\|k;{}$\6
${}\|u[\|j]\K\|t\AND\T{\^ffff},\39\|k\K\|t\GG\T{16};{}$\6
\4${}\}{}$\2\6
\&{for} ${}(\|j\K\|k\K\T{0};{}$ ${}\|j<\|n;{}$ ${}\|j\PP){}$\5
${}\{{}$\1\6
${}\|t\K(\|v[\|j]\LL\|d)+\|k;{}$\6
${}\|v[\|j]\K\|t\AND\T{\^ffff},\39\|k\K\|t\GG\T{16};{}$\6
\4${}\}{}$\2\6
${}\\{vh}\K\|v[\|n-\T{1}];{}$\6
${}\\{vmh}\K(\|n>\T{1}\?\|v[\|n-\T{2}]:\T{0}){}$;\par
\U13.\fi
 
\M{18}\B\X18:Unnormalize the remainder\X${}\E{}$\6
$\\{mask}\K(\T{1}\LL\|d)-\T{1};{}$\6
\&{for} ${}(\|j\K\T{3};{}$ ${}\|j\G\|n;{}$ ${}\|j\MM){}$\1\5
${}\|u[\|j]\K\T{0};{}$\2\6
\&{for} ${}(\|k\K\T{0};{}$ ${}\|j\G\T{0};{}$ ${}\|j\MM){}$\5
${}\{{}$\1\6
${}\|t\K(\|k\LL\T{16})+\|u[\|j];{}$\6
${}\|u[\|j]\K\|t\GG\|d,\39\|k\K\|t\AND\\{mask};{}$\6
\4${}\}{}$\2\par
\U13.\fi
 
\M{19}\B\X19:Pack \PB{\|q} and \PB{\|u} to \PB{\\{acc}} and \PB{\\{aux}}\X${}%
\E{}$\6
$\\{acc}.\|h\K(\|q[\T{3}]\LL\T{16})+\|q[\T{2}],\39\\{acc}.\|l\K(\|q[\T{1}]\LL%
\T{16})+\|q[\T{0}];{}$\6
${}\\{aux}.\|h\K(\|u[\T{3}]\LL\T{16})+\|u[\T{2}],\39\\{aux}.\|l\K(\|u[\T{1}]\LL%
\T{16})+\|u[\T{0}]{}$;\par
\U13.\fi
 
\M{20}\B\X20:Determine the quotient digit \PB{\|q[\|j]}\X${}\E{}$\6
${}\{{}$\1\6
\X21:Find the trial quotient, $\hat q$\X;\6
\X22:Subtract $b^j\hat q v$ from \PB{\|u}\X;\6
\X23:If the result was negative, decrease $\hat q$ by 1\X;\6
${}\|q[\|j]\K\\{qhat};{}$\6
\4${}\}{}$\2\par
\U13.\fi
 
\M{21}\B\X21:Find the trial quotient, $\hat q$\X${}\E{}$\6
$\|t\K(\|u[\|j+\|n]\LL\T{16})+\|u[\|j+\|n-\T{1}];{}$\6
${}\\{qhat}\K\|t/\\{vh},\39\\{rhat}\K\|t-\\{vh}*\\{qhat};{}$\6
\&{if} ${}(\|n>\T{1}){}$\1\6
\&{while} ${}(\\{qhat}\E\T{\^10000}\V\\{qhat}*\\{vmh}>(\\{rhat}\LL\T{16})+\|u[%
\|j+\|n-\T{2}]){}$\5
${}\{{}$\1\6
${}\\{qhat}\MM,\39\\{rhat}\MRL{+{\K}}\\{vh};{}$\6
\&{if} ${}(\\{rhat}\G\T{\^10000}){}$\1\5
\&{break};\2\6
\4${}\}{}$\2\2\par
\U20.\fi
 
\M{22}After this step, \PB{$\|u[\|j+\|n]$} will either equal \PB{\|k} or \PB{$%
\|k-\T{1}$}. The
true value of~\PB{\|u} would be obtained by subtracting~\PB{\|k} from \PB{$\|u[%
\|j+\|n]$};
but we don't have to fuss over \PB{$\|u[\|j+\|n]$}, because it won't be
examined later.
 
\Y\B\4\X22:Subtract $b^j\hat q v$ from \PB{\|u}\X${}\E{}$\6
\&{for} ${}(\|i\K\|k\K\T{0};{}$ ${}\|i<\|n;{}$ ${}\|i\PP){}$\5
${}\{{}$\1\6
${}\|t\K\|u[\|i+\|j]+\T{\^ffff0000}-\|k-\\{qhat}*\|v[\|i];{}$\6
${}\|u[\|i+\|j]\K\|t\AND\T{\^ffff},\39\|k\K\T{\^ffff}-(\|t\GG\T{16});{}$\6
\4${}\}{}$\2\par
\U20.\fi
 
\M{23}The correction here occurs only rarely, but it can be necessary---for
example, when dividing the number \Hex{7fff800100000000} by \Hex{800080020005}.
 
\Y\B\4\X23:If the result was negative, decrease $\hat q$ by 1\X${}\E{}$\6
\&{if} ${}(\|u[\|j+\|n]\I\|k){}$\5
${}\{{}$\1\6
${}\\{qhat}\MM;{}$\6
\&{for} ${}(\|i\K\|k\K\T{0};{}$ ${}\|i<\|n;{}$ ${}\|i\PP){}$\5
${}\{{}$\1\6
${}\|t\K\|u[\|i+\|j]+\|v[\|i]+\|k;{}$\6
${}\|u[\|i+\|j]\K\|t\AND\T{\^ffff},\39\|k\K\|t\GG\T{16};{}$\6
\4${}\}{}$\2\6
\4${}\}{}$\2\par
\U20.\fi
 
\M{24}Signed division can be reduced to unsigned division in a tedious
but straightforward manner. We assume that the divisor isn't zero.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{signed\_odiv}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{signed\_odiv}(\|y,\39\|z){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{octa} \\{yy}${},{}$ \\{zz}${},{}$ \|q;\6
\&{register} \&{int} \\{sy}${},{}$ \\{sz};\7
\&{if} ${}(\|y.\|h\AND\\{sign\_bit}){}$\1\5
${}\\{sy}\K\T{2},\39\\{yy}\K\\{ominus}(\\{zero\_octa},\39\|y);{}$\2\6
\&{else}\1\5
${}\\{sy}\K\T{0},\39\\{yy}\K\|y;{}$\2\6
\&{if} ${}(\|z.\|h\AND\\{sign\_bit}){}$\1\5
${}\\{sz}\K\T{1},\39\\{zz}\K\\{ominus}(\\{zero\_octa},\39\|z);{}$\2\6
\&{else}\1\5
${}\\{sz}\K\T{0},\39\\{zz}\K\|z;{}$\2\6
${}\|q\K\\{odiv}(\\{zero\_octa},\39\\{yy},\39\\{zz});{}$\6
${}\\{overflow}\K\\{false};{}$\6
\&{switch} ${}(\\{sy}+\\{sz}){}$\5
${}\{{}$\1\6
\4\&{case} \T{2}${}+\T{1}{}$:\5
${}\\{aux}\K\\{ominus}(\\{zero\_octa},\39\\{aux});{}$\6
\&{if} ${}(\|q.\|h\E\\{sign\_bit}){}$\1\5
${}\\{overflow}\K\\{true};{}$\2\6
\4\&{case} \T{0}${}+\T{0}{}$:\5
\&{return} \|q;\6
\4\&{case} \T{2}${}+\T{0}{}$:\5
\&{if} ${}(\\{aux}.\|h\V\\{aux}.\|l){}$\1\5
${}\\{aux}\K\\{ominus}(\\{zz},\39\\{aux});{}$\2\6
\&{goto} \\{negate\_q};\6
\4\&{case} \T{0}${}+\T{1}{}$:\5
\&{if} ${}(\\{aux}.\|h\V\\{aux}.\|l){}$\1\5
${}\\{aux}\K\\{ominus}(\\{aux},\39\\{zz});{}$\2\6
\4\\{negate\_q}:\5
\&{if} ${}(\\{aux}.\|h\V\\{aux}.\|l){}$\1\5
\&{return} \\{ominus}${}(\\{neg\_one},\39\|q);{}$\2\6
\&{else}\1\5
\&{return} \\{ominus}${}(\\{zero\_octa},\39\|q);{}$\2\6
\4${}\}{}$\2\6
\4${}\}{}$\2\par
\fi
 
\N{1}{25}Bit fiddling. The bitwise operators of \MMIX\ are fairly easy to
implement directly, but three of them occur often enough to deserve
packaging as subroutines.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{oand}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{oand}(\|y,\39\|z{}$)\C{ compute $y\land z$ }\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\5
\1\&{octa} \|x;\7
${}\|x.\|h\K\|y.\|h\AND\|z.\|h{}$;\5
${}\|x.\|l\K\|y.\|l\AND\|z.\|l;{}$\6
\&{return} \|x;\6
\4${}\}{}$\2\7
\&{octa} \\{oandn}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{oandn}(\|y,\39\|z{}$)\C{ compute $y\land\bar z$ }\1\1%
\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\5
\1\&{octa} \|x;\7
${}\|x.\|h\K\|y.\|h\AND\CM\|z.\|h{}$;\5
${}\|x.\|l\K\|y.\|l\AND\CM\|z.\|l;{}$\6
\&{return} \|x;\6
\4${}\}{}$\2\7
\&{octa} \\{oxor}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{oxor}(\|y,\39\|z{}$)\C{ compute $y\oplus z$ }\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\5
\1\&{octa} \|x;\7
${}\|x.\|h\K\|y.\|h\XOR\|z.\|h{}$;\5
${}\|x.\|l\K\|y.\|l\XOR\|z.\|l;{}$\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{26}Here's a fun way to count the number of bits in a tetrabyte.
[This classical trick is called the ``Gillies--Miller method
for sideways addition'' in {\sl The Preparation of Programs
for an Electronic Digital Computer\/} by Wilkes, Wheeler, and
Gill, second edition (Reading, Mass.:\ Addison--Wesley, 1957),
191--193. Some of the tricks used here were suggested by
Balbir Singh, Peter Rossmanith, and Stefan Schwoon.]
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{int} \\{count\_bits}\,\,\.{ARGS}((\&{tetra}));\5
\hbox{}\6{}\&{int} \\{count\_bits}(\|x)\1\1\6
\&{tetra} \|x;\2\2\6
${}\{{}$\1\6
\&{register} \&{int} \\{xx}${}\K\|x;{}$\7
${}\\{xx}\K\\{xx}-((\\{xx}\GG\T{1})\AND\T{\^55555555});{}$\6
${}\\{xx}\K(\\{xx}\AND\T{\^33333333})+((\\{xx}\GG\T{2})\AND\T{\^33333333});{}$\6
${}\\{xx}\K(\\{xx}+(\\{xx}\GG\T{4}))\AND\T{\^0f0f0f0f};{}$\6
${}\\{xx}\K\\{xx}+(\\{xx}\GG\T{8});{}$\6
\&{return} ${}(\\{xx}+(\\{xx}\GG\T{16}))\AND\T{\^ff};{}$\6
\4${}\}{}$\2\par
\fi
 
\M{27}To compute the nonnegative byte differences of two given tetrabytes,
we can carry out the following 20-step branchless computation:
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{tetra} \\{byte\_diff}\,\,${}\.{ARGS}((\&{tetra},\39\&{tetra})){}$;\5
\hbox{}\6{}\&{tetra} ${}\\{byte\_diff}(\|y,\39\|z){}$\1\1\6
\&{tetra} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{register} \&{tetra} \|d${}\K(\|y\AND\T{\^00ff00ff})+\T{\^01000100}-(\|z\AND%
\T{\^00ff00ff});{}$\6
\&{register} \&{tetra} \|m${}\K\|d\AND\T{\^01000100};{}$\6
\&{register} \&{tetra} \|x${}\K\|d\AND(\|m-(\|m\GG\T{8}));{}$\7
${}\|d\K((\|y\GG\T{8})\AND\T{\^00ff00ff})+\T{\^01000100}-((\|z\GG\T{8})\AND\T{%
\^00ff00ff});{}$\6
${}\|m\K\|d\AND\T{\^01000100};{}$\6
\&{return} \|x${}+((\|d\AND(\|m-(\|m\GG\T{8})))\LL\T{8});{}$\6
\4${}\}{}$\2\par
\fi
 
\M{28}To compute the nonnegative wyde differences of two tetrabytes,
another trick leads to a 15-step branchless computation.
(Research problem: Can \PB{\\{count\_bits}}, \PB{\\{byte\_diff}}, or \PB{%
\\{wyde\_diff}} be done
with fewer operations?)
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{tetra} \\{wyde\_diff}\,\,${}\.{ARGS}((\&{tetra},\39\&{tetra})){}$;\5
\hbox{}\6{}\&{tetra} ${}\\{wyde\_diff}(\|y,\39\|z){}$\1\1\6
\&{tetra} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{register} \&{tetra} \|a${}\K((\|y\GG\T{16})-(\|z\GG\T{16}))\AND\T{%
\^10000};{}$\6
\&{register} \&{tetra} \|b${}\K((\|y\AND\T{\^ffff})-(\|z\AND\T{\^ffff}))\AND\T{%
\^10000};{}$\7
\&{return} \|y${}-(\|z\XOR((\|y\XOR\|z)\AND(\|b-\|a-(\|b\GG\T{16}))));{}$\6
\4${}\}{}$\2\par
\fi
 
\M{29}The last bitwise subroutine we need is the most interesting:
It implements \MMIX's \.{MOR} and \.{MXOR} operations.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{bool\_mult}\,\,${}\.{ARGS}((\&{octa},\39\&{octa},\39\&{bool})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{bool\_mult}(\|y,\39\|z,\39\\{xor}){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\C{ the operands }\6
\&{bool} \\{xor};\C{ do we do xor instead of or? }\2\2\6
${}\{{}$\1\6
\&{octa} \|o${},{}$ \|x;\6
\&{register} \&{tetra} \|a${},{}$ \|b${},{}$ \|c;\6
\&{register} \&{int} \|k;\7
\&{for} ${}(\|k\K\T{0},\39\|o\K\|y,\39\|x\K\\{zero\_octa};{}$ ${}\|o.\|h\V\|o.%
\|l;{}$ ${}\|k\PP,\39\|o\K\\{shift\_right}(\|o,\39\T{8},\39\T{1})){}$\1\6
\&{if} ${}(\|o.\|l\AND\T{\^ff}){}$\5
${}\{{}$\1\6
${}\|a\K((\|z.\|h\GG\|k)\AND\T{\^01010101})*\T{\^ff};{}$\6
${}\|b\K((\|z.\|l\GG\|k)\AND\T{\^01010101})*\T{\^ff};{}$\6
${}\|c\K(\|o.\|l\AND\T{\^ff})*\T{\^01010101};{}$\6
\&{if} (\\{xor})\1\5
${}\|x.\|h\MRL{{\XOR}{\K}}\|a\AND\|c,\39\|x.\|l\MRL{{\XOR}{\K}}\|b\AND\|c;{}$\2%
\6
\&{else}\1\5
${}\|x.\|h\MRL{{\OR}{\K}}\|a\AND\|c,\39\|x.\|l\MRL{{\OR}{\K}}\|b\AND\|c;{}$\2\6
\4${}\}{}$\2\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\N{1}{30}Floating point packing and unpacking. Standard IEEE floating binary
numbers pack a sign, exponent, and fraction into a tetrabyte
or octabyte. In this section we consider basic subroutines that
convert between IEEE format and the separate unpacked components.
 
\Y\B\4\D$\.{ROUND\_OFF}$ \5
\T{1}\par
\B\4\D$\.{ROUND\_UP}$ \5
\T{2}\par
\B\4\D$\.{ROUND\_DOWN}$ \5
\T{3}\par
\B\4\D$\.{ROUND\_NEAR}$ \5
\T{4}\par
\Y\B\4\X4:Global variables\X${}\mathrel+\E{}$\6
\&{int} \\{cur\_round};\C{ the current rounding mode }\par
\fi
 
\M{31}The \PB{\\{fpack}} routine takes an octabyte $f$, a raw exponent~$e$,
and a sign~\PB{\|s}, and packs them
into the floating binary number that corresponds to
$\pm2^{e-1076}f$, using a given rounding mode.
The value of $f$ should satisfy $2^{54}\le f\le 2^{55}$.
 
Thus, for example, the floating binary number $+1.0=\Hex{3ff0000000000000}$
is obtained when $f=2^{54}$, $e=\Hex{3fe}$, and \PB{$\|s\K\.{'+'}$}.
The raw exponent~$e$ is usually one less than
the final exponent value; the leading bit of~$f$ is essentially added
to the exponent. (This trick works nicely for subnormal numbers, when
$e<0$, or in cases where the value of $f$ is rounded upwards to $2^{55}$.)
 
Exceptional events are noted by oring appropriate bits into
the global variable \PB{\\{exceptions}}. Special considerations apply to
underflow, which is not fully specified by Section 7.4 of the IEEE standard:
Implementations of the standard are free to choose between two definitions
of ``tininess'' and two definitions of ``accuracy loss.''
\MMIX\ determines tininess {\it after\/} rounding, hence a result with
$e<0$ is not necessarily tiny; \MMIX\ treats accuracy loss as equivalent
to inexactness. Thus, a result underflows if and only if
it is tiny and either (i)~it is inexact or (ii)~the underflow trap is enabled.
The \PB{\\{fpack}} routine sets \PB{\.{U\_BIT}} in \PB{\\{exceptions}} if and
only if the result is
tiny, \PB{\.{X\_BIT}} if and only if the result is inexact.
 
\Y\B\4\D$\.{X\_BIT}$ \5
$(\T{1}\LL\T{8}{}$)\C{ floating inexact }\par
\B\4\D$\.{Z\_BIT}$ \5
$(\T{1}\LL\T{9}{}$)\C{ floating division by zero }\par
\B\4\D$\.{U\_BIT}$ \5
$(\T{1}\LL\T{10}{}$)\C{ floating underflow }\par
\B\4\D$\.{O\_BIT}$ \5
$(\T{1}\LL\T{11}{}$)\C{ floating overflow }\par
\B\4\D$\.{I\_BIT}$ \5
$(\T{1}\LL\T{12}{}$)\C{ floating invalid operation }\par
\B\4\D$\.{W\_BIT}$ \5
$(\T{1}\LL\T{13}{}$)\C{ float-to-fix overflow }\par
\B\4\D$\.{V\_BIT}$ \5
$(\T{1}\LL\T{14}{}$)\C{ integer overflow }\par
\B\4\D$\.{D\_BIT}$ \5
$(\T{1}\LL\T{15}{}$)\C{ integer divide check }\par
\B\4\D$\.{E\_BIT}$ \5
$(\T{1}\LL\T{18}{}$)\C{ external (dynamic) trap bit }\par
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{fpack}\,\,${}\.{ARGS}((\&{octa},\39\&{int},\39\&{char},\39%
\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{fpack}(\|f,\39\|e,\39\|s,\39\|r){}$\1\1\6
\&{octa} \|f;\C{ the normalized fraction part }\6
\&{int} \|e;\C{ the raw exponent }\6
\&{char} \|s;\C{ the sign }\6
\&{int} \|r;\C{ the rounding mode }\2\2\6
${}\{{}$\1\6
\&{octa} \|o;\7
\&{if} ${}(\|e>\T{\^7fd}){}$\1\5
${}\|e\K\T{\^7ff},\39\|o\K\\{zero\_octa};{}$\2\6
\&{else}\5
${}\{{}$\1\6
\&{if} ${}(\|e<\T{0}){}$\5
${}\{{}$\1\6
\&{if} ${}(\|e<{-}\T{54}){}$\1\5
${}\|o.\|h\K\T{0},\39\|o.\|l\K\T{1};{}$\2\6
\&{else}\5
${}\{{}$\5
\1\&{octa} \\{oo};\7
${}\|o\K\\{shift\_right}(\|f,\39{-}\|e,\39\T{1});{}$\6
${}\\{oo}\K\\{shift\_left}(\|o,\39{-}\|e);{}$\6
\&{if} ${}(\\{oo}.\|l\I\|f.\|l\V\\{oo}.\|h\I\|f.\|h){}$\1\5
${}\|o.\|l\MRL{{\OR}{\K}}\T{1}{}$;\C{ sticky bit }\2\6
\4${}\}{}$\2\6
${}\|e\K\T{0};{}$\6
\4${}\}{}$\5
\2\&{else}\1\5
${}\|o\K\|f;{}$\2\6
\4${}\}{}$\2\6
\X33:Round and return the result\X;\6
\4${}\}{}$\2\par
\fi
 
\M{32}\B\X4:Global variables\X${}\mathrel+\E{}$\6
\&{int} \\{exceptions};\C{ bits possibly destined for rA }\par
\fi
 
\M{33}Everything falls together so nicely here, it's almost too good to be
true!
 
\Y\B\4\X33:Round and return the result\X${}\E{}$\6
\&{if} ${}(\|o.\|l\AND\T{3}){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{X\_BIT};{}$\2\6
\&{switch} (\|r)\5
${}\{{}$\1\6
\4\&{case} \.{ROUND\_DOWN}:\5
\&{if} ${}(\|s\E\.{'-'}){}$\1\5
${}\|o\K\\{incr}(\|o,\39\T{3}){}$;\5
\2\&{break};\6
\4\&{case} \.{ROUND\_UP}:\5
\&{if} ${}(\|s\I\.{'-'}){}$\1\5
${}\|o\K\\{incr}(\|o,\39\T{3});{}$\2\6
\4\&{case} \.{ROUND\_OFF}:\5
\&{break};\6
\4\&{case} \.{ROUND\_NEAR}:\5
${}\|o\K\\{incr}(\|o,\39\|o.\|l\AND\T{4}\?\T{2}:\T{1}){}$;\5
\&{break};\6
\4${}\}{}$\2\6
${}\|o\K\\{shift\_right}(\|o,\39\T{2},\39\T{1});{}$\6
${}\|o.\|h\MRL{+{\K}}\|e\LL\T{20};{}$\6
\&{if} ${}(\|o.\|h\G\T{\^7ff00000}){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{O\_BIT}+\.{X\_BIT}{}$;\C{ overflow }\2\6
\&{else} \&{if} ${}(\|o.\|h<\T{\^100000}){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{U\_BIT}{}$;\C{ tininess }\2\6
\&{if} ${}(\|s\E\.{'-'}){}$\1\5
${}\|o.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|o;\par
\U31.\fi
 
\M{34}Similarly, \PB{\\{sfpack}} packs a short float, from inputs
having the same conventions as \PB{\\{fpack}}.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{tetra} \\{sfpack}\,\,${}\.{ARGS}((\&{octa},\39\&{int},\39\&{char},\39%
\&{int})){}$;\5
\hbox{}\6{}\&{tetra} ${}\\{sfpack}(\|f,\39\|e,\39\|s,\39\|r){}$\1\1\6
\&{octa} \|f;\C{ the fraction part }\6
\&{int} \|e;\C{ the raw exponent }\6
\&{char} \|s;\C{ the sign }\6
\&{int} \|r;\C{ the rounding mode }\2\2\6
${}\{{}$\1\6
\&{register} \&{tetra} \|o;\7
\&{if} ${}(\|e>\T{\^47d}){}$\1\5
${}\|e\K\T{\^47f},\39\|o\K\T{0};{}$\2\6
\&{else}\5
${}\{{}$\1\6
${}\|o\K\\{shift\_left}(\|f,\39\T{3}).\|h;{}$\6
\&{if} ${}(\|f.\|l\AND\T{\^1fffffff}){}$\1\5
${}\|o\MRL{{\OR}{\K}}\T{1};{}$\2\6
\&{if} ${}(\|e<\T{\^380}){}$\5
${}\{{}$\1\6
\&{if} ${}(\|e<\T{\^380}-\T{25}){}$\1\5
${}\|o\K\T{1};{}$\2\6
\&{else}\5
${}\{{}$\5
\1\&{register} \&{tetra} \\{o0}${},{}$ \\{oo};\7
${}\\{o0}\K\|o;{}$\6
${}\|o\K\|o\GG(\T{\^380}-\|e);{}$\6
${}\\{oo}\K\|o\LL(\T{\^380}-\|e);{}$\6
\&{if} ${}(\\{oo}\I\\{o0}){}$\1\5
${}\|o\MRL{{\OR}{\K}}\T{1}{}$;\C{ sticky bit }\2\6
\4${}\}{}$\2\6
${}\|e\K\T{\^380};{}$\6
\4${}\}{}$\2\6
\4${}\}{}$\2\6
\X35:Round and return the short result\X;\6
\4${}\}{}$\2\par
\fi
 
\M{35}\B\X35:Round and return the short result\X${}\E{}$\6
\&{if} ${}(\|o\AND\T{3}){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{X\_BIT};{}$\2\6
\&{switch} (\|r)\5
${}\{{}$\1\6
\4\&{case} \.{ROUND\_DOWN}:\5
\&{if} ${}(\|s\E\.{'-'}){}$\1\5
${}\|o\MRL{+{\K}}\T{3}{}$;\5
\2\&{break};\6
\4\&{case} \.{ROUND\_UP}:\5
\&{if} ${}(\|s\I\.{'-'}){}$\1\5
${}\|o\MRL{+{\K}}\T{3};{}$\2\6
\4\&{case} \.{ROUND\_OFF}:\5
\&{break};\6
\4\&{case} \.{ROUND\_NEAR}:\5
${}\|o\MRL{+{\K}}(\|o\AND\T{4}\?\T{2}:\T{1}){}$;\5
\&{break};\6
\4${}\}{}$\2\6
${}\|o\K\|o\GG\T{2};{}$\6
${}\|o\MRL{+{\K}}(\|e-\T{\^380})\LL\T{23};{}$\6
\&{if} ${}(\|o\G\T{\^7f800000}){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{O\_BIT}+\.{X\_BIT}{}$;\C{ overflow }\2\6
\&{else} \&{if} ${}(\|o<\T{\^100000}){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{U\_BIT}{}$;\C{ tininess }\2\6
\&{if} ${}(\|s\E\.{'-'}){}$\1\5
${}\|o\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|o;\par
\U34.\fi
 
\M{36}The \PB{\\{funpack}} routine is, roughly speaking, the opposite of \PB{%
\\{fpack}}.
It takes a given floating point number~$x$ and separates out its
fraction part~$f$, exponent~$e$, and sign~$s$. It clears \PB{\\{exceptions}}
to zero. It returns the type of value found: \PB{\\{zro}}, \PB{\\{num}}, \PB{%
\\{inf}},
or \PB{\\{nan}}. When it returns \PB{\\{num}},
it will have set $f$, $e$, and~$s$
to the values from which \PB{\\{fpack}} would produce the original number~$x$
without exceptions.
 
\Y\B\4\D$\\{zero\_exponent}$ \5
$({-}\T{1000}{}$)\C{ zero is assumed to have this exponent }\par
\Y\B\4\X36:Other type definitions\X${}\E{}$\6
\&{typedef} \&{enum} ${}\{{}$\1\6
${}\\{zro},\39\\{num},\39\\{inf},\39\\{nan}{}$\2\6
${}\}{}$\5
\&{ftype};\par
\A59.
\U1.\fi
 
\M{37}\B\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{ftype} \\{funpack}\,\,${}\.{ARGS}((\&{octa},\39{}$\&{octa} ${}{*},\39{}$%
\&{int} ${}{*},\39{}$\&{char} ${}{*})){}$;\5
\hbox{}\6{}\&{ftype} ${}\\{funpack}(\|x,\39\|f,\39\|e,\39\|s){}$\1\1\6
\&{octa} \|x;\C{ the given floating point value }\6
\&{octa} ${}{*}\|f{}$;\C{ address where the fraction part should be stored }\6
\&{int} ${}{*}\|e{}$;\C{ address where the exponent part should be stored }\6
\&{char} ${}{*}\|s{}$;\C{ address where the sign should be stored }\2\2\6
${}\{{}$\1\6
\&{register} \&{int} \\{ee};\7
${}\\{exceptions}\K\T{0};{}$\6
${}{*}\|s\K(\|x.\|h\AND\\{sign\_bit}\?\.{'-'}:\.{'+'});{}$\6
${}{*}\|f\K\\{shift\_left}(\|x,\39\T{2});{}$\6
${}\|f\MG\|h\MRL{\AND{\K}}\T{\^3fffff};{}$\6
${}\\{ee}\K(\|x.\|h\GG\T{20})\AND\T{\^7ff};{}$\6
\&{if} (\\{ee})\5
${}\{{}$\1\6
${}{*}\|e\K\\{ee}-\T{1};{}$\6
${}\|f\MG\|h\MRL{{\OR}{\K}}\T{\^400000};{}$\6
\&{return} ${}(\\{ee}<\T{\^7ff}\?\\{num}:\|f\MG\|h\E\T{\^400000}\W\R\|f\MG\|l\?%
\\{inf}:\\{nan});{}$\6
\4${}\}{}$\2\6
\&{if} ${}(\R\|x.\|l\W\R\|f\MG\|h){}$\5
${}\{{}$\1\6
${}{*}\|e\K\\{zero\_exponent}{}$;\5
\&{return} \\{zro};\6
\4${}\}{}$\2\6
\&{do}\5
${}\{{}$\5
\1${}\\{ee}\MM{}$;\5
${}{*}\|f\K\\{shift\_left}({*}\|f,\39\T{1}){}$;\5
${}\}{}$\2\5
\&{while} ${}(\R(\|f\MG\|h\AND\T{\^400000}));{}$\6
${}{*}\|e\K\\{ee}{}$;\5
\&{return} \\{num};\6
\4${}\}{}$\2\par
\fi
 
\M{38}\B\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{ftype} \\{sfunpack}\,\,${}\.{ARGS}((\&{tetra},\39{}$\&{octa} ${}{*},\39{}$%
\&{int} ${}{*},\39{}$\&{char} ${}{*})){}$;\5
\hbox{}\6{}\&{ftype} ${}\\{sfunpack}(\|x,\39\|f,\39\|e,\39\|s){}$\1\1\6
\&{tetra} \|x;\C{ the given floating point value }\6
\&{octa} ${}{*}\|f{}$;\C{ address where the fraction part should be stored }\6
\&{int} ${}{*}\|e{}$;\C{ address where the exponent part should be stored }\6
\&{char} ${}{*}\|s{}$;\C{ address where the sign should be stored }\2\2\6
${}\{{}$\1\6
\&{register} \&{int} \\{ee};\7
${}\\{exceptions}\K\T{0};{}$\6
${}{*}\|s\K(\|x\AND\\{sign\_bit}\?\.{'-'}:\.{'+'});{}$\6
${}\|f\MG\|h\K(\|x\GG\T{1})\AND\T{\^3fffff},\39\|f\MG\|l\K\|x\LL\T{31};{}$\6
${}\\{ee}\K(\|x\GG\T{23})\AND\T{\^ff};{}$\6
\&{if} (\\{ee})\5
${}\{{}$\1\6
${}{*}\|e\K\\{ee}+\T{\^380}-\T{1};{}$\6
${}\|f\MG\|h\MRL{{\OR}{\K}}\T{\^400000};{}$\6
\&{return} ${}(\\{ee}<\T{\^ff}\?\\{num}:(\|x\AND\T{\^7fffffff})\E\T{\^7f800000}%
\?\\{inf}:\\{nan});{}$\6
\4${}\}{}$\2\6
\&{if} ${}(\R(\|x\AND\T{\^7fffffff})){}$\5
${}\{{}$\1\6
${}{*}\|e\K\\{zero\_exponent}{}$;\5
\&{return} \\{zro};\6
\4${}\}{}$\2\6
\&{do}\5
${}\{{}$\5
\1${}\\{ee}\MM{}$;\5
${}{*}\|f\K\\{shift\_left}({*}\|f,\39\T{1}){}$;\5
${}\}{}$\2\5
\&{while} ${}(\R(\|f\MG\|h\AND\T{\^400000}));{}$\6
${}{*}\|e\K\\{ee}+\T{\^380}{}$;\5
\&{return} \\{num};\6
\4${}\}{}$\2\par
\fi
 
\M{39}Since \MMIX\ downplays 32-bit operations, it uses \PB{\\{sfpack}} and %
\PB{\\{sfunpack}}
only when loading and storing short floats, or when converting
from fixed point to floating point.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{load\_sf}\,\,\.{ARGS}((\&{tetra}));\5
\hbox{}\6{}\&{octa} \\{load\_sf}(\|z)\1\1\6
\&{tetra} \|z;\C{ 32 bits to be loaded into a 64-bit register }\2\2\6
${}\{{}$\1\6
\&{octa} \|f${},{}$ \|x;\5
\&{int} \|e;\5
\&{char} \|s;\5
\&{ftype} \|t;\7
${}\|t\K\\{sfunpack}(\|z,\39{\AND}\|f,\39{\AND}\|e,\39{\AND}\|s);{}$\6
\&{switch} (\|t)\5
${}\{{}$\1\6
\4\&{case} \\{zro}:\5
${}\|x\K\\{zero\_octa}{}$;\5
\&{break};\6
\4\&{case} \\{num}:\5
\&{return} \\{fpack}${}(\|f,\39\|e,\39\|s,\39\.{ROUND\_OFF});{}$\6
\4\&{case} \\{inf}:\5
${}\|x\K\\{inf\_octa}{}$;\5
\&{break};\6
\4\&{case} \\{nan}:\5
${}\|x\K\\{shift\_right}(\|f,\39\T{2},\39\T{1}){}$;\5
${}\|x.\|h\MRL{{\OR}{\K}}\T{\^7ff00000}{}$;\5
\&{break};\6
\4${}\}{}$\2\6
\&{if} ${}(\|s\E\.{'-'}){}$\1\5
${}\|x.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{40}\B\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{tetra} \\{store\_sf}\,\,\.{ARGS}((\&{octa}));\5
\hbox{}\6{}\&{tetra} \\{store\_sf}(\|x)\1\1\6
\&{octa} \|x;\C{ 64 bits to be loaded into a 32-bit word }\2\2\6
${}\{{}$\1\6
\&{octa} \|f;\5
\&{tetra} \|z;\5
\&{int} \|e;\5
\&{char} \|s;\5
\&{ftype} \|t;\7
${}\|t\K\\{funpack}(\|x,\39{\AND}\|f,\39{\AND}\|e,\39{\AND}\|s);{}$\6
\&{switch} (\|t)\5
${}\{{}$\1\6
\4\&{case} \\{zro}:\5
${}\|z\K\T{0}{}$;\5
\&{break};\6
\4\&{case} \\{num}:\5
\&{return} \\{sfpack}${}(\|f,\39\|e,\39\|s,\39\\{cur\_round});{}$\6
\4\&{case} \\{inf}:\5
${}\|z\K\T{\^7f800000}{}$;\5
\&{break};\6
\4\&{case} \\{nan}:\5
\&{if} ${}(\R(\|f.\|h\AND\T{\^200000})){}$\5
${}\{{}$\1\6
${}\|f.\|h\MRL{{\OR}{\K}}\T{\^200000}{}$;\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\C{ NaN was signaling }\6
\4${}\}{}$\2\6
${}\|z\K\T{\^7f800000}\OR(\|f.\|h\LL\T{1})\OR(\|f.\|l\GG\T{31}){}$;\5
\&{break};\6
\4${}\}{}$\2\6
\&{if} ${}(\|s\E\.{'-'}){}$\1\5
${}\|z\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|z;\6
\4${}\}{}$\2\par
\fi
 
\N{1}{41}Floating multiplication and division.
The hardest fixed point operations were multiplication and division;
but these two operations are the {\it easiest\/} to implement in floating point
arithmetic, once their fixed point counterparts are available.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{fmult}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{fmult}(\|y,\39\|z){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{ftype} \\{yt}${},{}$ \\{zt};\6
\&{int} \\{ye}${},{}$ \\{ze};\6
\&{char} \\{ys}${},{}$ \\{zs};\6
\&{octa} \|x${},{}$ \\{xf}${},{}$ \\{yf}${},{}$ \\{zf};\6
\&{register} \&{int} \\{xe};\6
\&{register} \&{char} \\{xs};\7
${}\\{yt}\K\\{funpack}(\|y,\39{\AND}\\{yf},\39{\AND}\\{ye},\39{\AND}\\{ys});{}$%
\6
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
${}\\{xs}\K\\{ys}+\\{zs}-\.{'+'}{}$;\C{ will be \PB{\.{'-'}} when the result is
negative }\6
\&{switch} ${}(\T{4}*\\{yt}+\\{zt}){}$\5
${}\{{}$\1\6
\hbox{\4}\X42:The usual NaN cases\X;\6
\4\&{case} \T{4}${}*\\{zro}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{zro}{}$:\5
${}\|x\K\\{zero\_octa}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{num}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{inf}{}$:\5
${}\|x\K\\{inf\_octa}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{zro}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{zro}{}$:\5
${}\|x\K\\{standard\_NaN};{}$\6
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{num}+\\{num}{}$:\5
\X43:Multiply nonzero numbers and \PB{\&{return}}\X;\6
\4${}\}{}$\2\6
\&{if} ${}(\\{xs}\E\.{'-'}){}$\1\5
${}\|x.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{42}\B\X42:The usual NaN cases\X${}\E{}$\6
\4\&{case} \T{4}${}*\\{nan}+\\{nan}{}$:\5
\&{if} ${}(\R(\|y.\|h\AND\T{\^80000})){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\C{ \PB{\|y} is signaling }\2\6
\4\&{case} \T{4}${}*\\{zro}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{nan}{}$:\6
\&{if} ${}(\R(\|z.\|h\AND\T{\^80000})){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT},\39\|z.\|h\MRL{{\OR}{\K}}\T{%
\^80000};{}$\2\6
\&{return} \|z;\6
\4\&{case} \T{4}${}*\\{nan}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{inf}{}$:\6
\&{if} ${}(\R(\|y.\|h\AND\T{\^80000})){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT},\39\|y.\|h\MRL{{\OR}{\K}}\T{%
\^80000};{}$\2\6
\&{return} \|y;\par
\Us41, 44, 46\ETs93.\fi
 
\M{43}\B\X43:Multiply nonzero numbers and \PB{\&{return}}\X${}\E{}$\6
$\\{xe}\K\\{ye}+\\{ze}-\T{\^3fd}{}$;\C{ the raw exponent }\6
${}\|x\K\\{omult}(\\{yf},\39\\{shift\_left}(\\{zf},\39\T{9}));{}$\6
\&{if} ${}(\\{aux}.\|h\G\T{\^400000}){}$\1\5
${}\\{xf}\K\\{aux};{}$\2\6
\&{else}\1\5
${}\\{xf}\K\\{shift\_left}(\\{aux},\39\T{1}),\39\\{xe}\MM;{}$\2\6
\&{if} ${}(\|x.\|h\V\|x.\|l){}$\1\5
${}\\{xf}.\|l\MRL{{\OR}{\K}}\T{1}{}$;\C{ adjust the sticky bit }\2\6
\&{return} \\{fpack}${}(\\{xf},\39\\{xe},\39\\{xs},\39\\{cur\_round}){}$;\par
\U41.\fi
 
\M{44}\B\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{fdivide}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{fdivide}(\|y,\39\|z){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{ftype} \\{yt}${},{}$ \\{zt};\6
\&{int} \\{ye}${},{}$ \\{ze};\6
\&{char} \\{ys}${},{}$ \\{zs};\6
\&{octa} \|x${},{}$ \\{xf}${},{}$ \\{yf}${},{}$ \\{zf};\6
\&{register} \&{int} \\{xe};\6
\&{register} \&{char} \\{xs};\7
${}\\{yt}\K\\{funpack}(\|y,\39{\AND}\\{yf},\39{\AND}\\{ye},\39{\AND}\\{ys});{}$%
\6
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
${}\\{xs}\K\\{ys}+\\{zs}-\.{'+'}{}$;\C{ will be \PB{\.{'-'}} when the result is
negative }\6
\&{switch} ${}(\T{4}*\\{yt}+\\{zt}){}$\5
${}\{{}$\1\6
\hbox{\4}\X42:The usual NaN cases\X;\6
\4\&{case} \T{4}${}*\\{zro}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{inf}{}$:\5
${}\|x\K\\{zero\_octa}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{num}+\\{zro}{}$:\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{Z\_BIT};{}$\6
\4\&{case} \T{4}${}*\\{inf}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{zro}{}$:\5
${}\|x\K\\{inf\_octa}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{zro}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{inf}{}$:\5
${}\|x\K\\{standard\_NaN};{}$\6
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{num}+\\{num}{}$:\5
\X45:Divide nonzero numbers and \PB{\&{return}}\X;\6
\4${}\}{}$\2\6
\&{if} ${}(\\{xs}\E\.{'-'}){}$\1\5
${}\|x.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{45}\B\X45:Divide nonzero numbers and \PB{\&{return}}\X${}\E{}$\6
$\\{xe}\K\\{ye}-\\{ze}+\T{\^3fd}{}$;\C{ the raw exponent }\6
${}\\{xf}\K\\{odiv}(\\{yf},\39\\{zero\_octa},\39\\{shift\_left}(\\{zf},\39%
\T{9}));{}$\6
\&{if} ${}(\\{xf}.\|h\G\T{\^800000}){}$\5
${}\{{}$\1\6
${}\\{aux}.\|l\MRL{{\OR}{\K}}\\{xf}.\|l\AND\T{1};{}$\6
${}\\{xf}\K\\{shift\_right}(\\{xf},\39\T{1},\39\T{1});{}$\6
${}\\{xe}\PP;{}$\6
\4${}\}{}$\2\6
\&{if} ${}(\\{aux}.\|h\V\\{aux}.\|l){}$\1\5
${}\\{xf}.\|l\MRL{{\OR}{\K}}\T{1}{}$;\C{ adjust the sticky bit }\2\6
\&{return} \\{fpack}${}(\\{xf},\39\\{xe},\39\\{xs},\39\\{cur\_round}){}$;\par
\U44.\fi
 
\N{1}{46}Floating addition and subtraction. Now for the bread-and-butter
operation, the sum of two floating point numbers.
It is not terribly difficult, but many cases need to be handled carefully.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{fplus}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{fplus}(\|y,\39\|z){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{ftype} \\{yt}${},{}$ \\{zt};\6
\&{int} \\{ye}${},{}$ \\{ze};\6
\&{char} \\{ys}${},{}$ \\{zs};\6
\&{octa} \|x${},{}$ \\{xf}${},{}$ \\{yf}${},{}$ \\{zf};\6
\&{register} \&{int} \\{xe}${},{}$ \|d;\6
\&{register} \&{char} \\{xs};\7
${}\\{yt}\K\\{funpack}(\|y,\39{\AND}\\{yf},\39{\AND}\\{ye},\39{\AND}\\{ys});{}$%
\6
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
\&{switch} ${}(\T{4}*\\{yt}+\\{zt}){}$\5
${}\{{}$\1\6
\hbox{\4}\X42:The usual NaN cases\X;\6
\4\&{case} \T{4}${}*\\{zro}+\\{num}{}$:\5
\&{return} \\{fpack}${}(\\{zf},\39\\{ze},\39\\{zs},\39\.{ROUND\_OFF}){}$;\5
\&{break};\C{ may underflow }\6
\4\&{case} \T{4}${}*\\{num}+\\{zro}{}$:\5
\&{return} \\{fpack}${}(\\{yf},\39\\{ye},\39\\{ys},\39\.{ROUND\_OFF}){}$;\5
\&{break};\C{ may underflow }\6
\4\&{case} \T{4}${}*\\{inf}+\\{inf}{}$:\5
\&{if} ${}(\\{ys}\I\\{zs}){}$\5
${}\{{}$\1\6
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\5
${}\|x\K\\{standard\_NaN}{}$;\5
${}\\{xs}\K\\{zs}{}$;\5
\&{break};\6
\4${}\}{}$\2\6
\4\&{case} \T{4}${}*\\{num}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{inf}{}$:\5
${}\|x\K\\{inf\_octa}{}$;\5
${}\\{xs}\K\\{zs}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{inf}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{zro}{}$:\5
${}\|x\K\\{inf\_octa}{}$;\5
${}\\{xs}\K\\{ys}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{num}+\\{num}{}$:\5
\&{if} ${}(\|y.\|h\I(\|z.\|h\XOR\T{\^80000000})\V\|y.\|l\I\|z.\|l){}$\1\5
\X47:Add nonzero numbers and \PB{\&{return}}\X;\2\6
\4\&{case} \T{4}${}*\\{zro}+\\{zro}{}$:\5
${}\|x\K\\{zero\_octa};{}$\6
${}\\{xs}\K(\\{ys}\E\\{zs}\?\\{ys}:\\{cur\_round}\E\.{ROUND\_DOWN}\?\.{'-'}:%
\.{'+'}){}$;\5
\&{break};\6
\4${}\}{}$\2\6
\&{if} ${}(\\{xs}\E\.{'-'}){}$\1\5
${}\|x.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{47}\B\X47:Add nonzero numbers and \PB{\&{return}}\X${}\E{}$\6
${}\{{}$\5
\1\&{octa} \|o${},{}$ \\{oo};\7
\&{if} ${}(\\{ye}<\\{ze}\V(\\{ye}\E\\{ze}\W(\\{yf}.\|h<\\{zf}.\|h\V(\\{yf}.\|h%
\E\\{zf}.\|h\W\\{yf}.\|l<\\{zf}.\|l)))){}$\1\5
\X48:Exchange \PB{\|y} with \PB{\|z}\X;\2\6
${}\|d\K\\{ye}-\\{ze};{}$\6
${}\\{xs}\K\\{ys},\39\\{xe}\K\\{ye};{}$\6
\&{if} (\|d)\1\5
\X49:Adjust for difference in exponents\X;\2\6
\&{if} ${}(\\{ys}\E\\{zs}){}$\5
${}\{{}$\1\6
${}\\{xf}\K\\{oplus}(\\{yf},\39\\{zf});{}$\6
\&{if} ${}(\\{xf}.\|h\G\T{\^800000}){}$\1\5
${}\\{xe}\PP,\39\|d\K\\{xf}.\|l\AND\T{1},\39\\{xf}\K\\{shift\_right}(\\{xf},\39%
\T{1},\39\T{1}),\39\\{xf}.\|l\MRL{{\OR}{\K}}\|d;{}$\2\6
\4${}\}{}$\5
\2\&{else}\5
${}\{{}$\1\6
${}\\{xf}\K\\{ominus}(\\{yf},\39\\{zf});{}$\6
\&{if} ${}(\\{xf}.\|h\G\T{\^800000}){}$\1\5
${}\\{xe}\PP,\39\|d\K\\{xf}.\|l\AND\T{1},\39\\{xf}\K\\{shift\_right}(\\{xf},\39%
\T{1},\39\T{1}),\39\\{xf}.\|l\MRL{{\OR}{\K}}\|d;{}$\2\6
\&{else}\5
\1\&{while} ${}(\\{xf}.\|h<\T{\^400000}){}$\1\5
${}\\{xe}\MM,\39\\{xf}\K\\{shift\_left}(\\{xf},\39\T{1});{}$\2\2\6
\4${}\}{}$\2\6
\&{return} \\{fpack}${}(\\{xf},\39\\{xe},\39\\{xs},\39\\{cur\_round});{}$\6
\4${}\}{}$\2\par
\U46.\fi
 
\M{48}\B\X48:Exchange \PB{\|y} with \PB{\|z}\X${}\E{}$\6
${}\{{}$\1\6
${}\|o\K\\{yf},\39\\{yf}\K\\{zf},\39\\{zf}\K\|o;{}$\6
${}\|d\K\\{ye},\39\\{ye}\K\\{ze},\39\\{ze}\K\|d;{}$\6
${}\|d\K\\{ys},\39\\{ys}\K\\{zs},\39\\{zs}\K\|d;{}$\6
\4${}\}{}$\2\par
\Us47\ET51.\fi
 
\M{49}Proper rounding requires two bits to the right of the fraction delivered
to~\PB{\\{fpack}}. The first is the true next bit of the result;
the other is a ``sticky'' bit, which is nonzero if any further bits of the
true result are nonzero. Sticky rounding to an integer takes
$x$ into the number $\lfloor x/2\rfloor+\lceil x/2\rceil$.
 
Some subtleties need to be observed here, in order to
prevent the sticky bit from being shifted left. If we did not
shift \PB{\\{yf}} left~1 before shifting \PB{\\{zf}} to the right, an incorrect
answer would be obtained in certain cases---for example, if
$\PB{\\{yf}}=2^{54}$, $\PB{\\{zf}}=2^{54}+2^{53}-1$, $d=52$.
 
\Y\B\4\X49:Adjust for difference in exponents\X${}\E{}$\6
${}\{{}$\1\6
\&{if} ${}(\|d\Z\T{2}){}$\1\5
${}\\{zf}\K\\{shift\_right}(\\{zf},\39\|d,\39\T{1}){}$;\C{ exact result }\2\6
\&{else} \&{if} ${}(\|d>\T{53}){}$\1\5
${}\\{zf}.\|h\K\T{0},\39\\{zf}.\|l\K\T{1}{}$;\C{ tricky but OK }\2\6
\&{else}\5
${}\{{}$\1\6
\&{if} ${}(\\{ys}\I\\{zs}){}$\1\5
${}\|d\MM,\39\\{xe}\MM,\39\\{yf}\K\\{shift\_left}(\\{yf},\39\T{1});{}$\2\6
${}\|o\K\\{zf};{}$\6
${}\\{zf}\K\\{shift\_right}(\|o,\39\|d,\39\T{1});{}$\6
${}\\{oo}\K\\{shift\_left}(\\{zf},\39\|d);{}$\6
\&{if} ${}(\\{oo}.\|l\I\|o.\|l\V\\{oo}.\|h\I\|o.\|h){}$\1\5
${}\\{zf}.\|l\MRL{{\OR}{\K}}\T{1};{}$\2\6
\4${}\}{}$\2\6
\4${}\}{}$\2\par
\U47.\fi
 
\M{50}The comparison of floating point numbers with respect to $\epsilon$
shares some of the characteristics of floating point addition/subtraction.
In some ways it is simpler, and in other ways it is more difficult;
we might as well deal with it now. % anyways
 
Subroutine \PB{$\\{fepscomp}(\|y,\|z,\|e,\|s)$} returns 2 if \PB{\|y}, \PB{%
\|z}, or \PB{\|e} is a NaN
or \PB{\|e} is negative. It returns 1 if \PB{$\|s\K\T{0}$} and $y\approx z\
(e)$ or if
\PB{$\|s\I\T{0}$} and $y\sim z\ (e)$,
as defined in Section~4.2.2 of {\sl Seminumerical Algorithms\/};
otherwise it returns~0.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{int} \\{fepscomp}\,\,${}\.{ARGS}((\&{octa},\39\&{octa},\39\&{octa},\39%
\&{int})){}$;\5
\hbox{}\6{}\&{int} ${}\\{fepscomp}(\|y,\39\|z,\39\|e,\39\|s){}$\1\1\6
\&{octa} \|y${},{}$ \|z${},{}$ \|e;\C{ the operands }\6
\&{int} \|s;\C{ test similarity? }\2\2\6
${}\{{}$\1\6
\&{octa} \\{yf}${},{}$ \\{zf}${},{}$ \\{ef}${},{}$ \|o${},{}$ \\{oo};\6
\&{int} \\{ye}${},{}$ \\{ze}${},{}$ \\{ee};\6
\&{char} \\{ys}${},{}$ \\{zs}${},{}$ \\{es};\6
\&{register} \&{int} \\{yt}${},{}$ \\{zt}${},{}$ \\{et}${},{}$ \|d;\7
${}\\{et}\K\\{funpack}(\|e,\39{\AND}\\{ef},\39{\AND}\\{ee},\39{\AND}\\{es});{}$%
\6
\&{if} ${}(\\{es}\E\.{'-'}){}$\1\5
\&{return} \T{2};\2\6
\&{switch} (\\{et})\5
${}\{{}$\1\6
\4\&{case} \\{nan}:\5
\&{return} \T{2};\6
\4\&{case} \\{inf}:\5
${}\\{ee}\K\T{10000};{}$\6
\4\&{case} \\{num}:\5
\&{case} \\{zro}:\5
\&{break};\6
\4${}\}{}$\2\6
${}\\{yt}\K\\{funpack}(\|y,\39{\AND}\\{yf},\39{\AND}\\{ye},\39{\AND}\\{ys});{}$%
\6
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
\&{switch} ${}(\T{4}*\\{yt}+\\{zt}){}$\5
${}\{{}$\1\6
\4\&{case} \T{4}${}*\\{nan}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{nan}{}$:\5
\&{return} \T{2};\6
\4\&{case} \T{4}${}*\\{inf}+\\{inf}{}$:\5
\&{return} ${}(\\{ys}\E\\{zs}\V\\{ee}\G\T{1023});{}$\6
\4\&{case} \T{4}${}*\\{inf}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{inf}{}$:\5
\&{return} ${}(\|s\W\\{ee}\G\T{1022});{}$\6
\4\&{case} \T{4}${}*\\{zro}+\\{zro}{}$:\5
\&{return} \T{1};\6
\4\&{case} \T{4}${}*\\{zro}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{zro}{}$:\5
\&{if} ${}(\R\|s){}$\1\5
\&{return} \T{0};\2\6
\4\&{case} \T{4}${}*\\{num}+\\{num}{}$:\5
\&{break};\6
\4${}\}{}$\2\6
\X51:Compare two numbers with respect to epsilon and \PB{\&{return}}\X;\6
\4${}\}{}$\2\par
\fi
 
\M{51}The relation $y\approx z\ (\epsilon)$ reduces to
$y\sim z\ (\epsilon/2^d)$, if $d$~is the difference between the
larger and smaller exponents of $y$ and~$z$.
 
\Y\B\4\X51:Compare two numbers with respect to epsilon and \PB{\&{return}}\X${}%
\E{}$\6
\X52:Unsubnormalize \PB{\|y} and \PB{\|z}, if they are subnormal\X;\6
\&{if} ${}(\\{ye}<\\{ze}\V(\\{ye}\E\\{ze}\W(\\{yf}.\|h<\\{zf}.\|h\V(\\{yf}.\|h%
\E\\{zf}.\|h\W\\{yf}.\|l<\\{zf}.\|l)))){}$\1\5
\X48:Exchange \PB{\|y} with \PB{\|z}\X;\2\6
\&{if} ${}(\\{ze}\E\\{zero\_exponent}){}$\1\5
${}\\{ze}\K\\{ye};{}$\2\6
${}\|d\K\\{ye}-\\{ze};{}$\6
\&{if} ${}(\R\|s){}$\1\5
${}\\{ee}\MRL{-{\K}}\|d;{}$\2\6
\&{if} ${}(\\{ee}\G\T{1023}){}$\1\5
\&{return} \T{1};\C{ if $\epsilon\ge2$, $z\in N_\epsilon(y)$ }\2\6
\X53:Compute the difference of fraction parts, \PB{\|o}\X;\6
\&{if} ${}(\R\|o.\|h\W\R\|o.\|l){}$\1\5
\&{return} \T{1};\2\6
\&{if} ${}(\\{ee}<\T{968}){}$\1\5
\&{return} \T{0};\C{ if $y\ne z$ and $\epsilon<2^{-54}$, $y\not\sim z$ }\2\6
\&{if} ${}(\\{ee}\G\T{1021}){}$\1\5
${}\\{ef}\K\\{shift\_left}(\\{ef},\39\\{ee}-\T{1021});{}$\2\6
\&{else}\1\5
${}\\{ef}\K\\{shift\_right}(\\{ef},\39\T{1021}-\\{ee},\39\T{1});{}$\2\6
\&{return} \|o${}.\|h<\\{ef}.\|h\V(\|o.\|h\E\\{ef}.\|h\W\|o.\|l\Z\\{ef}.%
\|l){}$;\par
\U50.\fi
 
\M{52}\B\X52:Unsubnormalize \PB{\|y} and \PB{\|z}, if they are subnormal\X${}%
\E{}$\6
\&{if} ${}(\\{ye}<\T{0}\W\\{yt}\I\\{zro}){}$\1\5
${}\\{yf}\K\\{shift\_left}(\|y,\39\T{2}),\39\\{ye}\K\T{0};{}$\2\6
\&{if} ${}(\\{ze}<\T{0}\W\\{zt}\I\\{zro}){}$\1\5
${}\\{zf}\K\\{shift\_left}(\|z,\39\T{2}),\39\\{ze}\K\T{0}{}$;\2\par
\U51.\fi
 
\M{53}At this point $y\sim z$ if and only if
$$\PB{\\{yf}}+(-1)^{[ys=zs]}\PB{\\{zf}}/2^d\le 2^{ee-1021}\PB{\\{ef}}=2^{55}%
\epsilon.$$
We need to evaluate this relation without overstepping the bounds of
our simulated 64-bit registers.
 
When $d>2$, the difference of fraction parts might not fit exactly
in an octabyte;
in that case the numbers are not similar unless $\epsilon>3/8$,
and we replace the difference by the ceiling of the
true result. When $\epsilon<1/8$, our program essentially replaces
$2^{55}\epsilon$ by $\lfloor2^{55}\epsilon\rfloor$. These
truncations are not needed simultaneously. Therefore the logic
is justified by the facts that, if $n$ is an integer, we have
$x\le n$ if and only if $\lceil x\rceil\le n$;
$n\le x$ if and only if $n\le\lfloor x\rfloor$. (Notice that the
concept of ``sticky bit'' is {\it not\/} appropriate here.)
 
\Y\B\4\X53:Compute the difference of fraction parts, \PB{\|o}\X${}\E{}$\6
\&{if} ${}(\|d>\T{54}){}$\1\5
${}\|o\K\\{zero\_octa},\39\\{oo}\K\\{zf};{}$\2\6
\&{else}\1\5
${}\|o\K\\{shift\_right}(\\{zf},\39\|d,\39\T{1}),\39\\{oo}\K\\{shift\_left}(%
\|o,\39\|d);{}$\2\6
\&{if} ${}(\\{oo}.\|h\I\\{zf}.\|h\V\\{oo}.\|l\I\\{zf}.\|l){}$\5
${}\{{}$\C{ truncated result, hence $d>2$ }\1\6
\&{if} ${}(\\{ee}<\T{1020}){}$\1\5
\&{return} \T{0};\C{ difference is too large for similarity }\2\6
${}\|o\K\\{incr}(\|o,\39\\{ys}\E\\{zs}\?\T{0}:\T{1}){}$;\C{ adjust for ceiling
}\6
\4${}\}{}$\2\6
${}\|o\K(\\{ys}\E\\{zs}\?\\{ominus}(\\{yf},\39\|o):\\{oplus}(\\{yf},\39%
\|o)){}$;\par
\U51.\fi
 
\N{1}{54}Floating point output conversion.
The \PB{\\{print\_float}} routine converts an octabyte to a floating decimal
representation that will be input as precisely the same value.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{static} \&{void} \\{bignum\_times\_ten}\,\,${}\.{ARGS}((\\{bignum}*));{}$\6
\&{static} \&{void} \\{bignum\_dec}\,\,${}\.{ARGS}((\\{bignum}*,\\{bignum}*,%
\&{tetra}));{}$\6
\&{static} \&{int} \\{bignum\_compare}\,\,${}\.{ARGS}((\\{bignum}*,%
\\{bignum}*));{}$\6
\&{void} \\{print\_float}\,\,\.{ARGS}((\&{octa}));\5
\hbox{}\6{}\&{void} \\{print\_float}(\|x)\1\1\6
\&{octa} \|x;\2\2\6
${}\{{}$\1\6
\X56:Local variables for \PB{\\{print\_float}}\X;\6
\&{if} ${}(\|x.\|h\AND\\{sign\_bit}){}$\1\5
\\{printf}(\.{"-"});\2\6
\X55:Extract the exponent \PB{\|e} and determine the fraction interval $[f\dts
g]$ or $(f\dts g)$\X;\6
\X63:Store $f$ and $g$ as multiprecise integers\X;\6
\X64:Compute the significant digits \PB{\|s} and decimal exponent \PB{\|e}\X;\6
\X67:Print the significant digits with proper context\X;\6
\4${}\}{}$\2\par
\fi
 
\M{55}One way to visualize the problem being solved here is to consider
the vastly simpler case in which there are only 2-bit exponents
and 2-bit fractions. Then the sixteen possible 4-bit combinations
have the following interpretations:
$$\def\\{\;\dts\;}
\vbox{\halign{#\qquad&$#$\hfil\cr
0000&[0\\0.125]\cr
0001&(0.125\\0.375)\cr
0010&[0.375\\0.625]\cr
0011&(0.625\\0.875)\cr
0100&[0.875\\1.125]\cr
0101&(1.125\\1.375)\cr
0110&[1.375\\1.625]\cr
0111&(1.625\\1.875)\cr
1000&[1.875\\2.25]\cr
1001&(2.25\\2.75)\cr
1010&[2.75\\3.25]\cr
1011&(3.25\\3.75)\cr
1100&[3.75\\\infty]\cr
1101&\rm NaN(0\\0.375)\cr
1110&\rm NaN[0.375\\0.625]\cr
1111&\rm NaN(0.625\\1)\cr}}$$
Notice that the interval is closed, $[f\dts g]$, when the fraction part
is even; it is open, $(f\dts g)$, when the fraction part is odd.
The printed outputs for these sixteen values, if we actually were
dealing with such short exponents and fractions, would be
\.{0.}, \.{.2}, \.{.5}, \.{.7}, \.{1.}, \.{1.2}, \.{1.5}, \.{1.7},
\.{2.}, \.{2.5}, \.{3.}, \.{3.5}, \.{Inf}, \.{NaN.2}, \.{NaN}, \.{NaN.8},
respectively.
 
\Y\B\4\X55:Extract the exponent \PB{\|e} and determine the fraction interval
$[f\dts g]$ or $(f\dts g)$\X${}\E{}$\6
$\|f\K\\{shift\_left}(\|x,\39\T{1});{}$\6
${}\|e\K\|f.\|h\GG\T{21};{}$\6
${}\|f.\|h\MRL{\AND{\K}}\T{\^1fffff};{}$\6
\&{if} ${}(\R\|f.\|h\W\R\|f.\|l){}$\1\5
\X57:Handle the special case when the fraction part is zero\X\2\6
\&{else}\5
${}\{{}$\1\6
${}\|g\K\\{incr}(\|f,\39\T{1});{}$\6
${}\|f\K\\{incr}(\|f,\39{-}\T{1});{}$\6
\&{if} ${}(\R\|e){}$\1\5
${}\|e\K\T{1}{}$;\C{ subnormal }\2\6
\&{else} \&{if} ${}(\|e\E\T{\^7ff}){}$\5
${}\{{}$\1\6
\\{printf}(\.{"NaN"});\6
\&{if} ${}(\|g.\|h\E\T{\^100000}\W\|g.\|l\E\T{1}){}$\1\5
\&{return};\C{ the ``standard'' NaN }\2\6
${}\|e\K\T{\^3ff}{}$;\C{ extreme NaNs come out OK even without adjusting \PB{%
\|f} or \PB{\|g} }\6
\4${}\}{}$\5
\2\&{else}\1\5
${}\|f.\|h\MRL{{\OR}{\K}}\T{\^200000},\39\|g.\|h\MRL{{\OR}{\K}}\T{\^200000};{}$%
\2\6
\4${}\}{}$\2\par
\U54.\fi
 
\M{56}\B\X56:Local variables for \PB{\\{print\_float}}\X${}\E{}$\6
\&{octa} \|f${},{}$ \|g;\C{ lower and upper bounds on the fraction part }\6
\&{register} \&{int} \|e;\C{ exponent part }\6
\&{register} \&{int} \|j${},{}$ \|k;\C{ all purpose indices }\par
\A66.
\U54.\fi
 
\M{57}The transition points between exponents correspond to powers of~2. At
such points the interval extends only half as far to the left of that
power of~2 as it does to the right. For example, in the 4-bit minifloat numbers
considered above, case 1000 corresponds to the interval $[1.875\;\dts\;2.25]$.
 
\Y\B\4\X57:Handle the special case when the fraction part is zero\X${}\E{}$\6
${}\{{}$\1\6
\&{if} ${}(\R\|e){}$\5
${}\{{}$\1\6
\\{printf}(\.{"0."});\5
\&{return};\6
\4${}\}{}$\2\6
\&{if} ${}(\|e\E\T{\^7ff}){}$\5
${}\{{}$\1\6
\\{printf}(\.{"Inf"});\5
\&{return};\6
\4${}\}{}$\2\6
${}\|e\MM;{}$\6
${}\|f.\|h\K\T{\^3fffff},\39\|f.\|l\K\T{\^ffffffff};{}$\6
${}\|g.\|h\K\T{\^400000},\39\|g.\|l\K\T{2};{}$\6
\4${}\}{}$\2\par
\U55.\fi
 
\M{58}We want to find the ``simplest'' value in the interval corresponding
to the given number, in the sense that it has fewest significant
digits when expressed in decimal notation. Thus, for example,
if the floating point number can be described by a relatively
short string such as `\.{.1}' or `\.{37e100}', we want to discover that
representation.
 
The basic idea is to generate the decimal representations of the
two endpoints of the interval, outputting the leading digits where
both endpoints agree, then making a final decision at the first place where
they disagree.
 
The ``simplest'' value is not always unique. For example, in the
case of 4-bit minifloat numbers we could represent the bit pattern 0001 as
either \.{.2} or \.{.3}, and we could represent 1001 in five equally short
ways: \.{2.3} or \.{2.4} or \.{2.5} or \.{2.6} or \.{2.7}. The
algorithm below tries to choose the middle possibility in such cases.
 
[A solution to the analogous problem for fixed-point representations,
without the additional complication of round-to-even, was used by
the author in the program for \TeX; see {\sl Beauty is Our Business\/}
(Springer, 1990), 233--242.]
 
Suppose we are given two fractions $f$ and $g$, where $0\le f<g<1$, and
we want to compute the shortest decimal in the closed interval $[f\dts g]$.
If $f=0$, we are done. Otherwise let $10f=d+f'$ and $10g=e+g'$, where
$0\le f'<1$ and $0\le g'<1$. If $d<e$, we can terminate by outputting
any of the digits $d+1$, \dots,~$e$; otherwise we output the
common digit $d=e$, and repeat the process on the fractions $0\le f'<g'<1$.
A similar procedure works with respect to the open interval $(f\dts g)$.
 
\fi
 
\M{59}The program below carries out the stated algorithm by using
multiprecision
arithmetic on 77-place integers with 28 bits each. This choice
facilitates multiplication by~10, and allows us to deal with the whole range of
floating binary numbers using fixed point arithmetic. We keep track of
the leading and trailing digit positions so that trivial operations on
zeros are avoided.
 
If \PB{\|f} points to a \&{bignum}, its radix-$2^{28}$ digits are
\PB{$\|f\MG\\{dat}[\T{0}]$} through \PB{$\|f\MG\\{dat}[\T{76}]$}, from most
significant to least significant.
We assume that all digit positions are zero unless they lie in the
subarray between indices \PB{$\|f\MG\|a$} and \PB{$\|f\MG\|b$}, inclusive.
Furthermore, both \PB{$\|f\MG\\{dat}[\|f\MG\|a]$} and \PB{$\|f\MG\\{dat}[\|f\MG%
\|b]$} are nonzero,
unless \PB{$\|f\MG\|a\K\|f\MG\|b\K\\{bignum\_prec}-\T{1}$}.
 
The \&{bignum} data type can be used with any radix less than
$2^{32}$; we will use it later with radix~$10^9$. The \PB{\\{dat}} array
is made large enough to accommodate both applications.
 
\Y\B\4\D$\\{bignum\_prec}$ \5
\T{157}\C{ would be 77 if we cared only about \PB{\\{print\_float}} }\par
\Y\B\4\X36:Other type definitions\X${}\mathrel+\E{}$\6
\&{typedef} \&{struct} ${}\{{}$\1\6
\&{int} \|a;\C{ index of the most significant digit }\6
\&{int} \|b;\C{ index of the least significant digit; must be $\ge a$ }\6
\&{tetra} \\{dat}[\\{bignum\_prec}];\C{ the digits; undefined except between %
\PB{\|a} and \PB{\|b} }\2\6
${}\}{}$ \&{bignum};\par
\fi
 
\M{60}Here, for example, is how we go from $f$ to $10f$, assuming that
overflow will not occur and that the radix is $2^{28}$:
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{static} \&{void} \\{bignum\_times\_ten}(\|f)\1\1\6
\&{bignum} ${}{*}\|f;\2\2{}$\6
${}\{{}$\1\6
\&{register} \&{tetra} ${}{*}\|p,{}$ ${}{*}\|q;{}$\6
\&{register} \&{tetra} \|x${},{}$ \\{carry};\7
\&{for} ${}(\|p\K{\AND}\|f\MG\\{dat}[\|f\MG\|b],\39\|q\K{\AND}\|f\MG\\{dat}[\|f%
\MG\|a],\39\\{carry}\K\T{0};{}$ ${}\|p\G\|q;{}$ ${}\|p\MM){}$\5
${}\{{}$\1\6
${}\|x\K{*}\|p*\T{10}+\\{carry};{}$\6
${}{*}\|p\K\|x\AND\T{\^fffffff};{}$\6
${}\\{carry}\K\|x\GG\T{28};{}$\6
\4${}\}{}$\2\6
${}{*}\|p\K\\{carry};{}$\6
\&{if} (\\{carry})\1\5
${}\|f\MG\|a\MM;{}$\2\6
\&{if} ${}(\|f\MG\\{dat}[\|f\MG\|b]\E\T{0}\W\|f\MG\|b>\|f\MG\|a){}$\1\5
${}\|f\MG\|b\MM;{}$\2\6
\4${}\}{}$\2\par
\fi
 
\M{61}And here is how we test whether $f<g$, $f=g$, or $f>g$, using any
radix whatever:
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{static} \&{int} ${}\\{bignum\_compare}(\|f,\39\|g){}$\1\1\6
\&{bignum} ${}{*}\|f,{}$ ${}{*}\|g;\2\2{}$\6
${}\{{}$\1\6
\&{register} \&{tetra} ${}{*}\|p,{}$ ${}{*}\\{pp},{}$ ${}{*}\|q,{}$ ${}{*}%
\\{qq};{}$\7
\&{if} ${}(\|f\MG\|a\I\|g\MG\|a){}$\1\5
\&{return} \|f${}\MG\|a>\|g\MG\|a\?{-}\T{1}:\T{1};{}$\2\6
${}\\{pp}\K{\AND}\|f\MG\\{dat}[\|f\MG\|b],\39\\{qq}\K{\AND}\|g\MG\\{dat}[\|g\MG%
\|b];{}$\6
\&{for} ${}(\|p\K{\AND}\|f\MG\\{dat}[\|f\MG\|a],\39\|q\K{\AND}\|g\MG\\{dat}[\|g%
\MG\|a];{}$ ${}\|p\Z\\{pp};{}$ ${}\|p\PP,\39\|q\PP){}$\5
${}\{{}$\1\6
\&{if} ${}({*}\|p\I{*}\|q){}$\1\5
\&{return} ${}{*}\|p<{*}\|q\?{-}\T{1}:\T{1};{}$\2\6
\&{if} ${}(\|q\E\\{qq}){}$\1\5
\&{return} \|p${}<\\{pp};{}$\2\6
\4${}\}{}$\2\6
\&{return} ${}{-}\T{1};{}$\6
\4${}\}{}$\2\par
\fi
 
\M{62}The following subroutine subtracts $g$ from~$f$, assuming that
$f\ge g>0$ and using a given radix.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{static} \&{void} ${}\\{bignum\_dec}(\|f,\39\|g,\39\|r){}$\1\1\6
\&{bignum} ${}{*}\|f,{}$ ${}{*}\|g;{}$\6
\&{tetra} \|r;\C{ the radix }\2\2\6
${}\{{}$\1\6
\&{register} \&{tetra} ${}{*}\|p,{}$ ${}{*}\|q,{}$ ${}{*}\\{qq};{}$\6
\&{register} \&{int} \|x${},{}$ \\{borrow};\7
\&{while} ${}(\|g\MG\|b>\|f\MG\|b){}$\1\5
${}\|f\MG\\{dat}[\PP\|f\MG\|b]\K\T{0};{}$\2\6
${}\\{qq}\K{\AND}\|g\MG\\{dat}[\|g\MG\|a];{}$\6
\&{for} ${}(\|p\K{\AND}\|f\MG\\{dat}[\|g\MG\|b],\39\|q\K{\AND}\|g\MG\\{dat}[\|g%
\MG\|b],\39\\{borrow}\K\T{0};{}$ ${}\|q\G\\{qq};{}$ ${}\|p\MM,\39\|q\MM){}$\5
${}\{{}$\1\6
${}\|x\K{*}\|p-{*}\|q-\\{borrow};{}$\6
\&{if} ${}(\|x\G\T{0}){}$\1\5
${}\\{borrow}\K\T{0},\39{*}\|p\K\|x;{}$\2\6
\&{else}\1\5
${}\\{borrow}\K\T{1},\39{*}\|p\K\|x+\|r;{}$\2\6
\4${}\}{}$\2\6
\&{for} ( ; \\{borrow}; ${}\|p\MM){}$\1\6
\&{if} ${}({*}\|p){}$\1\5
${}\\{borrow}\K\T{0},\39{*}\|p\K{*}\|p-\T{1};{}$\2\6
\&{else}\1\5
${}{*}\|p\K\|r-\T{1};{}$\2\2\6
\&{while} ${}(\|f\MG\\{dat}[\|f\MG\|a]\E\T{0}){}$\5
${}\{{}$\1\6
\&{if} ${}(\|f\MG\|a\E\|f\MG\|b){}$\5
${}\{{}$\C{ the result is zero }\1\6
${}\|f\MG\|a\K\|f\MG\|b\K\\{bignum\_prec}-\T{1},\39\|f\MG\\{dat}[\\{bignum%
\_prec}-\T{1}]\K\T{0};{}$\6
\&{return};\6
\4${}\}{}$\2\6
${}\|f\MG\|a\PP;{}$\6
\4${}\}{}$\2\6
\&{while} ${}(\|f\MG\\{dat}[\|f\MG\|b]\E\T{0}){}$\1\5
${}\|f\MG\|b\MM;{}$\2\6
\4${}\}{}$\2\par
\fi
 
\M{63}Armed with these subroutines, we are ready to solve the problem.
The first task is to put the numbers into \&{bignum} form.
If the exponent is \PB{\|e}, the number destined for digit \PB{\\{dat}[\|k]}
will
consist of the rightmost 28 bits of the given fraction after it has
been shifted right $c-e-28k$ bits, for some constant~$c$.
We choose $c$ so that,
when $e$ has its maximum value \Hex{7ff}, the leading digit will
go into position \PB{\\{dat}[\T{1}]}, and so that when the number to be printed
is exactly~1 the integer part of~$g$ will also be exactly~1.
 
\Y\B\4\D$\\{magic\_offset}$ \5
\T{2112}\C{ the constant $c$ that makes it work }\par
\B\4\D$\\{origin}$ \5
\T{37}\C{ the radix point follows \PB{\\{dat}[\T{37}]} }\par
\Y\B\4\X63:Store $f$ and $g$ as multiprecise integers\X${}\E{}$\6
$\|k\K(\\{magic\_offset}-\|e)/\T{28};{}$\6
${}\ff.\\{dat}[\|k-\T{1}]\K\\{shift\_right}(\|f,\39\\{magic\_offset}+\T{28}-%
\|e-\T{28}*\|k,\39\T{1}).\|l\AND\T{\^fffffff};{}$\6
${}\\{gg}.\\{dat}[\|k-\T{1}]\K\\{shift\_right}(\|g,\39\\{magic\_offset}+\T{28}-%
\|e-\T{28}*\|k,\39\T{1}).\|l\AND\T{\^fffffff};{}$\6
${}\ff.\\{dat}[\|k]\K\\{shift\_right}(\|f,\39\\{magic\_offset}-\|e-\T{28}*\|k,%
\39\T{1}).\|l\AND\T{\^fffffff};{}$\6
${}\\{gg}.\\{dat}[\|k]\K\\{shift\_right}(\|g,\39\\{magic\_offset}-\|e-\T{28}*%
\|k,\39\T{1}).\|l\AND\T{\^fffffff};{}$\6
${}\ff.\\{dat}[\|k+\T{1}]\K\\{shift\_left}(\|f,\39\|e+\T{28}*\|k-(\\{magic%
\_offset}-\T{28})).\|l\AND\T{\^fffffff};{}$\6
${}\\{gg}.\\{dat}[\|k+\T{1}]\K\\{shift\_left}(\|g,\39\|e+\T{28}*\|k-(\\{magic%
\_offset}-\T{28})).\|l\AND\T{\^fffffff};{}$\6
${}\ff.\|a\K(\ff.\\{dat}[\|k-\T{1}]\?\|k-\T{1}:\|k);{}$\6
${}\ff.\|b\K(\ff.\\{dat}[\|k+\T{1}]\?\|k+\T{1}:\|k);{}$\6
${}\\{gg}.\|a\K(\\{gg}.\\{dat}[\|k-\T{1}]\?\|k-\T{1}:\|k);{}$\6
${}\\{gg}.\|b\K(\\{gg}.\\{dat}[\|k+\T{1}]\?\|k+\T{1}:\|k){}$;\par
\U54.\fi
 
\M{64}If $e$ is sufficiently small, the fractions $f$ and $g$ will be less
than~1,
and we can use the stated algorithm directly. Of course, if $e$ is
extremely small, a lot of leading zeros need to be lopped off; in the
worst case, we may have to multiply $f$ and~$g$ by~10 more than 300 times.
But hey, we don't need to do that extremely often, and computers are
pretty fast nowadays.
 
In the small-exponent case, the computation always terminates before
$f$ becomes zero, because the interval endpoints are fractions with
denominator $2^t$ for some $t>50$.
 
The invariant relations \PB{$\ff.\\{dat}[\ff.\|a]\I\T{0}$} and \PB{$\\{gg}.%
\\{dat}[\\{gg}.\|a]\I\T{0}$} are
not maintained by the computation here, when \PB{$\ff.\|a\K\\{origin}$} or %
\PB{$\\{gg}.\|a\K\\{origin}$}.
But no harm is done, because \PB{\\{bignum\_compare}} is not used.
 
\Y\B\4\X64:Compute the significant digits \PB{\|s} and decimal exponent \PB{%
\|e}\X${}\E{}$\6
\&{if} ${}(\|e>\T{\^401}){}$\1\5
\X65:Compute the significant digits in the large-exponent case\X\2\6
\&{else}\5
${}\{{}$\C{ if \PB{$\|e\Z\T{\^401}$} we have \PB{$\\{gg}.\|a\G\\{origin}$} and %
\PB{$\\{gg}.\\{dat}[\\{origin}]\Z\T{8}$} }\1\6
\&{if} ${}(\ff.\|a>\\{origin}){}$\1\5
${}\ff.\\{dat}[\\{origin}]\K\T{0};{}$\2\6
\&{for} ${}(\|e\K\T{1},\39\|p\K\|s;{}$ ${}\\{gg}.\|a>\\{origin}\V\ff.\\{dat}[%
\\{origin}]\E\\{gg}.\\{dat}[\\{origin}];{}$ \,)\5
${}\{{}$\1\6
\&{if} ${}(\\{gg}.\|a>\\{origin}){}$\1\5
${}\|e\MM;{}$\2\6
\&{else}\1\5
${}{*}\|p\PP\K\ff.\\{dat}[\\{origin}]+\.{'0'},\39\ff.\\{dat}[\\{origin}]\K%
\T{0},\39\\{gg}.\\{dat}[\\{origin}]\K\T{0};{}$\2\6
${}\\{bignum\_times\_ten}({\AND}\ff);{}$\6
${}\\{bignum\_times\_ten}({\AND}\\{gg});{}$\6
\4${}\}{}$\2\6
${}{*}\|p\PP\K((\ff.\\{dat}[\\{origin}]+\T{1}+\\{gg}.\\{dat}[\\{origin}])\GG%
\T{1})+\.{'0'}{}$;\C{ the middle digit }\6
\4${}\}{}$\2\6
${}{*}\|p\K\.{'\\0'}{}$;\C{ terminate the string \PB{\|s} }\par
\U54.\fi
 
\M{65}When \PB{\|e} is large, we use the stated algorithm by considering $f$
and
$g$ to be fractions whose denominator is a power of~10.
 
An interesting case arises when the number to be converted is
\Hex{44ada56a4b0835bf}, since the interval turns out to be
$$ (69999999999999991611392\ \ \dts\ \ 70000000000000000000000).$$
If this were a closed interval, we could simply give the answer
\.{7e22}; but the number \.{7e22} actually corresponds to
\Hex{44ada56a4b0835c0}
because of the round-to-even rule. Therefore the correct answer is, say,
\.{6.9999999999999995e22}. This example shows that we need a slightly
different strategy in the case of open intervals; we cannot simply
look at the first position in which the endpoints have different
decimal digits. Therefore we change the invariant relation to $0\le f<g\le 1$,
when open intervals are involved,
and we do not terminate the process when $f=0$ or $g=1$.
 
\Y\B\4\X65:Compute the significant digits in the large-exponent case\X${}\E{}$\6
${}\{{}$\5
\1\&{register} \&{int} \\{open}${}\K\|x.\|l\AND\T{1};{}$\7
${}\\{tt}.\\{dat}[\\{origin}]\K\T{10};{}$\6
${}\\{tt}.\|a\K\\{tt}.\|b\K\\{origin};{}$\6
\&{for} ${}(\|e\K\T{1};{}$ ${}\\{bignum\_compare}({\AND}\\{gg},\39{\AND}\\{tt})%
\G\\{open};{}$ ${}\|e\PP){}$\1\5
${}\\{bignum\_times\_ten}({\AND}\\{tt});{}$\2\6
${}\|p\K\|s;{}$\6
\&{while} (\T{1})\5
${}\{{}$\1\6
${}\\{bignum\_times\_ten}({\AND}\ff);{}$\6
${}\\{bignum\_times\_ten}({\AND}\\{gg});{}$\6
\&{for} ${}(\|j\K\.{'0'};{}$ ${}\\{bignum\_compare}({\AND}\ff,\39{\AND}\\{tt})%
\G\T{0};{}$ ${}\|j\PP){}$\1\5
${}\\{bignum\_dec}({\AND}\ff,\39{\AND}\\{tt},\39\T{\^10000000}),\39\\{bignum%
\_dec}({\AND}\\{gg},\39{\AND}\\{tt},\39\T{\^10000000});{}$\2\6
\&{if} ${}(\\{bignum\_compare}({\AND}\\{gg},\39{\AND}\\{tt})\G\\{open}){}$\1\5
\&{break};\2\6
${}{*}\|p\PP\K\|j;{}$\6
\&{if} ${}(\ff.\|a\E\\{bignum\_prec}-\T{1}\W\R\\{open}){}$\1\5
\&{goto} \\{done};\C{ $f=0$ in a closed interval }\2\6
\4${}\}{}$\2\6
\&{for} ${}(\|k\K\|j;{}$ ${}\\{bignum\_compare}({\AND}\\{gg},\39{\AND}\\{tt})\G%
\\{open};{}$ ${}\|k\PP){}$\1\5
${}\\{bignum\_dec}({\AND}\\{gg},\39{\AND}\\{tt},\39\T{\^10000000});{}$\2\6
${}{*}\|p\PP\K(\|j+\T{1}+\|k)\GG\T{1}{}$;\C{ the middle digit }\6
\4\\{done}:\5
;\6
\4${}\}{}$\2\par
\U64.\fi
 
\M{66}The length of string~\PB{\|s} will be at most 17. For if $f$ and $g$
agree to 17 places, we have $g/f<1+10^{-16}$; but the
ratio $g/f$ is always $\ge(1+2^{-52}+2^{-53})/(1+2^{-52}-2^{-53})
>1+2\times10^{-16}$.
 
\Y\B\4\X56:Local variables for \PB{\\{print\_float}}\X${}\mathrel+\E{}$\6
\&{bignum} ${}\ff,{}$ \\{gg};\C{ fractions or numerators of fractions }\6
\&{bignum} \\{tt};\C{ power of ten (used as the denominator) }\6
\&{char} \|s[\T{18}];\6
\&{register} \&{char} ${}{*}\|p{}$;\par
\fi
 
\M{67}At this point the significant digits are in string \PB{\|s}, and \PB{$%
\|s[\T{0}]\I\.{'0'}$}.
If we put a decimal point at the left of~\PB{\|s}, the result should
be multiplied by $10^e$.
 
We prefer the output `\.{300.}' to the form `\.{3e2}', and we prefer
`\.{.03}' to `\.{3e-2}'. In general, the output will use an
explicit exponent only if the alternative would take more than
18~characters.
 
\Y\B\4\X67:Print the significant digits with proper context\X${}\E{}$\6
\&{if} ${}(\|e>\T{17}\V\|e<{}$(\&{int}) \\{strlen}(\|s)${}-\T{17}){}$\1\5
${}\\{printf}(\.{"\%c\%s\%se\%d"},\39\|s[\T{0}],\39(\|s[\T{1}]\?\.{"."}:%
\.{""}),\39\|s+\T{1},\39\|e-\T{1});{}$\2\6
\&{else} \&{if} ${}(\|e<\T{0}){}$\1\5
${}\\{printf}(\.{".\%0*d\%s"},\39{-}\|e,\39\T{0},\39\|s);{}$\2\6
\&{else} \&{if} ${}(\\{strlen}(\|s)\G\|e){}$\1\5
${}\\{printf}(\.{"\%.*s.\%s"},\39\|e,\39\|s,\39\|s+\|e);{}$\2\6
\&{else}\1\5
${}\\{printf}(\.{"\%s\%0*d."},\39\|s,\39\|e-{}$(\&{int}) \\{strlen}(\|s)${},\39%
\T{0}){}$;\2\par
\U54.\fi
 
\N{1}{68}Floating point input conversion. Going the other way, we want to
be able to convert a given decimal number into its floating binary
equivalent. The following syntax is supported:
$$\vbox{\halign{$#$\hfil\cr
\<digit>\is\.0\mid\.1\mid\.2\mid\.3\mid\.4\mid
\.5\mid\.6\mid\.7\mid\.8\mid\.9\cr
\<digit string>\is\<digit>\mid\<digit string>\<digit>\cr
\<decimal string>\is\<digit string>\..\mid\..\<digit string>\mid
\<digit string>\..\<digit string>\cr
\<optional sign>\is\<empty>\mid\.+\mid\.-\cr
\<exponent>\is\.e\<optional sign>\<digit string>\cr
\<optional exponent>\is\<empty>\mid\<exponent>\cr
\<floating magnitude>\is\<digit string>\<exponent>\mid
\<decimal string>\<optional exponent>\mid\cr
\hskip12em \.{Inf}\mid\.{NaN}\mid\.{NaN.}\<digit string>\cr
\<floating constant>\is\<optional sign>\<floating magnitude>\cr
\<decimal constant>\is\<optional sign>\<digit string>\cr
}}$$
For example, `\.{-3.}' is the floating constant \Hex{c008000000000000}%
\thinspace;
`\.{1e3}' and `\.{1000}' are both equivalent to \Hex{408f400000000000}%
\thinspace;
`\.{NaN}' and `\.{+NaN.5}' are both equivalent to \Hex{7ff8000000000000}.
 
The \PB{\\{scan\_const}} routine looks at a given string and finds the
longest initial substring that matches the syntax of either \<decimal
constant> or \<floating constant>. It puts the corresponding value
into the global octabyte variable~\PB{\\{val}}; it also puts the position of
the first
unscanned character in the global pointer variable \PB{\\{next\_char}}.
It returns 1 if a floating constant was found, 0~if a decimal constant
was found, $-1$ if nothing was found. A decimal constant that doesn't
fit in an octabyte is computed modulo~$2^{64}$.
 
The value of \PB{\\{exceptions}} set by \PB{\\{scan\_const}} is not necessarily
correct.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{static} \&{void} \\{bignum\_double}\,\,\.{ARGS}((\&{bignum} ${}{*}));{}$\6
\&{int} \\{scan\_const}\,\,\.{ARGS}((\&{char} ${}{*})){}$;\5
\hbox{}\6{}\&{int} \\{scan\_const}(\|s)\1\1\6
\&{char} ${}{*}\|s;\2\2{}$\6
${}\{{}$\1\6
\X70:Local variables for \PB{\\{scan\_const}}\X;\6
${}\\{val}.\|h\K\\{val}.\|l\K\T{0};{}$\6
${}\|p\K\|s;{}$\6
\&{if} ${}({*}\|p\E\.{'+'}\V{*}\|p\E\.{'-'}){}$\1\5
${}\\{sign}\K{*}\|p\PP{}$;\5
\2\&{else}\1\5
${}\\{sign}\K\.{'+'};{}$\2\6
\&{if} ${}(\\{strncmp}(\|p,\39\.{"NaN"},\39\T{3})\E\T{0}){}$\1\5
${}\\{NaN}\K\\{true},\39\|p\MRL{+{\K}}\T{3};{}$\2\6
\&{else}\1\5
${}\\{NaN}\K\\{false};{}$\2\6
\&{if} ${}((\\{isdigit}({*}\|p)\W\R\\{NaN})\V({*}\|p\E\.{'.'}\W\\{isdigit}({*}(%
\|p+\T{1})))){}$\1\5
\X73:Scan a number and \PB{\&{return}}\X;\2\6
\&{if} (\\{NaN})\1\5
\X71:Return the standard NaN\X;\2\6
\&{if} ${}(\\{strncmp}(\|p,\39\.{"Inf"},\39\T{3})\E\T{0}){}$\1\5
\X72:Return infinity\X;\2\6
\4\\{no\_const\_found}:\5
${}\\{next\_char}\K\|s{}$;\5
\&{return} ${}{-}\T{1};{}$\6
\4${}\}{}$\2\par
\fi
 
\M{69}\B\X4:Global variables\X${}\mathrel+\E{}$\6
\&{octa} \\{val};\C{ value returned by \PB{\\{scan\_const}} }\6
\&{char} ${}{*}\\{next\_char}{}$;\C{ pointer returned by \PB{\\{scan\_const}} }%
\par
\fi
 
\M{70}\B\X70:Local variables for \PB{\\{scan\_const}}\X${}\E{}$\6
\&{register} \&{char} ${}{*}\|p,{}$ ${}{*}\|q{}$;\C{ for string manipulations }%
\6
\&{register} \&{bool} \\{NaN};\C{ are we processing a NaN? }\6
\&{int} \\{sign};\C{ \PB{\.{'+'}} or \PB{\.{'-'}} }\par
\As76\ET81.
\U68.\fi
 
\M{71}\B\X71:Return the standard NaN\X${}\E{}$\6
${}\{{}$\1\6
${}\\{next\_char}\K\|p;{}$\6
${}\\{val}.\|h\K\T{\^600000},\39\\{exp}\K\T{\^3fe};{}$\6
\&{goto} \\{packit};\6
\4${}\}{}$\2\par
\U68.\fi
 
\M{72}\B\X72:Return infinity\X${}\E{}$\6
${}\{{}$\1\6
${}\\{next\_char}\K\|p+\T{3};{}$\6
\&{goto} \\{make\_it\_infinite};\6
\4${}\}{}$\2\par
\U68.\fi
 
\M{73}We saw above that a string of at most 17 digits is enough to characterize
a floating point number, for purposes of output. But a much longer buffer
for digits is needed when we're doing input. For example, consider the
borderline quantity $(1+2^{-53})/2^{1022}$; its decimal expansion, when
written out exactly, is a number with more than 750 significant digits:
\.{2.2250738585...8125e-308}.
If {\it any one\/} of those digits is increased, or if
additional nonzero digits are added as in
\.{2.2250738585...81250000001e-308},
the rounded value is supposed to change from \Hex{0010000000000000}
to \Hex{0010000000000001}.
 
We assume here that the user prefers a perfectly correct answer to
a speedy almost-correct one, so we implement the most general case.
 
\Y\B\4\X73:Scan a number and \PB{\&{return}}\X${}\E{}$\6
${}\{{}$\1\6
\&{for} ${}(\|q\K\\{buf0},\39\\{dec\_pt}\K{}$(\&{char} ${}{*}){}$ \T{0}; ${}%
\\{isdigit}({*}\|p);{}$ ${}\|p\PP){}$\5
${}\{{}$\1\6
${}\\{val}\K\\{oplus}(\\{val},\39\\{shift\_left}(\\{val},\39\T{2})){}$;\C{
multiply by 5 }\6
${}\\{val}\K\\{incr}(\\{shift\_left}(\\{val},\39\T{1}),\39{*}\|p-\.{'0'});{}$\6
\&{if} ${}(\|q>\\{buf0}\V{*}\|p\I\.{'0'}){}$\1\6
\&{if} ${}(\|q<\\{buf\_max}){}$\1\5
${}{*}\|q\PP\K{*}\|p;{}$\2\6
\&{else} \&{if} ${}({*}(\|q-\T{1})\E\.{'0'}){}$\1\5
${}{*}(\|q-\T{1})\K{*}\|p;{}$\2\2\6
\4${}\}{}$\2\6
\&{if} (\\{NaN})\1\5
${}{*}\|q\PP\K\.{'1'};{}$\2\6
\&{if} ${}({*}\|p\E\.{'.'}){}$\1\5
\X74:Scan a fraction part\X;\2\6
${}\\{next\_char}\K\|p;{}$\6
\&{if} ${}({*}\|p\E\.{'e'}\W\R\\{NaN}){}$\1\5
\X77:Scan an exponent\X\2\6
\&{else}\1\5
${}\\{exp}\K\T{0};{}$\2\6
\&{if} (\\{dec\_pt})\1\5
\X78:Return a floating point constant\X;\2\6
\&{if} ${}(\\{sign}\E\.{'-'}){}$\1\5
${}\\{val}\K\\{ominus}(\\{zero\_octa},\39\\{val});{}$\2\6
\&{return} \T{0};\6
\4${}\}{}$\2\par
\U68.\fi
 
\M{74}\B\X74:Scan a fraction part\X${}\E{}$\6
${}\{{}$\1\6
${}\\{dec\_pt}\K\|q;{}$\6
${}\|p\PP;{}$\6
\&{for} ${}(\\{zeros}\K\T{0};{}$ ${}\\{isdigit}({*}\|p);{}$ ${}\|p\PP){}$\1\6
\&{if} ${}({*}\|p\E\.{'0'}\W\|q\E\\{buf0}){}$\1\5
${}\\{zeros}\PP;{}$\2\6
\&{else} \&{if} ${}(\|q<\\{buf\_max}){}$\1\5
${}{*}\|q\PP\K{*}\|p;{}$\2\6
\&{else} \&{if} ${}({*}(\|q-\T{1})\E\.{'0'}){}$\1\5
${}{*}(\|q-\T{1})\K{*}\|p;{}$\2\2\6
\4${}\}{}$\2\par
\U73.\fi
 
\M{75}The buffer needs room for eight digits of padding at the left, followed
by up to $1022+53-307$ significant digits, followed by a ``sticky'' digit
at position \PB{$\\{buf\_max}-\T{1}$}, and eight more digits of padding.
 
\Y\B\4\D$\\{buf0}$ \5
$(\\{buf}+\T{8}{}$)\par
\B\4\D$\\{buf\_max}$ \5
$(\\{buf}+\T{777}{}$)\par
\Y\B\4\X4:Global variables\X${}\mathrel+\E{}$\6
\&{static} \&{char} \\{buf}[\T{785}]${}\K\.{"00000000"}{}$;\C{ where we put
significant input digits }\par
\fi
 
\M{76}\B\X70:Local variables for \PB{\\{scan\_const}}\X${}\mathrel+\E{}$\6
\&{register} \&{char} ${}{*}\\{dec\_pt}{}$;\C{ position of decimal point in %
\PB{\\{buf}} }\6
\&{register} \&{int} \\{exp};\C{ scanned exponent; later used for raw binary
exponent }\6
\&{register} \&{int} \\{zeros};\C{ leading zeros removed after decimal point }%
\par
\fi
 
\M{77}Here we don't advance \PB{\\{next\_char}} and force a decimal point until
we
know that a syntactically correct exponent exists.
 
The code here will convert extra-large inputs like
`\.{9e+9999999999999999}' into $\infty$ and extra-small inputs into zero.
Strange inputs like `\.{-00.0e9999999}' must also be accommodated.
 
\Y\B\4\X77:Scan an exponent\X${}\E{}$\6
${}\{{}$\5
\1\&{register} \&{char} \\{exp\_sign};\7
${}\|p\PP;{}$\6
\&{if} ${}({*}\|p\E\.{'+'}\V{*}\|p\E\.{'-'}){}$\1\5
${}\\{exp\_sign}\K{*}\|p\PP{}$;\5
\2\&{else}\1\5
${}\\{exp\_sign}\K\.{'+'};{}$\2\6
\&{if} ${}(\\{isdigit}({*}\|p)){}$\5
${}\{{}$\1\6
\&{for} ${}(\\{exp}\K{*}\|p\PP-\.{'0'};{}$ ${}\\{isdigit}({*}\|p);{}$ ${}\|p%
\PP){}$\1\6
\&{if} ${}(\\{exp}<\T{1000}){}$\1\5
${}\\{exp}\K\T{10}*\\{exp}+{*}\|p-\.{'0'};{}$\2\2\6
\&{if} ${}(\R\\{dec\_pt}){}$\1\5
${}\\{dec\_pt}\K\|q,\39\\{zeros}\K\T{0};{}$\2\6
\&{if} ${}(\\{exp\_sign}\E\.{'-'}){}$\1\5
${}\\{exp}\K{-}\\{exp};{}$\2\6
${}\\{next\_char}\K\|p;{}$\6
\4${}\}{}$\2\6
\4${}\}{}$\2\par
\U73.\fi
 
\M{78}\B\X78:Return a floating point constant\X${}\E{}$\6
${}\{{}$\1\6
\X79:Move the digits from \PB{\\{buf}} to \PB{$\ff$}\X;\6
\X83:Determine the binary fraction and binary exponent\X;\6
\4\\{packit}:\5
\X84:Pack and round the answer\X;\6
\&{return} \T{1};\6
\4${}\}{}$\2\par
\U73.\fi
 
\M{79}Now we get ready to compute the binary fraction bits, by putting the
scanned input digits into a multiprecision fixed-point
accumulator \PB{$\ff$} that spans the full necessary range.
After this step, the number that we want to convert to floating binary
will appear in \PB{$\ff.\\{dat}[\ff.\|a]$}, \PB{$\ff.\\{dat}[\ff.\|a+\T{1}]$}, %
\dots,
\PB{$\ff.\\{dat}[\ff.\|b]$}.
The radix-$10^9$ digit in ${\it ff}[36-k]$ is understood to be multiplied
by $10^{9k}$, for $36\ge k\ge-120$.
 
\Y\B\4\X79:Move the digits from \PB{\\{buf}} to \PB{$\ff$}\X${}\E{}$\6
$\|x\K\\{buf}+\T{341}+\\{zeros}-\\{dec\_pt}-\\{exp};{}$\6
\&{if} ${}(\|q\E\\{buf0}\V\|x\G\T{1413}){}$\5
${}\{{}$\1\6
\4\\{make\_it\_zero}:\5
${}\\{exp}\K{-}\T{99999}{}$;\5
\&{goto} \\{packit};\6
\4${}\}{}$\2\6
\&{if} ${}(\|x<\T{0}){}$\5
${}\{{}$\1\6
\4\\{make\_it\_infinite}:\5
${}\\{exp}\K\T{99999}{}$;\5
\&{goto} \\{packit};\6
\4${}\}{}$\2\6
${}\ff.\|a\K\|x/\T{9};{}$\6
\&{for} ${}(\|p\K\|q;{}$ ${}\|p<\|q+\T{8};{}$ ${}\|p\PP){}$\1\5
${}{*}\|p\K\.{'0'}{}$;\C{ pad with trailing zeros }\2\6
${}\|q\K\|q-\T{1}-(\|q+\T{341}+\\{zeros}-\\{dec\_pt}-\\{exp})\MOD\T{9}{}$;\C{
compute stopping place in \PB{\\{buf}} }\6
\&{for} ${}(\|p\K\\{buf0}-\|x\MOD\T{9},\39\|k\K\ff.\|a;{}$ ${}\|p\Z\|q\W\|k\Z%
\T{156};{}$ ${}\|p\MRL{+{\K}}\T{9},\39\|k\PP){}$\1\5
\X80:Put the 9-digit number \PB{${*}\|p$}\thinspace\dots\thinspace\PB{${*}(\|p+%
\T{8})$} into \PB{$\ff.\\{dat}[\|k]$}\X;\2\6
${}\ff.\|b\K\|k-\T{1};{}$\6
\&{for} ${}(\|x\K\T{0};{}$ ${}\|p\Z\|q;{}$ ${}\|p\MRL{+{\K}}\T{9}){}$\1\6
\&{if} ${}(\\{strncmp}(\|p,\39\.{"000000000"},\39\T{9})\I\T{0}){}$\1\5
${}\|x\K\T{1};{}$\2\2\6
${}\ff.\\{dat}[\T{156}]\MRL{+{\K}}\|x{}$;\C{ nonzero digits that fall off the
right are sticky }\6
\&{while} ${}(\ff.\\{dat}[\ff.\|b]\E\T{0}){}$\1\5
${}\ff.\|b\MM{}$;\2\par
\U78.\fi
 
\M{80}\B\X80:Put the 9-digit number \PB{${*}\|p$}\thinspace\dots\thinspace%
\PB{${*}(\|p+\T{8})$} into \PB{$\ff.\\{dat}[\|k]$}\X${}\E{}$\6
${}\{{}$\1\6
\&{for} ${}(\|x\K{*}\|p-\.{'0'},\39\\{pp}\K\|p+\T{1};{}$ ${}\\{pp}<\|p+%
\T{9};{}$ ${}\\{pp}\PP){}$\1\5
${}\|x\K\T{10}*\|x+{*}\\{pp}-\.{'0'};{}$\2\6
${}\ff.\\{dat}[\|k]\K\|x;{}$\6
\4${}\}{}$\2\par
\U79.\fi
 
\M{81}\B\X70:Local variables for \PB{\\{scan\_const}}\X${}\mathrel+\E{}$\6
\&{register} \&{int} \|k${},{}$ \|x;\6
\&{register} \&{char} ${}{*}\\{pp};{}$\6
\&{bignum} ${}\ff,{}$ \\{tt};\par
\fi
 
\M{82}Here's a subroutine that is dual to \PB{\\{bignum\_times\_ten}}. It
changes $f$
to~$2f$, assuming that overflow will not occur and that the radix is $10^9$.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{static} \&{void} \\{bignum\_double}(\|f)\1\1\6
\&{bignum} ${}{*}\|f;\2\2{}$\6
${}\{{}$\1\6
\&{register} \&{tetra} ${}{*}\|p,{}$ ${}{*}\|q;{}$\6
\&{register} \&{int} \|x${},{}$ \\{carry};\7
\&{for} ${}(\|p\K{\AND}\|f\MG\\{dat}[\|f\MG\|b],\39\|q\K{\AND}\|f\MG\\{dat}[\|f%
\MG\|a],\39\\{carry}\K\T{0};{}$ ${}\|p\G\|q;{}$ ${}\|p\MM){}$\5
${}\{{}$\1\6
${}\|x\K{*}\|p+{*}\|p+\\{carry};{}$\6
\&{if} ${}(\|x\G\T{1000000000}){}$\1\5
${}\\{carry}\K\T{1},\39{*}\|p\K\|x-\T{1000000000};{}$\2\6
\&{else}\1\5
${}\\{carry}\K\T{0},\39{*}\|p\K\|x;{}$\2\6
\4${}\}{}$\2\6
${}{*}\|p\K\\{carry};{}$\6
\&{if} (\\{carry})\1\5
${}\|f\MG\|a\MM;{}$\2\6
\&{if} ${}(\|f\MG\\{dat}[\|f\MG\|b]\E\T{0}\W\|f\MG\|b>\|f\MG\|a){}$\1\5
${}\|f\MG\|b\MM;{}$\2\6
\4${}\}{}$\2\par
\fi
 
\M{83}\B\X83:Determine the binary fraction and binary exponent\X${}\E{}$\6
$\\{val}\K\\{zero\_octa};{}$\6
\&{if} ${}(\ff.\|a>\T{36}){}$\5
${}\{{}$\1\6
\&{for} ${}(\\{exp}\K\T{\^3fe};{}$ ${}\ff.\|a>\T{36};{}$ ${}\\{exp}\MM){}$\1\5
${}\\{bignum\_double}({\AND}\ff);{}$\2\6
\&{for} ${}(\|k\K\T{54};{}$ \|k; ${}\|k\MM){}$\5
${}\{{}$\1\6
\&{if} ${}(\ff.\\{dat}[\T{36}]){}$\5
${}\{{}$\1\6
\&{if} ${}(\|k\G\T{32}){}$\1\5
${}\\{val}.\|h\MRL{{\OR}{\K}}\T{1}\LL(\|k-\T{32}){}$;\5
\2\&{else}\1\5
${}\\{val}.\|l\MRL{{\OR}{\K}}\T{1}\LL\|k;{}$\2\6
${}\ff.\\{dat}[\T{36}]\K\T{0};{}$\6
\&{if} ${}(\ff.\|b\E\T{36}){}$\1\5
\&{break};\C{ break if \PB{$\ff$} now zero }\2\6
\4${}\}{}$\2\6
${}\\{bignum\_double}({\AND}\ff);{}$\6
\4${}\}{}$\2\6
\4${}\}{}$\5
\2\&{else}\5
${}\{{}$\1\6
${}\\{tt}.\|a\K\\{tt}.\|b\K\T{36},\39\\{tt}.\\{dat}[\T{36}]\K\T{2};{}$\6
\&{for} ${}(\\{exp}\K\T{\^3fe};{}$ ${}\\{bignum\_compare}({\AND}\ff,\39{\AND}%
\\{tt})\G\T{0};{}$ ${}\\{exp}\PP){}$\1\5
${}\\{bignum\_double}({\AND}\\{tt});{}$\2\6
\&{for} ${}(\|k\K\T{54};{}$ \|k; ${}\|k\MM){}$\5
${}\{{}$\1\6
${}\\{bignum\_double}({\AND}\ff);{}$\6
\&{if} ${}(\\{bignum\_compare}({\AND}\ff,\39{\AND}\\{tt})\G\T{0}){}$\5
${}\{{}$\1\6
\&{if} ${}(\|k\G\T{32}){}$\1\5
${}\\{val}.\|h\MRL{{\OR}{\K}}\T{1}\LL(\|k-\T{32}){}$;\5
\2\&{else}\1\5
${}\\{val}.\|l\MRL{{\OR}{\K}}\T{1}\LL\|k;{}$\2\6
${}\\{bignum\_dec}({\AND}\ff,\39{\AND}\\{tt},\39\T{1000000000});{}$\6
\&{if} ${}(\ff.\|a\E\\{bignum\_prec}-\T{1}){}$\1\5
\&{break};\C{ break if \PB{$\ff$} now zero }\2\6
\4${}\}{}$\2\6
\4${}\}{}$\2\6
\4${}\}{}$\2\6
\&{if} ${}(\|k\E\T{0}){}$\1\5
${}\\{val}.\|l\MRL{{\OR}{\K}}\T{1}{}$;\C{ add sticky bit if \PB{$\ff$} nonzero
}\2\par
\U78.\fi
 
\M{84}We need to be careful that the input `\.{NaN.999999999999999999999}'
doesn't
get rounded up; it is supposed to yield \Hex{7fffffffffffffff}.
 
Although the input `\.{NaN.0}' is illegal, strictly speaking, we silently
convert it to \Hex{7ff0000000000001}---a number that would be
output as `\.{NaN.0000000000000002}'.
 
\Y\B\4\X84:Pack and round the answer\X${}\E{}$\6
$\\{val}\K\\{fpack}(\\{val},\39\\{exp},\39\\{sign},\39\.{ROUND\_NEAR});{}$\6
\&{if} (\\{NaN})\5
${}\{{}$\1\6
\&{if} ${}((\\{val}.\|h\AND\T{\^7fffffff})\E\T{\^40000000}){}$\1\5
${}\\{val}.\|h\MRL{{\OR}{\K}}\T{\^7fffffff},\39\\{val}.\|l\K\T{\^ffffffff};{}$%
\2\6
\&{else} \&{if} ${}((\\{val}.\|h\AND\T{\^7fffffff})\E\T{\^3ff00000}\W\R\\{val}.%
\|l){}$\1\5
${}\\{val}.\|h\MRL{{\OR}{\K}}\T{\^40000000},\39\\{val}.\|l\K\T{1};{}$\2\6
\&{else}\1\5
${}\\{val}.\|h\MRL{{\OR}{\K}}\T{\^40000000};{}$\2\6
\4${}\}{}$\2\par
\U78.\fi
 
\N{1}{85}Floating point remainders. In this section we implement the remainder
of the floating point operations---one of which happens to be the
operation of taking the remainder.
 
The easiest task remaining is to compare two floating point quantities.
Routine \PB{\\{fcomp}} returns $-1$~if~$y<z$, 0~if~$y=z$, $+1$~if~$y>z$, and
$+2$~if $y$ and~$z$ are unordered.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{int} \\{fcomp}\,\,${}\.{ARGS}((\&{octa},\39\&{octa})){}$;\5
\hbox{}\6{}\&{int} ${}\\{fcomp}(\|y,\39\|z){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\2\2\6
${}\{{}$\1\6
\&{ftype} \\{yt}${},{}$ \\{zt};\6
\&{int} \\{ye}${},{}$ \\{ze};\6
\&{char} \\{ys}${},{}$ \\{zs};\6
\&{octa} \\{yf}${},{}$ \\{zf};\6
\&{register} \&{int} \|x;\7
${}\\{yt}\K\\{funpack}(\|y,\39{\AND}\\{yf},\39{\AND}\\{ye},\39{\AND}\\{ys});{}$%
\6
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
\&{switch} ${}(\T{4}*\\{yt}+\\{zt}){}$\5
${}\{{}$\1\6
\4\&{case} \T{4}${}*\\{nan}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{nan}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{nan}+\\{inf}{}$:\5
\&{return} \T{2};\6
\4\&{case} \T{4}${}*\\{zro}+\\{zro}{}$:\5
\&{return} \T{0};\6
\4\&{case} \T{4}${}*\\{zro}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{inf}{}$:\6
\&{if} ${}(\\{ys}\I\\{zs}){}$\1\5
${}\|x\K\T{1};{}$\2\6
\&{else} \&{if} ${}(\|y.\|h>\|z.\|h){}$\1\5
${}\|x\K\T{1};{}$\2\6
\&{else} \&{if} ${}(\|y.\|h<\|z.\|h){}$\1\5
${}\|x\K{-}\T{1};{}$\2\6
\&{else} \&{if} ${}(\|y.\|l>\|z.\|l){}$\1\5
${}\|x\K\T{1};{}$\2\6
\&{else} \&{if} ${}(\|y.\|l<\|z.\|l){}$\1\5
${}\|x\K{-}\T{1};{}$\2\6
\&{else}\1\5
\&{return} \T{0};\2\6
\&{break};\6
\4${}\}{}$\2\6
\&{return} ${}(\\{ys}\E\.{'-'}\?{-}\|x:\|x);{}$\6
\4${}\}{}$\2\par
\fi
 
\M{86}Several \MMIX\ operations act on a single floating point number and
accept an arbitrary rounding mode. For example, consider the
operation of rounding to the nearest floating point integer:
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{fintegerize}\,\,${}\.{ARGS}((\&{octa},\39\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{fintegerize}(\|z,\39\|r){}$\1\1\6
\&{octa} \|z;\C{ the operand }\6
\&{int} \|r;\C{ the rounding mode }\2\2\6
${}\{{}$\1\6
\&{ftype} \\{zt};\6
\&{int} \\{ze};\6
\&{char} \\{zs};\6
\&{octa} \\{xf}${},{}$ \\{zf};\7
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
\&{if} ${}(\R\|r){}$\1\5
${}\|r\K\\{cur\_round};{}$\2\6
\&{switch} (\\{zt})\5
${}\{{}$\1\6
\4\&{case} \\{nan}:\5
\&{if} ${}(\R(\|z.\|h\AND\T{\^80000})){}$\5
${}\{{}$\5
\1${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\5
${}\|z.\|h\MRL{{\OR}{\K}}\T{\^80000}{}$;\5
${}\}{}$\2\6
\4\&{case} \\{inf}:\5
\&{case} \\{zro}:\5
\&{return} \|z;\6
\4\&{case} \\{num}:\5
\X87:Integerize and \PB{\&{return}}\X;\6
\4${}\}{}$\2\6
\4${}\}{}$\2\par
\fi
 
\M{87}\B\X87:Integerize and \PB{\&{return}}\X${}\E{}$\6
\&{if} ${}(\\{ze}\G\T{1074}){}$\1\5
\&{return} \\{fpack}${}(\\{zf},\39\\{ze},\39\\{zs},\39\.{ROUND\_OFF}){}$;\C{
already an integer }\2\6
\&{if} ${}(\\{ze}\Z\T{1020}){}$\1\5
${}\\{xf}.\|h\K\T{0},\39\\{xf}.\|l\K\T{1};{}$\2\6
\&{else}\5
${}\{{}$\5
\1\&{octa} \\{oo};\7
${}\\{xf}\K\\{shift\_right}(\\{zf},\39\T{1074}-\\{ze},\39\T{1});{}$\6
${}\\{oo}\K\\{shift\_left}(\\{xf},\39\T{1074}-\\{ze});{}$\6
\&{if} ${}(\\{oo}.\|l\I\\{zf}.\|l\V\\{oo}.\|h\I\\{zf}.\|h){}$\1\5
${}\\{xf}.\|l\MRL{{\OR}{\K}}\T{1}{}$;\C{ sticky bit }\2\6
\4${}\}{}$\2\6
\&{switch} (\|r)\5
${}\{{}$\1\6
\4\&{case} \.{ROUND\_DOWN}:\5
\&{if} ${}(\\{zs}\E\.{'-'}){}$\1\5
${}\\{xf}\K\\{incr}(\\{xf},\39\T{3}){}$;\5
\2\&{break};\6
\4\&{case} \.{ROUND\_UP}:\5
\&{if} ${}(\\{zs}\I\.{'-'}){}$\1\5
${}\\{xf}\K\\{incr}(\\{xf},\39\T{3});{}$\2\6
\4\&{case} \.{ROUND\_OFF}:\5
\&{break};\6
\4\&{case} \.{ROUND\_NEAR}:\5
${}\\{xf}\K\\{incr}(\\{xf},\39\\{xf}.\|l\AND\T{4}\?\T{2}:\T{1}){}$;\5
\&{break};\6
\4${}\}{}$\2\6
${}\\{xf}.\|l\MRL{\AND{\K}}\T{\^fffffffc};{}$\6
\&{if} ${}(\\{ze}\G\T{1022}){}$\1\5
\&{return} \\{fpack}${}(\\{shift\_left}(\\{xf},\39\T{1074}-\\{ze}),\39\\{ze},%
\39\\{zs},\39\.{ROUND\_OFF});{}$\2\6
\&{if} ${}(\\{xf}.\|l){}$\1\5
${}\\{xf}.\|h\K\T{\^3ff00000},\39\\{xf}.\|l\K\T{0};{}$\2\6
\&{if} ${}(\\{zs}\E\.{'-'}){}$\1\5
${}\\{xf}.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \\{xf};\par
\U86.\fi
 
\M{88}To convert floating point to fixed point, we use \PB{\\{fixit}}.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{fixit}\,\,${}\.{ARGS}((\&{octa},\39\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{fixit}(\|z,\39\|r){}$\1\1\6
\&{octa} \|z;\C{ the operand }\6
\&{int} \|r;\C{ the rounding mode }\2\2\6
${}\{{}$\1\6
\&{ftype} \\{zt};\6
\&{int} \\{ze};\6
\&{char} \\{zs};\6
\&{octa} \\{zf}${},{}$ \|o;\7
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
\&{if} ${}(\R\|r){}$\1\5
${}\|r\K\\{cur\_round};{}$\2\6
\&{switch} (\\{zt})\5
${}\{{}$\1\6
\4\&{case} \\{nan}:\5
\&{case} \\{inf}:\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\5
\&{return} \|z;\6
\4\&{case} \\{zro}:\5
\&{return} \\{zero\_octa};\6
\4\&{case} \\{num}:\5
\&{if} ${}(\\{funpack}(\\{fintegerize}(\|z,\39\|r),\39{\AND}\\{zf},\39{\AND}%
\\{ze},\39{\AND}\\{zs})\E\\{zro}){}$\1\5
\&{return} \\{zero\_octa};\2\6
\&{if} ${}(\\{ze}\Z\T{1076}){}$\1\5
${}\|o\K\\{shift\_right}(\\{zf},\39\T{1076}-\\{ze},\39\T{1});{}$\2\6
\&{else}\5
${}\{{}$\1\6
\&{if} ${}(\\{ze}>\T{1085}\V(\\{ze}\E\T{1085}\W(\\{zf}.\|h>\T{\^400000}\V%
\3{-1}(\\{zf}.\|h\E\T{\^400000}\W(\\{zf}.\|l\V\\{zs}\I\.{'-'}))))){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{W\_BIT};{}$\2\6
\&{if} ${}(\\{ze}\G\T{1140}){}$\1\5
\&{return} \\{zero\_octa};\2\6
${}\|o\K\\{shift\_left}(\\{zf},\39\\{ze}-\T{1076});{}$\6
\4${}\}{}$\2\6
\&{return} ${}(\\{zs}\E\.{'-'}\?\\{ominus}(\\{zero\_octa},\39\|o):\|o);{}$\6
\4${}\}{}$\2\6
\4${}\}{}$\2\par
\fi
 
\M{89}Going the other way, we can specify not only a rounding mode but whether
the given fixed point octabyte is signed or unsigned, and whether the
result should be rounded to short precision.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{floatit}\,\,${}\.{ARGS}((\&{octa},\39\&{int},\39\&{int},\39%
\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{floatit}(\|z,\39\|r,\39\|u,\39\|p){}$\1\1\6
\&{octa} \|z;\C{ octabyte to float }\6
\&{int} \|r;\C{ rounding mode }\6
\&{int} \|u;\C{ unsigned? }\6
\&{int} \|p;\C{ short precision? }\2\2\6
${}\{{}$\1\6
\&{int} \|e;\5
\&{char} \|s;\6
\&{register} \&{int} \|t;\7
${}\\{exceptions}\K\T{0};{}$\6
\&{if} ${}(\R\|z.\|h\W\R\|z.\|l){}$\1\5
\&{return} \\{zero\_octa};\2\6
\&{if} ${}(\R\|r){}$\1\5
${}\|r\K\\{cur\_round};{}$\2\6
\&{if} ${}(\R\|u\W(\|z.\|h\AND\\{sign\_bit})){}$\1\5
${}\|s\K\.{'-'},\39\|z\K\\{ominus}(\\{zero\_octa},\39\|z){}$;\5
\2\&{else}\1\5
${}\|s\K\.{'+'};{}$\2\6
${}\|e\K\T{1076};{}$\6
\&{while} ${}(\|z.\|h<\T{\^400000}){}$\1\5
${}\|e\MM,\39\|z\K\\{shift\_left}(\|z,\39\T{1});{}$\2\6
\&{while} ${}(\|z.\|h\G\T{\^800000}){}$\5
${}\{{}$\1\6
${}\|e\PP;{}$\6
${}\|t\K\|z.\|l\AND\T{1};{}$\6
${}\|z\K\\{shift\_right}(\|z,\39\T{1},\39\T{1});{}$\6
${}\|z.\|l\MRL{{\OR}{\K}}\|t;{}$\6
\4${}\}{}$\2\6
\&{if} (\|p)\1\5
\X90:Convert to short float\X;\2\6
\&{return} \\{fpack}${}(\|z,\39\|e,\39\|s,\39\|r);{}$\6
\4${}\}{}$\2\par
\fi
 
\M{90}\B\X90:Convert to short float\X${}\E{}$\6
${}\{{}$\1\6
\&{register} \&{int} \\{ex};\5
\&{register} \&{tetra} \|t;\7
${}\|t\K\\{sfpack}(\|z,\39\|e,\39\|s,\39\|r);{}$\6
${}\\{ex}\K\\{exceptions};{}$\6
${}\\{sfunpack}(\|t,\39{\AND}\|z,\39{\AND}\|e,\39{\AND}\|s);{}$\6
${}\\{exceptions}\K\\{ex};{}$\6
\4${}\}{}$\2\par
\U89.\fi
 
\M{91}The square root operation is more interesting.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{froot}\,\,${}\.{ARGS}((\&{octa},\39\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{froot}(\|z,\39\|r){}$\1\1\6
\&{octa} \|z;\C{ the operand }\6
\&{int} \|r;\C{ the rounding mode }\2\2\6
${}\{{}$\1\6
\&{ftype} \\{zt};\6
\&{int} \\{ze};\6
\&{char} \\{zs};\6
\&{octa} \|x${},{}$ \\{xf}${},{}$ \\{rf}${},{}$ \\{zf};\6
\&{register} \&{int} \\{xe}${},{}$ \|k;\7
\&{if} ${}(\R\|r){}$\1\5
${}\|r\K\\{cur\_round};{}$\2\6
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
\&{if} ${}(\\{zs}\E\.{'-'}\W\\{zt}\I\\{zro}){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT},\39\|x\K\\{standard\_NaN};{}$\2\6
\&{else}\5
\1\&{switch} (\\{zt})\5
${}\{{}$\1\6
\4\&{case} \\{nan}:\5
\&{if} ${}(\R(\|z.\|h\AND\T{\^80000})){}$\1\5
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT},\39\|z.\|h\MRL{{\OR}{\K}}\T{%
\^80000};{}$\2\6
\&{return} \|z;\6
\4\&{case} \\{inf}:\5
\&{case} \\{zro}:\5
${}\|x\K\|z{}$;\5
\&{break};\6
\4\&{case} \\{num}:\5
\X92:Take the square root and \PB{\&{return}}\X;\6
\4${}\}{}$\2\2\6
\&{if} ${}(\\{zs}\E\.{'-'}){}$\1\5
${}\|x.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{92}The square root can be found by an adaptation of the old pencil-and-paper
method. If $n=\lfloor\sqrt s\rfloor$, where $s$ is an integer,
we have $s=n^2+r$ where $0\le r\le2n$;
this invariant can be maintained if we replace $s$ by $4s+(0,1,2,3)$
and $n$ by $2n+(0,1)$. The following code implements this idea with
$2n$ in~\PB{\\{xf}} and $r$ in~\PB{\\{rf}}. (It could easily be made to run
about
twice as fast.)
 
\Y\B\4\X92:Take the square root and \PB{\&{return}}\X${}\E{}$\6
$\\{xf}.\|h\K\T{0},\39\\{xf}.\|l\K\T{2};{}$\6
${}\\{xe}\K(\\{ze}+\T{\^3fe})\GG\T{1};{}$\6
\&{if} ${}(\\{ze}\AND\T{1}){}$\1\5
${}\\{zf}\K\\{shift\_left}(\\{zf},\39\T{1});{}$\2\6
${}\\{rf}.\|h\K\T{0},\39\\{rf}.\|l\K(\\{zf}.\|h\GG\T{22})-\T{1};{}$\6
\&{for} ${}(\|k\K\T{53};{}$ \|k; ${}\|k\MM){}$\5
${}\{{}$\1\6
${}\\{rf}\K\\{shift\_left}(\\{rf},\39\T{2}){}$;\5
${}\\{xf}\K\\{shift\_left}(\\{xf},\39\T{1});{}$\6
\&{if} ${}(\|k\G\T{43}){}$\1\5
${}\\{rf}\K\\{incr}(\\{rf},\39(\\{zf}.\|h\GG(\T{2}*(\|k-\T{43})))\AND\T{3});{}$%
\2\6
\&{else} \&{if} ${}(\|k\G\T{27}){}$\1\5
${}\\{rf}\K\\{incr}(\\{rf},\39(\\{zf}.\|l\GG(\T{2}*(\|k-\T{27})))\AND\T{3});{}$%
\2\6
\&{if} ${}((\\{rf}.\|l>\\{xf}.\|l\W\\{rf}.\|h\G\\{xf}.\|h)\V\\{rf}.\|h>\\{xf}.%
\|h){}$\5
${}\{{}$\1\6
${}\\{xf}.\|l\PP{}$;\5
${}\\{rf}\K\\{ominus}(\\{rf},\39\\{xf}){}$;\5
${}\\{xf}.\|l\PP;{}$\6
\4${}\}{}$\2\6
\4${}\}{}$\2\6
\&{if} ${}(\\{rf}.\|h\V\\{rf}.\|l){}$\1\5
${}\\{xf}.\|l\PP{}$;\C{ sticky bit }\2\6
\&{return} \\{fpack}${}(\\{xf},\39\\{xe},\39\.{'+'},\39\|r){}$;\par
\U91.\fi
 
\M{93}And finally, the genuine floating point remainder. Subroutine \PB{%
\\{fremstep}}
either calculates $y\,{\rm rem}\,z$ or reduces $y$ to a smaller number
having the same remainder with respect to~$z$. In the latter case
the \PB{\.{E\_BIT}} is set in \PB{\\{exceptions}}. A third parameter, \PB{%
\\{delta}},
gives a decrease in exponent that is acceptable for incomplete results;
if \PB{\\{delta}} is sufficiently large, say 2500, the correct result will
always be obtained in one step of \PB{\\{fremstep}}.
 
\Y\B\4\X5:Subroutines\X${}\mathrel+\E{}$\6
\&{octa} \\{fremstep}\,\,${}\.{ARGS}((\&{octa},\39\&{octa},\39\&{int})){}$;\5
\hbox{}\6{}\&{octa} ${}\\{fremstep}(\|y,\39\|z,\39\\{delta}){}$\1\1\6
\&{octa} \|y${},{}$ \|z;\6
\&{int} \\{delta};\2\2\6
${}\{{}$\1\6
\&{ftype} \\{yt}${},{}$ \\{zt};\6
\&{int} \\{ye}${},{}$ \\{ze};\6
\&{char} \\{xs}${},{}$ \\{ys}${},{}$ \\{zs};\6
\&{octa} \|x${},{}$ \\{xf}${},{}$ \\{yf}${},{}$ \\{zf};\6
\&{register} \&{int} \\{xe}${},{}$ \\{thresh}${},{}$ \\{odd};\7
${}\\{yt}\K\\{funpack}(\|y,\39{\AND}\\{yf},\39{\AND}\\{ye},\39{\AND}\\{ys});{}$%
\6
${}\\{zt}\K\\{funpack}(\|z,\39{\AND}\\{zf},\39{\AND}\\{ze},\39{\AND}\\{zs});{}$%
\6
\&{switch} ${}(\T{4}*\\{yt}+\\{zt}){}$\5
${}\{{}$\1\6
\hbox{\4}\X42:The usual NaN cases\X;\6
\4\&{case} \T{4}${}*\\{zro}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{zro}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{inf}+\\{inf}{}$:\5
${}\|x\K\\{standard\_NaN};{}$\6
${}\\{exceptions}\MRL{{\OR}{\K}}\.{I\_BIT}{}$;\5
\&{break};\6
\4\&{case} \T{4}${}*\\{zro}+\\{num}{}$:\5
\&{case} \T{4}${}*\\{zro}+\\{inf}{}$:\5
\&{case} \T{4}${}*\\{num}+\\{inf}{}$:\5
\&{return} \|y;\6
\4\&{case} \T{4}${}*\\{num}+\\{num}{}$:\5
\X94:Remainderize nonzero numbers and \PB{\&{return}}\X;\6
\4\\{zero\_out}:\5
${}\|x\K\\{zero\_octa};{}$\6
\4${}\}{}$\2\6
\&{if} ${}(\\{ys}\E\.{'-'}){}$\1\5
${}\|x.\|h\MRL{{\OR}{\K}}\\{sign\_bit};{}$\2\6
\&{return} \|x;\6
\4${}\}{}$\2\par
\fi
 
\M{94}If there's a huge difference in exponents and the remainder is nonzero,
this computation will take a long time. One could compute
$(2^ny)\,{\rm rem}\,z$ much more quickly for large~$n$ by using $O(\log n)$
multiplications modulo~$z$, but the floating remainder operation isn't
important enough to justify such expensive hardware.
 
Results of floating remainder are always exact, so the rounding mode
is immaterial.
 
\Y\B\4\X94:Remainderize nonzero numbers and \PB{\&{return}}\X${}\E{}$\6
$\\{odd}\K\T{0}{}$;\C{ will be 1 if we've subtracted an odd multiple of~$z$
from $y$ }\6
${}\\{thresh}\K\\{ye}-\\{delta};{}$\6
\&{if} ${}(\\{thresh}<\\{ze}){}$\1\5
${}\\{thresh}\K\\{ze};{}$\2\6
\&{while} ${}(\\{ye}\G\\{thresh}){}$\1\5
\X95:Reduce \PB{$(\\{ye},\\{yf})$} by a multiple of \PB{\\{zf}}; \PB{\&{goto} %
\\{zero\_out}} if the remainder is zero, \PB{\&{goto} \\{try\_complement}} if
appropriate\X;\2\6
\&{if} ${}(\\{ye}\G\\{ze}){}$\5
${}\{{}$\1\6
${}\\{exceptions}\MRL{{\OR}{\K}}\.{E\_BIT}{}$;\5
\&{return} \\{fpack}${}(\\{yf},\39\\{ye},\39\\{ys},\39\.{ROUND\_OFF});{}$\6
\4${}\}{}$\2\6
\&{if} ${}(\\{ye}<\\{ze}-\T{1}){}$\1\5
\&{return} \\{fpack}${}(\\{yf},\39\\{ye},\39\\{ys},\39\.{ROUND\_OFF});{}$\2\6
${}\\{yf}\K\\{shift\_right}(\\{yf},\39\T{1},\39\T{1});{}$\6
\4\\{try\_complement}:\5
${}\\{xf}\K\\{ominus}(\\{zf},\39\\{yf}),\39\\{xe}\K\\{ze},\39\\{xs}\K\.{'+'}+%
\.{'-'}-\\{ys};{}$\6
\&{if} ${}(\\{xf}.\|h>\\{yf}.\|h\V(\\{xf}.\|h\E\\{yf}.\|h\W(\\{xf}.\|l>\\{yf}.%
\|l\V(\\{xf}.\|l\E\\{yf}.\|l\W\R\\{odd})))){}$\1\5
${}\\{xf}\K\\{yf},\39\\{xs}\K\\{ys};{}$\2\6
\&{while} ${}(\\{xf}.\|h<\T{\^400000}){}$\1\5
${}\\{xe}\MM,\39\\{xf}\K\\{shift\_left}(\\{xf},\39\T{1});{}$\2\6
\&{return} \\{fpack}${}(\\{xf},\39\\{xe},\39\\{xs},\39\.{ROUND\_OFF}){}$;\par
\U93.\fi
 
\M{95}Here we are careful not to change the sign of \PB{\|y}, because a
remainder
of~0 is supposed to inherit the original sign of~\PB{\|y}.
 
\Y\B\4\X95:Reduce \PB{$(\\{ye},\\{yf})$} by a multiple of \PB{\\{zf}}; \PB{%
\&{goto} \\{zero\_out}} if the remainder is zero, \PB{\&{goto} \\{try%
\_complement}} if appropriate\X${}\E{}$\6
${}\{{}$\1\6
\&{if} ${}(\\{yf}.\|h\E\\{zf}.\|h\W\\{yf}.\|l\E\\{zf}.\|l){}$\1\5
\&{goto} \\{zero\_out};\2\6
\&{if} ${}(\\{yf}.\|h<\\{zf}.\|h\V(\\{yf}.\|h\E\\{zf}.\|h\W\\{yf}.\|l<\\{zf}.%
\|l)){}$\5
${}\{{}$\1\6
\&{if} ${}(\\{ye}\E\\{ze}){}$\1\5
\&{goto} \\{try\_complement};\2\6
${}\\{ye}\MM,\39\\{yf}\K\\{shift\_left}(\\{yf},\39\T{1});{}$\6
\4${}\}{}$\2\6
${}\\{yf}\K\\{ominus}(\\{yf},\39\\{zf});{}$\6
\&{if} ${}(\\{ye}\E\\{ze}){}$\1\5
${}\\{odd}\K\T{1};{}$\2\6
\&{while} ${}(\\{yf}.\|h<\T{\^400000}){}$\1\5
${}\\{ye}\MM,\39\\{yf}\K\\{shift\_left}(\\{yf},\39\T{1});{}$\2\6
\4${}\}{}$\2\par
\U94.\fi
 
\N{1}{96}Index.
 
\fi
 
 
\inx
\fin
\con

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.