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