File: class.c

package info (click to toggle)
mlton 20041109-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,212 kB
  • ctags: 58,085
  • sloc: ansic: 10,386; makefile: 1,178; sh: 1,139; pascal: 256; asm: 97
file content (161 lines) | stat: -rw-r--r-- 3,999 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
#include "platform.h"

#if (defined __sparc__)
#include <ieeefp.h>
#endif

enum {
	DEBUG_REAL_CLASS = FALSE,
};

/* All this code assumes IEEE 754/854 and little endian.
 *
 * In memory, the 64 bits of a double are layed out as follows.
 *
 * d[0]  bits 7-0 of mantissa
 * d[1]  bits 15-8 of mantissa
 * d[2]  bits 23-16 of mantissa
 * d[3]  bits 31-24 of mantissa
 * d[4]  bits 39-32 of mantissa
 * d[5]  bits 47-40 of mantissa
 * d[6]  bits 3-0 of exponent
 *       bits 51-48 of mantissa
 * d[7]  sign bit
 *       bits 10-4 of exponent
 *
 *
 * In memory, the 32 bits of a float are layed out as follows.
 *
 * d[0]  bits 7-0 of mantissa
 * d[1]  bits 15-8 of mantissa
 * d[2]  bit  0 of exponent
 *       bits 22-16 of mantissa
 * d[7]  sign bit
 *       bits 7-2 of exponent
 */

#define Real_Class_nanQuiet 0
#define Real_Class_nanSignalling 1
#define Real_Class_inf 2
#define Real_Class_zero 3
#define Real_Class_normal 4
#define Real_Class_subnormal 5

#if (defined __i386__)

/* masks for word 1 */
#define EXPONENT_MASK64 0x7FF00000
#define MANTISSA_MASK64 0x000FFFFF
#define SIGNBIT_MASK64  0x80000000
#define MANTISSA_HIGHBIT_MASK64 0x00080000

Int Real64_class (Real64 d) {
	Word word0, word1;
	Int res;

	word0 = ((Word *)&d)[0];
	word1 = ((Word *)&d)[1];
	
	if ((word1 & EXPONENT_MASK64) == EXPONENT_MASK64) {
		/* NAN_QUIET, NAN_SIGNALLING, or INF */
		if (word0 or (word1 & MANTISSA_MASK64)) {
			/* NAN_QUIET or NAN_SIGNALLING -- look at the highest bit of mantissa */
			if (word1 & MANTISSA_HIGHBIT_MASK64)
				res = Real_Class_nanQuiet;
			else
				res = Real_Class_nanSignalling;
		} else
			res = Real_Class_inf;
	} else {
		/* ZERO, NORMAL, or SUBNORMAL */
		if (word1 & EXPONENT_MASK64)
       			res = Real_Class_normal;
		else if (word0 or (word1 & MANTISSA_MASK64))
			res = Real_Class_subnormal;
		else
			res = Real_Class_zero;
	}
	if (DEBUG_REAL_CLASS)
		fprintf (stderr, "%d = Real64_class ()\n", (int)res);
	return res;
}

#elif (defined __ppc__ && defined __Darwin__)

Int Real64_class (Real64 d) {
	int c = fpclassify (d);
	switch (c) {
		/* FIXME: not distinguishing between nanSignalling and nanQuiet */
		case FP_NAN:		return Real_Class_nanQuiet;
		case FP_INFINITE:	return Real_Class_inf;
		case FP_ZERO:		return Real_Class_zero;
		case FP_NORMAL:		return Real_Class_normal;
		case FP_SUBNORMAL:	return Real_Class_subnormal;
		default: die("Real_class error: invalid class %d\n", c);
	}
}


#elif (defined __sparc__)

Int Real64_class (Real64 d) {
	fpclass_t c;

	c = fpclass (d);
	switch (c) {
	case FP_SNAN: return Real_Class_nanSignalling;
	case FP_QNAN: return Real_Class_nanQuiet;
	case FP_NINF: return Real_Class_inf;
	case FP_PINF: return Real_Class_inf;
	case FP_NDENORM: return Real_Class_subnormal;
	case FP_PDENORM: return Real_Class_subnormal;
	case FP_NZERO: return Real_Class_zero;
	case FP_PZERO: return Real_Class_zero;
	case FP_NNORM: return Real_Class_normal;
	case FP_PNORM: return Real_Class_normal;
	default:
		die ("Real_class error: invalid class %d\n", c);
	}
}

#else

#error Real64_class not implemented

#endif

/* masks for word 0 */
#define EXPONENT_MASK32 0x7F800000
#define MANTISSA_MASK32 0x007FFFFF
#define SIGNBIT_MASK32  0x80000000
#define MANTISSA_HIGHBIT_MASK32 0x00400000

Int Real32_class (Real32 f) {
	Word word0;
	Int res;

	word0 = ((Word *)&f)[0];
	
	if ((word0 & EXPONENT_MASK32) == EXPONENT_MASK32) {
		/* NAN_QUIET, NAN_SIGNALLING, or INF */
		if (word0 & MANTISSA_MASK32) {
			/* NAN_QUIET or NAN_SIGNALLING -- look at the highest bit of mantissa */
			if (word0 & MANTISSA_HIGHBIT_MASK32)
				res = Real_Class_nanQuiet;
			else
				res = Real_Class_nanSignalling;
		} else
			res = Real_Class_inf;
	} else {
		/* ZERO, NORMAL, or SUBNORMAL */
		if (word0 & EXPONENT_MASK32)
       			res = Real_Class_normal;
		else if (word0 & MANTISSA_MASK32)
			res = Real_Class_subnormal;
		else
			res = Real_Class_zero;
	}
	if (DEBUG_REAL_CLASS)
		fprintf (stderr, "%d = Real32_class (%g)\n", (int)res, f);
	return res;
}