1 C This testcase was miscompiled on i?86/x86_64, the scheduler
2 C swapped write to DMACH(1) with following read from SMALL(1),
3 C at -O2+, as the front-end didn't signal in any way this kind
4 C of type punning is ok.
5 C The testcase is from blas, http://www.netlib.org/blas/d1mach.f
7 DOUBLE PRECISION FUNCTION D1MACH
(I
)
10 C DOUBLE-PRECISION MACHINE CONSTANTS
11 C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
12 C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
13 C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
14 C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
15 C D1MACH( 5) = LOG10(B)
22 INTEGER*4 SC
, CRAY1
(38), J
24 SAVE SMALL
, LARGE
, RIGHT
, DIVER
, LOG10
, SC
25 DOUBLE PRECISION DMACH
(5)
26 EQUIVALENCE
(DMACH
(1),SMALL
(1))
27 EQUIVALENCE
(DMACH
(2),LARGE
(1))
28 EQUIVALENCE
(DMACH
(3),RIGHT
(1))
29 EQUIVALENCE
(DMACH
(4),DIVER
(1))
30 EQUIVALENCE
(DMACH
(5),LOG10
(1))
31 C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES.
32 C R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF
33 C D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR
35 C TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
38 C AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW.
39 C CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY
40 C mail netlib@research.bell-labs.com
41 C send old1mach from blas
42 C PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com.
44 C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
45 C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 /
46 C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 /
47 C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 /
48 C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 /
49 C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/
51 C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
53 C DATA SMALL(1),SMALL(2) / 8388608, 0 /
54 C DATA LARGE(1),LARGE(2) / 2147483647, -1 /
55 C DATA RIGHT(1),RIGHT(2) / 612368384, 0 /
56 C DATA DIVER(1),DIVER(2) / 620756992, 0 /
57 C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/
59 C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
60 C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 /
61 C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 /
62 C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 /
63 C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 /
64 C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/
66 C ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES.
69 IF ( SMALL
(1) .EQ
. 1117925532
70 * .AND
. SMALL
(2) .EQ
. -448790528) THEN
71 * *** IEEE BIG ENDIAN
***
82 ELSE IF ( SMALL
(2) .EQ
. 1117925532
83 * .AND
. SMALL
(1) .EQ
. -448790528) THEN
84 * *** IEEE LITTLE ENDIAN
***
95 ELSE IF ( SMALL
(1) .EQ
. -2065213935
96 * .AND
. SMALL
(2) .EQ
. 10752) THEN
97 * *** VAX WITH D_FLOATING
***
107 LOG10
(2) = -805796613
108 ELSE IF ( SMALL
(1) .EQ
. 1267827943
109 * .AND
. SMALL
(2) .EQ
. 704643072) THEN
110 * *** IBM MAINFRAME
***
113 LARGE
(1) = 2147483647
119 LOG10
(1) = 1091781651
120 LOG10
(2) = 1352628735
121 ELSE IF ( SMALL
(1) .EQ
. 1120022684
122 * .AND
. SMALL
(2) .EQ
. -448790528) THEN
126 LARGE
(1) = 2147483647
128 RIGHT
(1) = 1019215872
130 DIVER
(1) = 1020264448
132 LOG10
(1) = 1072907283
133 LOG10
(2) = 1352628735
134 ELSE IF ( SMALL
(1) .EQ
. 815547074
135 * .AND
. SMALL
(2) .EQ
. 58688) THEN
136 * *** VAX G
-FLOATING
***
145 LOG10
(1) = 1142112243
146 LOG10
(2) = 2046775455
150 LARGE
(2) = LARGE
(2) - RIGHT
(2)
151 IF (LARGE
(2) .EQ
. 64 .AND
. SMALL
(2) .EQ
. 0) THEN
154 CRAY1
(J
+1) = CRAY1
(J
) + CRAY1
(J
)
156 CRAY1
(22) = CRAY1
(21) + 321322
158 CRAY1
(J
+1) = CRAY1
(J
) + CRAY1
(J
)
160 IF (CRAY1
(38) .EQ
. SMALL
(1)) THEN
162 CALL I1MCRY
(SMALL
(1), J
, 8285, 8388608, 0)
164 CALL I1MCRY
(LARGE
(1), J
, 24574, 16777215, 16777215)
165 CALL I1MCRY
(LARGE
(2), J
, 0, 16777215, 16777214)
166 CALL I1MCRY
(RIGHT
(1), J
, 16291, 8388608, 0)
168 CALL I1MCRY
(DIVER
(1), J
, 16292, 8388608, 0)
170 CALL I1MCRY
(LOG10
(1), J
, 16383, 10100890, 8715215)
171 CALL I1MCRY
(LOG10
(2), J
, 0, 16226447, 9001388)
184 IF (DMACH
(4) .GE
. 1.0D0
) STOP 778
185 IF (I
.LT
. 1 .OR
. I
.GT
. 5) THEN
186 WRITE(*,*) 'D1MACH(I): I =',I
,' is out of bounds.'
191 9000 FORMAT(/' Adjust D1MACH by uncommenting data statements'/
192 *' appropriate for your machine.')
193 * /* Standard C source
for D1MACH
-- remove the
* in column
1 */
197 *double d1mach_
(long
*i
)
200 * case
1: return DBL_MIN
;
201 * case
2: return DBL_MAX
;
202 * case
3: return DBL_EPSILON
/FLT_RADIX
;
203 * case
4: return DBL_EPSILON
;
204 * case
5: return log10
((double)FLT_RADIX
);
206 * fprintf
(stderr
, "invalid argument: d1mach(%ld)\n", *i
);
207 * exit
(1); return 0; /* some compilers demand
return values
*/
210 SUBROUTINE I1MCRY
(A
, A1
, B
, C
, D
)
211 **** SPECIAL COMPUTATION
FOR OLD CRAY MACHINES
****
212 INTEGER*4 A
, A1
, B
, C
, D
218 DOUBLE PRECISION D1MACH