This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
stick addressable constants into the constant pool
- From: Richard Henderson <rth at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Fri, 30 Jul 2004 16:06:53 -0700
- Subject: stick addressable constants into the constant pool
This is a problem that Fortran faces more than most, because argument
passing is, by default, by reference. The difference in code generation
can be seen in, e.g., intrinsic_scale.f90:
before:
leal -28(%ebp), %eax
movl $0x00000000, -32(%ebp)
movl %eax, 4(%esp)
movl $3, -28(%ebp)
leal -32(%ebp), %eax
movl %eax, (%esp)
call test_real4__
leal -36(%ebp), %eax
movl $0, -48(%ebp)
movl %eax, 4(%esp)
movl $0, -44(%ebp)
leal -48(%ebp), %eax
movl $3, -36(%ebp)
movl %eax, (%esp)
call test_real8__
after:
movl $.LC5, 4(%esp)
movl $.LC6, (%esp)
call test_real4__
movl $.LC5, 4(%esp)
movl $.LC7, (%esp)
call test_real8__
This did show up two testsuite bugs, which wrote to arguments that
were given as constants. Which now gives a SEGV, since Linux puts
the constant pool in read-only memory. I guess we'll have to see
how much trouble this give us with dusty decks...
r~
* gimplify.c (gimplify_expr) <case CONST_DECL>: Don't replace
with DECL_INITIAL if fb_lvalue.
* tree-gimple.c (is_gimple_id): Add CONST_DECL.
* tree-pretty-print.c (dump_decl_name): Dump unnamed CONST_DECL
with <Cxxx>.
* tree-ssa-ccp.c (maybe_fold_stmt_indirect): Fold CONST_DECL.
fortran/
* trans-expr.c (gfc_conv_expr_reference): Create a CONST_DECL
for TREE_CONSTANTs.
testsuite/
* gfortran.fortran-torture/execute/intrinsic_rrspacing.f90: Fix
write to constant argument.
* gfortran.fortran-torture/execute/intrinsic_scale.f90: Likewise.
Index: gimplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/gimplify.c,v
retrieving revision 2.56
diff -c -p -d -u -r2.56 gimplify.c
--- gimplify.c 28 Jul 2004 02:57:25 -0000 2.56
+++ gimplify.c 30 Jul 2004 22:31:40 -0000
@@ -3576,7 +3576,14 @@ gimplify_expr (tree *expr_p, tree *pre_p
break;
case CONST_DECL:
- *expr_p = DECL_INITIAL (*expr_p);
+ /* If we require an lvalue, such as for ADDR_EXPR, retain the
+ CONST_DECL node. Otherwise the decl is replacable by its
+ value. */
+ /* ??? Should be == fb_lvalue, but ADDR_EXPR passes fb_either. */
+ if (fallback & fb_lvalue)
+ ret = GS_ALL_DONE;
+ else
+ *expr_p = DECL_INITIAL (*expr_p);
break;
case DECL_EXPR:
Index: tree-gimple.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/tree-gimple.c,v
retrieving revision 2.19
diff -c -p -d -u -r2.19 tree-gimple.c
--- tree-gimple.c 28 Jul 2004 01:16:59 -0000 2.19
+++ tree-gimple.c 30 Jul 2004 22:31:40 -0000
@@ -413,6 +413,7 @@ is_gimple_id (tree t)
return (is_gimple_variable (t)
|| TREE_CODE (t) == FUNCTION_DECL
|| TREE_CODE (t) == LABEL_DECL
+ || TREE_CODE (t) == CONST_DECL
/* Allow string constants, since they are addressable. */
|| TREE_CODE (t) == STRING_CST);
}
Index: tree-pretty-print.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/tree-pretty-print.c,v
retrieving revision 2.26
diff -c -p -d -u -r2.26 tree-pretty-print.c
--- tree-pretty-print.c 28 Jul 2004 23:44:45 -0000 2.26
+++ tree-pretty-print.c 30 Jul 2004 22:31:40 -0000
@@ -165,7 +165,10 @@ dump_decl_name (pretty_printer *buffer,
pp_printf (buffer, "<L" HOST_WIDE_INT_PRINT_DEC ">",
LABEL_DECL_UID (node));
else
- pp_printf (buffer, "<D%u>", DECL_UID (node));
+ {
+ char c = TREE_CODE (node) == CONST_DECL ? 'C' : 'D';
+ pp_printf (buffer, "<%c%u>", c, DECL_UID (node));
+ }
}
}
Index: tree-ssa-ccp.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/tree-ssa-ccp.c,v
retrieving revision 2.28
diff -c -p -d -u -r2.28 tree-ssa-ccp.c
--- tree-ssa-ccp.c 30 Jul 2004 00:16:17 -0000 2.28
+++ tree-ssa-ccp.c 30 Jul 2004 22:31:41 -0000
@@ -1868,6 +1868,11 @@ maybe_fold_stmt_indirect (tree expr, tre
/* Strip the ADDR_EXPR. */
base = TREE_OPERAND (base, 0);
+ /* Fold away CONST_DECL to its value, if the type is scalar. */
+ if (TREE_CODE (base) == CONST_DECL
+ && is_gimple_min_invariant (DECL_INITIAL (base)))
+ return DECL_INITIAL (base);
+
/* Try folding *(&B+O) to B[X]. */
t = maybe_fold_offset_to_array_ref (base, offset, TREE_TYPE (expr));
if (t)
Index: fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.15
diff -c -p -d -u -r1.15 trans-expr.c
--- fortran/trans-expr.c 12 Jul 2004 01:23:36 -0000 1.15
+++ fortran/trans-expr.c 30 Jul 2004 22:31:41 -0000
@@ -1612,8 +1612,17 @@ gfc_conv_expr_reference (gfc_se * se, gf
gfc_conv_expr (se, expr);
/* Create a temporary var to hold the value. */
- var = gfc_create_var (TREE_TYPE (se->expr), NULL);
- gfc_add_modify_expr (&se->pre, var, se->expr);
+ if (TREE_CONSTANT (se->expr))
+ {
+ var = build_decl (CONST_DECL, NULL, TREE_TYPE (se->expr));
+ DECL_INITIAL (var) = se->expr;
+ pushdecl (var);
+ }
+ else
+ {
+ var = gfc_create_var (TREE_TYPE (se->expr), NULL);
+ gfc_add_modify_expr (&se->pre, var, se->expr);
+ }
gfc_add_block_to_block (&se->pre, &se->post);
/* Take the address of that value. */
Index: testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90,v
retrieving revision 1.2
diff -c -p -d -u -r1.2 intrinsic_rrspacing.f90
--- testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90 13 May 2004 06:40:53 -0000 1.2
+++ testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90 30 Jul 2004 22:31:43 -0000
@@ -8,18 +8,20 @@ program test_rrspacing
call test_real8(33.0_8)
call test_real8(-33.0_8)
end
-subroutine test_real4(x)
- real x,y
+subroutine test_real4(orig)
+ real x,y,orig
integer p
+ x = orig
p = 24
y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p)
x = rrspacing(x)
if (abs (x - y) .gt. abs(x * 1e-6)) call abort
end
-subroutine test_real8(x)
- real*8 x,y,t
+subroutine test_real8(orig)
+ real*8 x,y,t,orig
integer p
+ x = orig
p = 53
y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p)
x = rrspacing(x)
Index: testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90,v
retrieving revision 1.3
diff -c -p -d -u -r1.3 intrinsic_scale.f90
--- testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90 10 Jun 2004 12:41:32 -0000 1.3
+++ testsuite/gfortran.fortran-torture/execute/intrinsic_scale.f90 30 Jul 2004 22:31:43 -0000
@@ -10,17 +10,19 @@ program test_scale
call test_real8 (33.0_8, -4)
call test_real8 (-33._8, 4)
end
-subroutine test_real4 (x, i)
- real x,y
+subroutine test_real4 (orig, i)
+ real x,y,orig
integer i
+ x = orig
y = x * (2.0 ** i)
x = scale (x, i)
if (abs (x - y) .gt. abs(x * 1e-6)) call abort
end
-subroutine test_real8 (x, i)
- real*8 x,y
+subroutine test_real8 (orig, i)
+ real*8 x,y,orig
integer i
+ x = orig
y = x * (2.0 ** i)
x = scale (x, i)
if (abs (x - y) .gt. abs(x * 1e-6)) call abort