1d11907f1SDavid du Colombier /*
2d11907f1SDavid du Colombier * Floating Point Interpreter.
3d11907f1SDavid du Colombier * shamelessly stolen from an original by ark.
4*4e3613abSDavid du Colombier *
5*4e3613abSDavid du Colombier * NB: the Internal arguments to fpisub and fpidiv are reversed from
6*4e3613abSDavid du Colombier * what you might naively expect: they compute y-x and y/x, respectively.
7d11907f1SDavid du Colombier */
8d11907f1SDavid du Colombier #include "fpi.h"
9d11907f1SDavid du Colombier
10d11907f1SDavid du Colombier void
fpiround(Internal * i)11d11907f1SDavid du Colombier fpiround(Internal *i)
12d11907f1SDavid du Colombier {
13d11907f1SDavid du Colombier unsigned long guard;
14d11907f1SDavid du Colombier
15d11907f1SDavid du Colombier guard = i->l & GuardMask;
16d11907f1SDavid du Colombier i->l &= ~GuardMask;
17d11907f1SDavid du Colombier if(guard > (LsBit>>1) || (guard == (LsBit>>1) && (i->l & LsBit))){
18d11907f1SDavid du Colombier i->l += LsBit;
19d11907f1SDavid du Colombier if(i->l & CarryBit){
20d11907f1SDavid du Colombier i->l &= ~CarryBit;
21d11907f1SDavid du Colombier i->h++;
22d11907f1SDavid du Colombier if(i->h & CarryBit){
23d11907f1SDavid du Colombier if (i->h & 0x01)
24d11907f1SDavid du Colombier i->l |= CarryBit;
25d11907f1SDavid du Colombier i->l >>= 1;
26d11907f1SDavid du Colombier i->h >>= 1;
27d11907f1SDavid du Colombier i->e++;
28d11907f1SDavid du Colombier }
29d11907f1SDavid du Colombier }
30d11907f1SDavid du Colombier }
31d11907f1SDavid du Colombier }
32d11907f1SDavid du Colombier
33d11907f1SDavid du Colombier static void
matchexponents(Internal * x,Internal * y)34d11907f1SDavid du Colombier matchexponents(Internal *x, Internal *y)
35d11907f1SDavid du Colombier {
36d11907f1SDavid du Colombier int count;
37d11907f1SDavid du Colombier
38d11907f1SDavid du Colombier count = y->e - x->e;
39d11907f1SDavid du Colombier x->e = y->e;
40d11907f1SDavid du Colombier if(count >= 2*FractBits){
41d11907f1SDavid du Colombier x->l = x->l || x->h;
42d11907f1SDavid du Colombier x->h = 0;
43d11907f1SDavid du Colombier return;
44d11907f1SDavid du Colombier }
45d11907f1SDavid du Colombier if(count >= FractBits){
46d11907f1SDavid du Colombier count -= FractBits;
47d11907f1SDavid du Colombier x->l = x->h|(x->l != 0);
48d11907f1SDavid du Colombier x->h = 0;
49d11907f1SDavid du Colombier }
50d11907f1SDavid du Colombier while(count > 0){
51d11907f1SDavid du Colombier count--;
52d11907f1SDavid du Colombier if(x->h & 0x01)
53d11907f1SDavid du Colombier x->l |= CarryBit;
54d11907f1SDavid du Colombier if(x->l & 0x01)
55d11907f1SDavid du Colombier x->l |= 2;
56d11907f1SDavid du Colombier x->l >>= 1;
57d11907f1SDavid du Colombier x->h >>= 1;
58d11907f1SDavid du Colombier }
59d11907f1SDavid du Colombier }
60d11907f1SDavid du Colombier
61d11907f1SDavid du Colombier static void
shift(Internal * i)62d11907f1SDavid du Colombier shift(Internal *i)
63d11907f1SDavid du Colombier {
64d11907f1SDavid du Colombier i->e--;
65d11907f1SDavid du Colombier i->h <<= 1;
66d11907f1SDavid du Colombier i->l <<= 1;
67d11907f1SDavid du Colombier if(i->l & CarryBit){
68d11907f1SDavid du Colombier i->l &= ~CarryBit;
69d11907f1SDavid du Colombier i->h |= 0x01;
70d11907f1SDavid du Colombier }
71d11907f1SDavid du Colombier }
72d11907f1SDavid du Colombier
73d11907f1SDavid du Colombier static void
normalise(Internal * i)74d11907f1SDavid du Colombier normalise(Internal *i)
75d11907f1SDavid du Colombier {
76d11907f1SDavid du Colombier while((i->h & HiddenBit) == 0)
77d11907f1SDavid du Colombier shift(i);
78d11907f1SDavid du Colombier }
79d11907f1SDavid du Colombier
80d11907f1SDavid du Colombier static void
renormalise(Internal * i)81d11907f1SDavid du Colombier renormalise(Internal *i)
82d11907f1SDavid du Colombier {
83d11907f1SDavid du Colombier if(i->e < -2 * FractBits)
84d11907f1SDavid du Colombier i->e = -2 * FractBits;
85d11907f1SDavid du Colombier while(i->e < 1){
86d11907f1SDavid du Colombier i->e++;
87d11907f1SDavid du Colombier if(i->h & 0x01)
88d11907f1SDavid du Colombier i->l |= CarryBit;
89d11907f1SDavid du Colombier i->h >>= 1;
90d11907f1SDavid du Colombier i->l = (i->l>>1)|(i->l & 0x01);
91d11907f1SDavid du Colombier }
92d11907f1SDavid du Colombier if(i->e >= ExpInfinity)
93d11907f1SDavid du Colombier SetInfinity(i);
94d11907f1SDavid du Colombier }
95d11907f1SDavid du Colombier
96d11907f1SDavid du Colombier void
fpinormalise(Internal * x)97d11907f1SDavid du Colombier fpinormalise(Internal *x)
98d11907f1SDavid du Colombier {
99d11907f1SDavid du Colombier if(!IsWeird(x) && !IsZero(x))
100d11907f1SDavid du Colombier normalise(x);
101d11907f1SDavid du Colombier }
102d11907f1SDavid du Colombier
103d11907f1SDavid du Colombier void
fpiadd(Internal * x,Internal * y,Internal * i)104d11907f1SDavid du Colombier fpiadd(Internal *x, Internal *y, Internal *i)
105d11907f1SDavid du Colombier {
106d11907f1SDavid du Colombier Internal *t;
107d11907f1SDavid du Colombier
108d11907f1SDavid du Colombier i->s = x->s;
109d11907f1SDavid du Colombier if(IsWeird(x) || IsWeird(y)){
110d11907f1SDavid du Colombier if(IsNaN(x) || IsNaN(y))
111d11907f1SDavid du Colombier SetQNaN(i);
112d11907f1SDavid du Colombier else
113d11907f1SDavid du Colombier SetInfinity(i);
114d11907f1SDavid du Colombier return;
115d11907f1SDavid du Colombier }
116d11907f1SDavid du Colombier if(x->e > y->e){
117d11907f1SDavid du Colombier t = x;
118d11907f1SDavid du Colombier x = y;
119d11907f1SDavid du Colombier y = t;
120d11907f1SDavid du Colombier }
121d11907f1SDavid du Colombier matchexponents(x, y);
122d11907f1SDavid du Colombier i->e = x->e;
123d11907f1SDavid du Colombier i->h = x->h + y->h;
124d11907f1SDavid du Colombier i->l = x->l + y->l;
125d11907f1SDavid du Colombier if(i->l & CarryBit){
126d11907f1SDavid du Colombier i->h++;
127d11907f1SDavid du Colombier i->l &= ~CarryBit;
128d11907f1SDavid du Colombier }
129d11907f1SDavid du Colombier if(i->h & (HiddenBit<<1)){
130d11907f1SDavid du Colombier if(i->h & 0x01)
131d11907f1SDavid du Colombier i->l |= CarryBit;
132d11907f1SDavid du Colombier i->l = (i->l>>1)|(i->l & 0x01);
133d11907f1SDavid du Colombier i->h >>= 1;
134d11907f1SDavid du Colombier i->e++;
135d11907f1SDavid du Colombier }
136d11907f1SDavid du Colombier if(IsWeird(i))
137d11907f1SDavid du Colombier SetInfinity(i);
138d11907f1SDavid du Colombier }
139d11907f1SDavid du Colombier
140d11907f1SDavid du Colombier void
fpisub(Internal * x,Internal * y,Internal * i)141d11907f1SDavid du Colombier fpisub(Internal *x, Internal *y, Internal *i)
142d11907f1SDavid du Colombier {
143d11907f1SDavid du Colombier Internal *t;
144d11907f1SDavid du Colombier
145d11907f1SDavid du Colombier if(y->e < x->e
146d11907f1SDavid du Colombier || (y->e == x->e && (y->h < x->h || (y->h == x->h && y->l < x->l)))){
147d11907f1SDavid du Colombier t = x;
148d11907f1SDavid du Colombier x = y;
149d11907f1SDavid du Colombier y = t;
150d11907f1SDavid du Colombier }
151d11907f1SDavid du Colombier i->s = y->s;
152d11907f1SDavid du Colombier if(IsNaN(y)){
153d11907f1SDavid du Colombier SetQNaN(i);
154d11907f1SDavid du Colombier return;
155d11907f1SDavid du Colombier }
156d11907f1SDavid du Colombier if(IsInfinity(y)){
157d11907f1SDavid du Colombier if(IsInfinity(x))
158d11907f1SDavid du Colombier SetQNaN(i);
159d11907f1SDavid du Colombier else
160d11907f1SDavid du Colombier SetInfinity(i);
161d11907f1SDavid du Colombier return;
162d11907f1SDavid du Colombier }
163d11907f1SDavid du Colombier matchexponents(x, y);
164d11907f1SDavid du Colombier i->e = y->e;
165d11907f1SDavid du Colombier i->h = y->h - x->h;
166d11907f1SDavid du Colombier i->l = y->l - x->l;
167d11907f1SDavid du Colombier if(i->l < 0){
168d11907f1SDavid du Colombier i->l += CarryBit;
169d11907f1SDavid du Colombier i->h--;
170d11907f1SDavid du Colombier }
171d11907f1SDavid du Colombier if(i->h == 0 && i->l == 0)
172d11907f1SDavid du Colombier SetZero(i);
173d11907f1SDavid du Colombier else while(i->e > 1 && (i->h & HiddenBit) == 0)
174d11907f1SDavid du Colombier shift(i);
175d11907f1SDavid du Colombier }
176d11907f1SDavid du Colombier
177d11907f1SDavid du Colombier #define CHUNK (FractBits/2)
178d11907f1SDavid du Colombier #define CMASK ((1<<CHUNK)-1)
179d11907f1SDavid du Colombier #define HI(x) ((short)((x)>>CHUNK) & CMASK)
180d11907f1SDavid du Colombier #define LO(x) ((short)(x) & CMASK)
181d11907f1SDavid du Colombier #define SPILL(x) ((x)>>CHUNK)
182d11907f1SDavid du Colombier #define M(x, y) ((long)a[x]*(long)b[y])
183d11907f1SDavid du Colombier #define C(h, l) (((long)((h) & CMASK)<<CHUNK)|((l) & CMASK))
184d11907f1SDavid du Colombier
185d11907f1SDavid du Colombier void
fpimul(Internal * x,Internal * y,Internal * i)186d11907f1SDavid du Colombier fpimul(Internal *x, Internal *y, Internal *i)
187d11907f1SDavid du Colombier {
188d11907f1SDavid du Colombier long a[4], b[4], c[7], f[4];
189d11907f1SDavid du Colombier
190d11907f1SDavid du Colombier i->s = x->s^y->s;
191d11907f1SDavid du Colombier if(IsWeird(x) || IsWeird(y)){
192d11907f1SDavid du Colombier if(IsNaN(x) || IsNaN(y) || IsZero(x) || IsZero(y))
193d11907f1SDavid du Colombier SetQNaN(i);
194d11907f1SDavid du Colombier else
195d11907f1SDavid du Colombier SetInfinity(i);
196d11907f1SDavid du Colombier return;
197d11907f1SDavid du Colombier }
198d11907f1SDavid du Colombier else if(IsZero(x) || IsZero(y)){
199d11907f1SDavid du Colombier SetZero(i);
200d11907f1SDavid du Colombier return;
201d11907f1SDavid du Colombier }
202d11907f1SDavid du Colombier normalise(x);
203d11907f1SDavid du Colombier normalise(y);
204d11907f1SDavid du Colombier i->e = x->e + y->e - (ExpBias - 1);
205d11907f1SDavid du Colombier
206d11907f1SDavid du Colombier a[0] = HI(x->h); b[0] = HI(y->h);
207d11907f1SDavid du Colombier a[1] = LO(x->h); b[1] = LO(y->h);
208d11907f1SDavid du Colombier a[2] = HI(x->l); b[2] = HI(y->l);
209d11907f1SDavid du Colombier a[3] = LO(x->l); b[3] = LO(y->l);
210d11907f1SDavid du Colombier
211d11907f1SDavid du Colombier c[6] = M(3, 3);
212d11907f1SDavid du Colombier c[5] = M(2, 3) + M(3, 2) + SPILL(c[6]);
213d11907f1SDavid du Colombier c[4] = M(1, 3) + M(2, 2) + M(3, 1) + SPILL(c[5]);
214d11907f1SDavid du Colombier c[3] = M(0, 3) + M(1, 2) + M(2, 1) + M(3, 0) + SPILL(c[4]);
215d11907f1SDavid du Colombier c[2] = M(0, 2) + M(1, 1) + M(2, 0) + SPILL(c[3]);
216d11907f1SDavid du Colombier c[1] = M(0, 1) + M(1, 0) + SPILL(c[2]);
217d11907f1SDavid du Colombier c[0] = M(0, 0) + SPILL(c[1]);
218d11907f1SDavid du Colombier
219d11907f1SDavid du Colombier f[0] = c[0];
220d11907f1SDavid du Colombier f[1] = C(c[1], c[2]);
221d11907f1SDavid du Colombier f[2] = C(c[3], c[4]);
222d11907f1SDavid du Colombier f[3] = C(c[5], c[6]);
223d11907f1SDavid du Colombier
224d11907f1SDavid du Colombier if((f[0] & HiddenBit) == 0){
225d11907f1SDavid du Colombier f[0] <<= 1;
226d11907f1SDavid du Colombier f[1] <<= 1;
227d11907f1SDavid du Colombier f[2] <<= 1;
228d11907f1SDavid du Colombier f[3] <<= 1;
229d11907f1SDavid du Colombier if(f[1] & CarryBit){
230d11907f1SDavid du Colombier f[0] |= 1;
231d11907f1SDavid du Colombier f[1] &= ~CarryBit;
232d11907f1SDavid du Colombier }
233d11907f1SDavid du Colombier if(f[2] & CarryBit){
234d11907f1SDavid du Colombier f[1] |= 1;
235d11907f1SDavid du Colombier f[2] &= ~CarryBit;
236d11907f1SDavid du Colombier }
237d11907f1SDavid du Colombier if(f[3] & CarryBit){
238d11907f1SDavid du Colombier f[2] |= 1;
239d11907f1SDavid du Colombier f[3] &= ~CarryBit;
240d11907f1SDavid du Colombier }
241d11907f1SDavid du Colombier i->e--;
242d11907f1SDavid du Colombier }
243d11907f1SDavid du Colombier i->h = f[0];
244d11907f1SDavid du Colombier i->l = f[1];
245d11907f1SDavid du Colombier if(f[2] || f[3])
246d11907f1SDavid du Colombier i->l |= 1;
247d11907f1SDavid du Colombier renormalise(i);
248d11907f1SDavid du Colombier }
249d11907f1SDavid du Colombier
250d11907f1SDavid du Colombier void
fpidiv(Internal * x,Internal * y,Internal * i)251d11907f1SDavid du Colombier fpidiv(Internal *x, Internal *y, Internal *i)
252d11907f1SDavid du Colombier {
253d11907f1SDavid du Colombier i->s = x->s^y->s;
254d11907f1SDavid du Colombier if(IsNaN(x) || IsNaN(y)
255d11907f1SDavid du Colombier || (IsInfinity(x) && IsInfinity(y)) || (IsZero(x) && IsZero(y))){
256d11907f1SDavid du Colombier SetQNaN(i);
257d11907f1SDavid du Colombier return;
258d11907f1SDavid du Colombier }
259d11907f1SDavid du Colombier else if(IsZero(x) || IsInfinity(y)){
260d11907f1SDavid du Colombier SetInfinity(i);
261d11907f1SDavid du Colombier return;
262d11907f1SDavid du Colombier }
263d11907f1SDavid du Colombier else if(IsInfinity(x) || IsZero(y)){
264d11907f1SDavid du Colombier SetZero(i);
265d11907f1SDavid du Colombier return;
266d11907f1SDavid du Colombier }
267d11907f1SDavid du Colombier normalise(x);
268d11907f1SDavid du Colombier normalise(y);
269d11907f1SDavid du Colombier i->h = 0;
270d11907f1SDavid du Colombier i->l = 0;
271d11907f1SDavid du Colombier i->e = y->e - x->e + (ExpBias + 2*FractBits - 1);
272d11907f1SDavid du Colombier do{
273d11907f1SDavid du Colombier if(y->h > x->h || (y->h == x->h && y->l >= x->l)){
274d11907f1SDavid du Colombier i->l |= 0x01;
275d11907f1SDavid du Colombier y->h -= x->h;
276d11907f1SDavid du Colombier y->l -= x->l;
277d11907f1SDavid du Colombier if(y->l < 0){
278d11907f1SDavid du Colombier y->l += CarryBit;
279d11907f1SDavid du Colombier y->h--;
280d11907f1SDavid du Colombier }
281d11907f1SDavid du Colombier }
282d11907f1SDavid du Colombier shift(y);
283d11907f1SDavid du Colombier shift(i);
284d11907f1SDavid du Colombier }while ((i->h & HiddenBit) == 0);
285d11907f1SDavid du Colombier if(y->h || y->l)
286d11907f1SDavid du Colombier i->l |= 0x01;
287d11907f1SDavid du Colombier renormalise(i);
288d11907f1SDavid du Colombier }
289d11907f1SDavid du Colombier
290d11907f1SDavid du Colombier int
fpicmp(Internal * x,Internal * y)291d11907f1SDavid du Colombier fpicmp(Internal *x, Internal *y)
292d11907f1SDavid du Colombier {
293d11907f1SDavid du Colombier if(IsNaN(x) && IsNaN(y))
294d11907f1SDavid du Colombier return 0;
295d11907f1SDavid du Colombier if(IsInfinity(x) && IsInfinity(y))
296d11907f1SDavid du Colombier return y->s - x->s;
29782726826SDavid du Colombier if(IsZero(x) && IsZero(y))
29882726826SDavid du Colombier return 0;
299d11907f1SDavid du Colombier if(x->e == y->e && x->h == y->h && x->l == y->l)
300d11907f1SDavid du Colombier return y->s - x->s;
301d11907f1SDavid du Colombier if(x->e < y->e
302d11907f1SDavid du Colombier || (x->e == y->e && (x->h < y->h || (x->h == y->h && x->l < y->l))))
303d11907f1SDavid du Colombier return y->s ? 1: -1;
304d11907f1SDavid du Colombier return x->s ? -1: 1;
305d11907f1SDavid du Colombier }
306