ulp.c revision 1.1.1.2 1 1.1 kleink /****************************************************************
2 1.1 kleink
3 1.1 kleink The author of this software is David M. Gay.
4 1.1 kleink
5 1.1 kleink Copyright (C) 1998, 1999 by Lucent Technologies
6 1.1 kleink All Rights Reserved
7 1.1 kleink
8 1.1 kleink Permission to use, copy, modify, and distribute this software and
9 1.1 kleink its documentation for any purpose and without fee is hereby
10 1.1 kleink granted, provided that the above copyright notice appear in all
11 1.1 kleink copies and that both that the copyright notice and this
12 1.1 kleink permission notice and warranty disclaimer appear in supporting
13 1.1 kleink documentation, and that the name of Lucent or any of its entities
14 1.1 kleink not be used in advertising or publicity pertaining to
15 1.1 kleink distribution of the software without specific, written prior
16 1.1 kleink permission.
17 1.1 kleink
18 1.1 kleink LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
19 1.1 kleink INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
20 1.1 kleink IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
21 1.1 kleink SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22 1.1 kleink WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
23 1.1 kleink IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24 1.1 kleink ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25 1.1 kleink THIS SOFTWARE.
26 1.1 kleink
27 1.1 kleink ****************************************************************/
28 1.1 kleink
29 1.1 kleink /* Please send bug reports to David M. Gay (dmg at acm dot org,
30 1.1 kleink * with " at " changed at "@" and " dot " changed to "."). */
31 1.1 kleink
32 1.1 kleink #include "gdtoaimp.h"
33 1.1 kleink
34 1.1 kleink double
35 1.1 kleink ulp
36 1.1 kleink #ifdef KR_headers
37 1.1.1.2 christos (x) U *x;
38 1.1 kleink #else
39 1.1.1.2 christos (U *x)
40 1.1 kleink #endif
41 1.1 kleink {
42 1.1 kleink Long L;
43 1.1.1.2 christos U a;
44 1.1 kleink
45 1.1 kleink L = (word0(x) & Exp_mask) - (P-1)*Exp_msk1;
46 1.1 kleink #ifndef Sudden_Underflow
47 1.1 kleink if (L > 0) {
48 1.1 kleink #endif
49 1.1 kleink #ifdef IBM
50 1.1 kleink L |= Exp_msk1 >> 4;
51 1.1 kleink #endif
52 1.1.1.2 christos word0(&a) = L;
53 1.1.1.2 christos word1(&a) = 0;
54 1.1 kleink #ifndef Sudden_Underflow
55 1.1 kleink }
56 1.1 kleink else {
57 1.1 kleink L = -L >> Exp_shift;
58 1.1 kleink if (L < Exp_shift) {
59 1.1.1.2 christos word0(&a) = 0x80000 >> L;
60 1.1.1.2 christos word1(&a) = 0;
61 1.1 kleink }
62 1.1 kleink else {
63 1.1.1.2 christos word0(&a) = 0;
64 1.1 kleink L -= Exp_shift;
65 1.1.1.2 christos word1(&a) = L >= 31 ? 1 : 1 << (31 - L);
66 1.1 kleink }
67 1.1 kleink }
68 1.1 kleink #endif
69 1.1.1.2 christos return dval(&a);
70 1.1 kleink }
71