| C This testcase was miscompiled on i?86/x86_64, the scheduler |
| C swapped write to DMACH(1) with following read from SMALL(1), |
| C at -O2+, as the front-end didn't signal in any way this kind |
| C of type punning is ok. |
| C The testcase is from blas, http://www.netlib.org/blas/d1mach.f |
| |
| DOUBLE PRECISION FUNCTION D1MACH(I) |
| INTEGER I |
| C |
| C DOUBLE-PRECISION MACHINE CONSTANTS |
| C D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE. |
| C D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE. |
| C D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING. |
| C D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING. |
| C D1MACH( 5) = LOG10(B) |
| C |
| INTEGER SMALL(2) |
| INTEGER LARGE(2) |
| INTEGER RIGHT(2) |
| INTEGER DIVER(2) |
| INTEGER LOG10(2) |
| INTEGER SC, CRAY1(38), J |
| COMMON /D9MACH/ CRAY1 |
| SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC |
| DOUBLE PRECISION DMACH(5) |
| EQUIVALENCE (DMACH(1),SMALL(1)) |
| EQUIVALENCE (DMACH(2),LARGE(1)) |
| EQUIVALENCE (DMACH(3),RIGHT(1)) |
| EQUIVALENCE (DMACH(4),DIVER(1)) |
| EQUIVALENCE (DMACH(5),LOG10(1)) |
| C THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES. |
| C R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF |
| C D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR |
| C MANY MACHINES YET. |
| C TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1 |
| C ON THE NEXT LINE |
| DATA SC/0/ |
| C AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW. |
| C CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY |
| C mail netlib@research.bell-labs.com |
| C send old1mach from blas |
| C PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com. |
| C |
| C MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES. |
| C DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 / |
| C DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 / |
| C DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 / |
| C DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 / |
| C DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/ |
| C |
| C MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING |
| C 32-BIT INTEGERS. |
| C DATA SMALL(1),SMALL(2) / 8388608, 0 / |
| C DATA LARGE(1),LARGE(2) / 2147483647, -1 / |
| C DATA RIGHT(1),RIGHT(2) / 612368384, 0 / |
| C DATA DIVER(1),DIVER(2) / 620756992, 0 / |
| C DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/ |
| C |
| C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. |
| C DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 / |
| C DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 / |
| C DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 / |
| C DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 / |
| C DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/ |
| C |
| C ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES. |
| IF (SC .NE. 987) THEN |
| DMACH(1) = 1.D13 |
| IF ( SMALL(1) .EQ. 1117925532 |
| * .AND. SMALL(2) .EQ. -448790528) THEN |
| * *** IEEE BIG ENDIAN *** |
| SMALL(1) = 1048576 |
| SMALL(2) = 0 |
| LARGE(1) = 2146435071 |
| LARGE(2) = -1 |
| RIGHT(1) = 1017118720 |
| RIGHT(2) = 0 |
| DIVER(1) = 1018167296 |
| DIVER(2) = 0 |
| LOG10(1) = 1070810131 |
| LOG10(2) = 1352628735 |
| ELSE IF ( SMALL(2) .EQ. 1117925532 |
| * .AND. SMALL(1) .EQ. -448790528) THEN |
| * *** IEEE LITTLE ENDIAN *** |
| SMALL(2) = 1048576 |
| SMALL(1) = 0 |
| LARGE(2) = 2146435071 |
| LARGE(1) = -1 |
| RIGHT(2) = 1017118720 |
| RIGHT(1) = 0 |
| DIVER(2) = 1018167296 |
| DIVER(1) = 0 |
| LOG10(2) = 1070810131 |
| LOG10(1) = 1352628735 |
| ELSE IF ( SMALL(1) .EQ. -2065213935 |
| * .AND. SMALL(2) .EQ. 10752) THEN |
| * *** VAX WITH D_FLOATING *** |
| SMALL(1) = 128 |
| SMALL(2) = 0 |
| LARGE(1) = -32769 |
| LARGE(2) = -1 |
| RIGHT(1) = 9344 |
| RIGHT(2) = 0 |
| DIVER(1) = 9472 |
| DIVER(2) = 0 |
| LOG10(1) = 546979738 |
| LOG10(2) = -805796613 |
| ELSE IF ( SMALL(1) .EQ. 1267827943 |
| * .AND. SMALL(2) .EQ. 704643072) THEN |
| * *** IBM MAINFRAME *** |
| SMALL(1) = 1048576 |
| SMALL(2) = 0 |
| LARGE(1) = 2147483647 |
| LARGE(2) = -1 |
| RIGHT(1) = 856686592 |
| RIGHT(2) = 0 |
| DIVER(1) = 873463808 |
| DIVER(2) = 0 |
| LOG10(1) = 1091781651 |
| LOG10(2) = 1352628735 |
| ELSE IF ( SMALL(1) .EQ. 1120022684 |
| * .AND. SMALL(2) .EQ. -448790528) THEN |
| * *** CONVEX C-1 *** |
| SMALL(1) = 1048576 |
| SMALL(2) = 0 |
| LARGE(1) = 2147483647 |
| LARGE(2) = -1 |
| RIGHT(1) = 1019215872 |
| RIGHT(2) = 0 |
| DIVER(1) = 1020264448 |
| DIVER(2) = 0 |
| LOG10(1) = 1072907283 |
| LOG10(2) = 1352628735 |
| ELSE IF ( SMALL(1) .EQ. 815547074 |
| * .AND. SMALL(2) .EQ. 58688) THEN |
| * *** VAX G-FLOATING *** |
| SMALL(1) = 16 |
| SMALL(2) = 0 |
| LARGE(1) = -32769 |
| LARGE(2) = -1 |
| RIGHT(1) = 15552 |
| RIGHT(2) = 0 |
| DIVER(1) = 15568 |
| DIVER(2) = 0 |
| LOG10(1) = 1142112243 |
| LOG10(2) = 2046775455 |
| ELSE |
| DMACH(2) = 1.D27 + 1 |
| DMACH(3) = 1.D27 |
| LARGE(2) = LARGE(2) - RIGHT(2) |
| IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN |
| CRAY1(1) = 67291416 |
| DO 10 J = 1, 20 |
| CRAY1(J+1) = CRAY1(J) + CRAY1(J) |
| 10 CONTINUE |
| CRAY1(22) = CRAY1(21) + 321322 |
| DO 20 J = 22, 37 |
| CRAY1(J+1) = CRAY1(J) + CRAY1(J) |
| 20 CONTINUE |
| IF (CRAY1(38) .EQ. SMALL(1)) THEN |
| * *** CRAY *** |
| CALL I1MCRY(SMALL(1), J, 8285, 8388608, 0) |
| SMALL(2) = 0 |
| CALL I1MCRY(LARGE(1), J, 24574, 16777215, 16777215) |
| CALL I1MCRY(LARGE(2), J, 0, 16777215, 16777214) |
| CALL I1MCRY(RIGHT(1), J, 16291, 8388608, 0) |
| RIGHT(2) = 0 |
| CALL I1MCRY(DIVER(1), J, 16292, 8388608, 0) |
| DIVER(2) = 0 |
| CALL I1MCRY(LOG10(1), J, 16383, 10100890, 8715215) |
| CALL I1MCRY(LOG10(2), J, 0, 16226447, 9001388) |
| ELSE |
| WRITE(*,9000) |
| STOP 779 |
| END IF |
| ELSE |
| WRITE(*,9000) |
| STOP 779 |
| END IF |
| END IF |
| SC = 987 |
| END IF |
| * SANITY CHECK |
| IF (DMACH(4) .GE. 1.0D0) STOP 778 |
| IF (I .LT. 1 .OR. I .GT. 5) THEN |
| WRITE(*,*) 'D1MACH(I): I =',I,' is out of bounds.' |
| STOP |
| END IF |
| D1MACH = DMACH(I) |
| RETURN |
| 9000 FORMAT(/' Adjust D1MACH by uncommenting data statements'/ |
| *' appropriate for your machine.') |
| * /* Standard C source for D1MACH -- remove the * in column 1 */ |
| *#include <stdio.h> |
| *#include <float.h> |
| *#include <math.h> |
| *double d1mach_(long *i) |
| *{ |
| * switch(*i){ |
| * case 1: return DBL_MIN; |
| * case 2: return DBL_MAX; |
| * case 3: return DBL_EPSILON/FLT_RADIX; |
| * case 4: return DBL_EPSILON; |
| * case 5: return log10((double)FLT_RADIX); |
| * } |
| * fprintf(stderr, "invalid argument: d1mach(%ld)\n", *i); |
| * exit(1); return 0; /* some compilers demand return values */ |
| *} |
| END |
| SUBROUTINE I1MCRY(A, A1, B, C, D) |
| **** SPECIAL COMPUTATION FOR OLD CRAY MACHINES **** |
| INTEGER A, A1, B, C, D |
| A1 = 16777216*B + C |
| A = 16777216*A1 + D |
| END |
| |
| PROGRAM MAIN |
| DOUBLE PRECISION D1MACH |
| EXTERNAL D1MACH |
| PRINT *,D1MACH(1) |
| PRINT *,D1MACH(2) |
| PRINT *,D1MACH(3) |
| PRINT *,D1MACH(4) |
| PRINT *,D1MACH(5) |
| END |