OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [equiv_5.f] - Blame information for rev 717

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 695 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*4 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*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))
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 INTEGER*4S.
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*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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.