| 1 |
149 |
jeremybenn |
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
|
| 6 |
|
|
|
| 7 |
|
|
DOUBLE PRECISION FUNCTION D1MACH(I)
|
| 8 |
|
|
INTEGER I
|
| 9 |
|
|
C
|
| 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)
|
| 16 |
|
|
C
|
| 17 |
|
|
INTEGER SMALL(2)
|
| 18 |
|
|
INTEGER LARGE(2)
|
| 19 |
|
|
INTEGER RIGHT(2)
|
| 20 |
|
|
INTEGER DIVER(2)
|
| 21 |
|
|
INTEGER LOG10(2)
|
| 22 |
|
|
INTEGER 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))
|
| 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
|
| 34 |
|
|
C MANY MACHINES YET.
|
| 35 |
|
|
C TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
|
| 36 |
|
|
C ON THE NEXT LINE
|
| 37 |
|
|
DATA SC/0/
|
| 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.
|
| 43 |
|
|
C
|
| 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/
|
| 50 |
|
|
C
|
| 51 |
|
|
C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
|
| 52 |
|
|
C 32-BIT INTEGERS.
|
| 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/
|
| 58 |
|
|
C
|
| 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/
|
| 65 |
|
|
C
|
| 66 |
|
|
C 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 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
|
