1C  This testcase was miscompiled on i?86/x86_64, the scheduler
2C  swapped write to DMACH(1) with following read from SMALL(1),
3C  at -O2+, as the front-end didn't signal in any way this kind
4C  of type punning is ok.
5C  The testcase is from blas, http://www.netlib.org/blas/d1mach.f
6
7      DOUBLE PRECISION FUNCTION D1MACH(I)
8      INTEGER*4 I
9C
10C  DOUBLE-PRECISION MACHINE CONSTANTS
11C  D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
12C  D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
13C  D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
14C  D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
15C  D1MACH( 5) = LOG10(B)
16C
17      INTEGER*4 SMALL(2)
18      INTEGER*4 LARGE(2)
19      INTEGER*4 RIGHT(2)
20      INTEGER*4 DIVER(2)
21      INTEGER*4 LOG10(2)
22      INTEGER*4 SC, CRAY1(38), J
23      COMMON /D9MACH/ CRAY1
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))
31C  THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES.
32C  R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF
33C  D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR
34C  MANY MACHINES YET.
35C  TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
36C  ON THE NEXT LINE
37      DATA SC/0/
38C  AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW.
39C  CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY
40C          mail netlib@research.bell-labs.com
41C          send old1mach from blas
42C  PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com.
43C
44C     MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
45C      DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 /
46C      DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 /
47C      DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 /
48C      DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 /
49C      DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/
50C
51C     MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
52C     32-BIT INTEGER*4S.
53C      DATA SMALL(1),SMALL(2) /    8388608,           0 /
54C      DATA LARGE(1),LARGE(2) / 2147483647,          -1 /
55C      DATA RIGHT(1),RIGHT(2) /  612368384,           0 /
56C      DATA DIVER(1),DIVER(2) /  620756992,           0 /
57C      DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/
58C
59C     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
60C      DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 /
61C      DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 /
62C      DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 /
63C      DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 /
64C      DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/
65C
66C     ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES.
67      IF (SC .NE. 987) THEN
68         DMACH(1) = 1.D13
69         IF (      SMALL(1) .EQ. 1117925532
70     *       .AND. SMALL(2) .EQ. -448790528) THEN
71*           *** IEEE BIG ENDIAN ***
72            SMALL(1) = 1048576
73            SMALL(2) = 0
74            LARGE(1) = 2146435071
75            LARGE(2) = -1
76            RIGHT(1) = 1017118720
77            RIGHT(2) = 0
78            DIVER(1) = 1018167296
79            DIVER(2) = 0
80            LOG10(1) = 1070810131
81            LOG10(2) = 1352628735
82         ELSE IF ( SMALL(2) .EQ. 1117925532
83     *       .AND. SMALL(1) .EQ. -448790528) THEN
84*           *** IEEE LITTLE ENDIAN ***
85            SMALL(2) = 1048576
86            SMALL(1) = 0
87            LARGE(2) = 2146435071
88            LARGE(1) = -1
89            RIGHT(2) = 1017118720
90            RIGHT(1) = 0
91            DIVER(2) = 1018167296
92            DIVER(1) = 0
93            LOG10(2) = 1070810131
94            LOG10(1) = 1352628735
95         ELSE IF ( SMALL(1) .EQ. -2065213935
96     *       .AND. SMALL(2) .EQ. 10752) THEN
97*               *** VAX WITH D_FLOATING ***
98            SMALL(1) = 128
99            SMALL(2) = 0
100            LARGE(1) = -32769
101            LARGE(2) = -1
102            RIGHT(1) = 9344
103            RIGHT(2) = 0
104            DIVER(1) = 9472
105            DIVER(2) = 0
106            LOG10(1) = 546979738
107            LOG10(2) = -805796613
108         ELSE IF ( SMALL(1) .EQ. 1267827943
109     *       .AND. SMALL(2) .EQ. 704643072) THEN
110*               *** IBM MAINFRAME ***
111            SMALL(1) = 1048576
112            SMALL(2) = 0
113            LARGE(1) = 2147483647
114            LARGE(2) = -1
115            RIGHT(1) = 856686592
116            RIGHT(2) = 0
117            DIVER(1) = 873463808
118            DIVER(2) = 0
119            LOG10(1) = 1091781651
120            LOG10(2) = 1352628735
121         ELSE IF ( SMALL(1) .EQ. 1120022684
122     *       .AND. SMALL(2) .EQ. -448790528) THEN
123*           *** CONVEX C-1 ***
124            SMALL(1) = 1048576
125            SMALL(2) = 0
126            LARGE(1) = 2147483647
127            LARGE(2) = -1
128            RIGHT(1) = 1019215872
129            RIGHT(2) = 0
130            DIVER(1) = 1020264448
131            DIVER(2) = 0
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 ***
137            SMALL(1) = 16
138            SMALL(2) = 0
139            LARGE(1) = -32769
140            LARGE(2) = -1
141            RIGHT(1) = 15552
142            RIGHT(2) = 0
143            DIVER(1) = 15568
144            DIVER(2) = 0
145            LOG10(1) = 1142112243
146            LOG10(2) = 2046775455
147         ELSE
148            DMACH(2) = 1.D27 + 1
149            DMACH(3) = 1.D27
150            LARGE(2) = LARGE(2) - RIGHT(2)
151            IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN
152               CRAY1(1) = 67291416
153               DO 10 J = 1, 20
154                  CRAY1(J+1) = CRAY1(J) + CRAY1(J)
155 10               CONTINUE
156               CRAY1(22) = CRAY1(21) + 321322
157               DO 20 J = 22, 37
158                  CRAY1(J+1) = CRAY1(J) + CRAY1(J)
159 20               CONTINUE
160               IF (CRAY1(38) .EQ. SMALL(1)) THEN
161*                  *** CRAY ***
162                  CALL I1MCRY(SMALL(1), J, 8285, 8388608, 0)
163                  SMALL(2) = 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)
167                  RIGHT(2) = 0
168                  CALL I1MCRY(DIVER(1), J, 16292, 8388608, 0)
169                  DIVER(2) = 0
170                  CALL I1MCRY(LOG10(1), J, 16383, 10100890, 8715215)
171                  CALL I1MCRY(LOG10(2), J, 0, 16226447, 9001388)
172               ELSE
173                  WRITE(*,9000)
174                  STOP 779
175                  END IF
176            ELSE
177               WRITE(*,9000)
178               STOP 779
179               END IF
180            END IF
181         SC = 987
182         END IF
183*    SANITY CHECK
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.'
187         STOP
188         END IF
189      D1MACH = DMACH(I)
190      RETURN
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 */
194*#include <stdio.h>
195*#include <float.h>
196*#include <math.h>
197*double d1mach_(long *i)
198*{
199*	switch(*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);
205*	  }
206*	fprintf(stderr, "invalid argument: d1mach(%ld)\n", *i);
207*	exit(1); return 0; /* some compilers demand return values */
208*}
209      END
210      SUBROUTINE I1MCRY(A, A1, B, C, D)
211**** SPECIAL COMPUTATION FOR OLD CRAY MACHINES ****
212      INTEGER*4 A, A1, B, C, D
213      A1 = 16777216*B + C
214      A = 16777216*A1 + D
215      END
216
217      PROGRAM MAIN
218      DOUBLE PRECISION D1MACH
219      EXTERNAL D1MACH
220      PRINT *,D1MACH(1)
221      PRINT *,D1MACH(2)
222      PRINT *,D1MACH(3)
223      PRINT *,D1MACH(4)
224      PRINT *,D1MACH(5)
225      END
226