Skip to content

R
riscv-gcc-1
Commit 7b9c708f by Jakub Jelinek Committed by Jakub Jelinek
Options

f95-lang.c (gfc_get_alias_set): New function. 

	* f95-lang.c (gfc_get_alias_set): New function.
	(LANG_HOOKS_GET_ALIAS_SET): Define.

	* gfortran.fortran-torture/execute/equiv_5.f: New test.

From-SVN: r112416
parent b78c0542
Showing with 255 additions and 0 deletions
gcc/fortran/ChangeLog
2006-03-27 Jakub Jelinek <jakub@redhat.com>
* f95-lang.c (gfc_get_alias_set): New function.
(LANG_HOOKS_GET_ALIAS_SET): Define.
2006-03-25 Steven G. Kargl <kargls@comcast.net> 2006-03-25 Steven G. Kargl <kargls@comcast.net>
PR fortran/26816 PR fortran/26816
......
gcc/fortran/f95-lang.c
...@@ -99,6 +99,7 @@ void insert_block (tree); ...@@ -99,6 +99,7 @@ void insert_block (tree);
static void gfc_clear_binding_stack (void); static void gfc_clear_binding_stack (void);
static void gfc_be_parse_file (int); static void gfc_be_parse_file (int);
static void gfc_expand_function (tree); static void gfc_expand_function (tree);
static HOST_WIDE_INT gfc_get_alias_set (tree);
#undef LANG_HOOKS_NAME #undef LANG_HOOKS_NAME
#undef LANG_HOOKS_INIT #undef LANG_HOOKS_INIT
...@@ -116,6 +117,7 @@ static void gfc_expand_function (tree); ...@@ -116,6 +117,7 @@ static void gfc_expand_function (tree);
#undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
#undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
#undef LANG_HOOKS_CLEAR_BINDING_STACK #undef LANG_HOOKS_CLEAR_BINDING_STACK
#undef LANG_HOOKS_GET_ALIAS_SET
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
...@@ -139,6 +141,7 @@ static void gfc_expand_function (tree); ...@@ -139,6 +141,7 @@ static void gfc_expand_function (tree);
#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type
#define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function
#define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack #define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack
#define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
#define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
#define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
...@@ -694,6 +697,24 @@ gfc_mark_addressable (tree exp) ...@@ -694,6 +697,24 @@ gfc_mark_addressable (tree exp)
} }
} }
/* Return the typed-based alias set for T, which may be an expression
or a type. Return -1 if we don't do anything special. */
static HOST_WIDE_INT
gfc_get_alias_set (tree t)
{
tree u;
/* Permit type-punning when accessing an EQUIVALENCEd variable or
mixed type entry master's return value. */
for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
if (TREE_CODE (u) == COMPONENT_REF
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
return 0;
return -1;
}
/* press the big red button - garbage (ggc) collection is on */ /* press the big red button - garbage (ggc) collection is on */
int ggc_p = 1; int ggc_p = 1;
......
gcc/testsuite/ChangeLog
2006-03-27 Jakub Jelinek <jakub@redhat.com>
* gfortran.fortran-torture/execute/equiv_5.f: New test.
2006-03-26 Jerry DeLisle <jvdelisle@gcc.gnu.org> 2006-03-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/26661 PR libgfortran/26661
gcc/testsuite/gfortran.fortran-torture/execute/equiv_5.f 0 → 100644
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment