Hi,
On Fri, 15 Apr 2011, Dominique Dhumieres wrote:
> Michael,
>
> > Yes, this is due to the DECL_EXPR statement which is rendered by the
> > dumper just the same as a normal decl. The testcase looks for exactly one
> > such decl, but with -fstack-arrays there are exactly two for each such
> > array.
>
> The testsuite is run without -fstack-arrays, so I dont' understand why
> the "DECL_EXPR statement" appears.
Bummer, you're right. I unconditionally emit a DECL_EXPR for arrays even
when they don't have a variable length. It's harmless, but makes the
testcase fail (I wasn't seeing the fail because I've changed the testcase
already to make it not fail with -fstack-arrays).
I'll make the DECL_EXPR conditional on the size being variable. As Tobias
already okayed the patch I'm planning to check in the slightly modified
variant as below, after a new round of testing.
Ciao,
Michael.
* trans-array.c (toplevel): Include gimple.h.
(gfc_trans_allocate_array_storage): Check flag_stack_arrays,
properly expand variable length arrays.
(gfc_trans_auto_array_allocation): If flag_stack_arrays create
variable length decls and associate them with their scope.
* gfortran.h (gfc_option_t): Add flag_stack_arrays member.
* options.c (gfc_init_options): Handle -fstack_arrays option.
* lang.opt (fstack-arrays): Add option.
* invoke.texi (Code Gen Options): Document it.
* Make-lang.in (trans-array.o): Depend on GIMPLE_H.
Index: fortran/trans-array.c
===================================================================
*** fortran/trans-array.c (revision 172431)
--- fortran/trans-array.c (working copy)
*************** along with GCC; see the file COPYING3.
*** 81,86 ****
--- 81,87 ----
#include "system.h"
#include "coretypes.h"
#include "tree.h"
+ #include "gimple.h"
#include "diagnostic-core.h" /* For internal_error/fatal_error. */
#include "flags.h"
#include "gfortran.h"
*************** gfc_trans_allocate_array_storage (stmtbl
*** 630,647 ****
{
/* Allocate the temporary. */
onstack = !dynamic && initial == NULL_TREE
! && gfc_can_put_var_on_stack (size);
if (onstack)
{
/* Make a temporary variable to hold the data. */
tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (nelem),
nelem, gfc_index_one_node);
tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
tmp);
tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
tmp);
tmp = gfc_create_var (tmp, "A");
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
gfc_conv_descriptor_data_set (pre, desc, tmp);
}
--- 631,657 ----
{
/* Allocate the temporary. */
onstack = !dynamic && initial == NULL_TREE
! && (gfc_option.flag_stack_arrays
! || gfc_can_put_var_on_stack (size));
if (onstack)
{
/* Make a temporary variable to hold the data. */
tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (nelem),
nelem, gfc_index_one_node);
+ tmp = gfc_evaluate_now (tmp, pre);
tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
tmp);
tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
tmp);
tmp = gfc_create_var (tmp, "A");
+ /* If we're here only because of -fstack-arrays we have to
+ emit a DECL_EXPR to make the gimplifier emit alloca calls. */
+ if (!gfc_can_put_var_on_stack (size))
+ gfc_add_expr_to_block (pre,
+ fold_build1_loc (input_location,
+ DECL_EXPR, TREE_TYPE (tmp),
+ tmp));
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
gfc_conv_descriptor_data_set (pre, desc, tmp);
}
*************** gfc_trans_auto_array_allocation (tree de
*** 4759,4767 ****
{
stmtblock_t init;
tree type;
! tree tmp;
tree size;
tree offset;
bool onstack;
gcc_assert (!(sym->attr.pointer || sym->attr.allocatable));
--- 4769,4779 ----
{
stmtblock_t init;
tree type;
! tree tmp = NULL_TREE;
tree size;
tree offset;
+ tree space;
+ tree inittree;
bool onstack;
gcc_assert (!(sym->attr.pointer || sym->attr.allocatable));
*************** gfc_trans_auto_array_allocation (tree de
*** 4818,4832 ****
return;
}
! /* The size is the number of elements in the array, so multiply by the
! size of an element to get the total size. */
! tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, fold_convert (gfc_array_index_type, tmp));
! /* Allocate memory to hold the data. */
! tmp = gfc_call_malloc (&init, TREE_TYPE (decl), size);
! gfc_add_modify (&init, decl, tmp);
/* Set offset of the array. */
if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
--- 4830,4859 ----
return;
}
! if (gfc_option.flag_stack_arrays)
! {
! gcc_assert (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE);
! space = build_decl (sym->declared_at.lb->location,
! VAR_DECL, create_tmp_var_name ("A"),
! TREE_TYPE (TREE_TYPE (decl)));
! gfc_trans_vla_type_sizes (sym, &init);
! }
! else
! {
! /* The size is the number of elements in the array, so multiply by the
! size of an element to get the total size. */
! tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
! size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
! size, fold_convert (gfc_array_index_type, tmp));
! /* Allocate memory to hold the data. */
! tmp = gfc_call_malloc (&init, TREE_TYPE (decl), size);
! gfc_add_modify (&init, decl, tmp);
!
! /* Free the temporary. */
! tmp = gfc_call_free (convert (pvoid_type_node, decl));
! space = NULL_TREE;
! }
/* Set offset of the array. */
if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
*************** gfc_trans_auto_array_allocation (tree de
*** 4835,4844 ****
/* Automatic arrays should not have initializers. */
gcc_assert (!sym->value);
! /* Free the temporary. */
! tmp = gfc_call_free (convert (pvoid_type_node, decl));
! gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
--- 4862,4887 ----
/* Automatic arrays should not have initializers. */
gcc_assert (!sym->value);
! inittree = gfc_finish_block (&init);
!
! if (space)
! {
! tree addr;
! pushdecl (space);
! /* Don't create new scope, emit the DECL_EXPR in exactly the scope
! where also space is located. */
! gfc_init_block (&init);
! tmp = fold_build1_loc (input_location, DECL_EXPR,
! TREE_TYPE (space), space);
! gfc_add_expr_to_block (&init, tmp);
! addr = fold_build1_loc (sym->declared_at.lb->location,
! ADDR_EXPR, TREE_TYPE (decl), space);
! gfc_add_modify (&init, decl, addr);
! gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
! tmp = NULL_TREE;
! }
! gfc_add_init_cleanup (block, inittree, tmp);
}
Index: fortran/Make-lang.in
===================================================================
*** fortran/Make-lang.in (revision 172431)
--- fortran/Make-lang.in (working copy)
*************** fortran/trans-stmt.o: $(GFORTRAN_TRANS_D
*** 353,359 ****
fortran/trans-openmp.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \
fortran/ioparm.def
! fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
gt-fortran-trans-intrinsic.h
fortran/dependency.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
--- 353,359 ----
fortran/trans-openmp.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \
fortran/ioparm.def
! fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS) $(GIMPLE_H)
fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
gt-fortran-trans-intrinsic.h
fortran/dependency.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
Index: fortran/gfortran.h
===================================================================
*** fortran/gfortran.h (revision 172431)
--- fortran/gfortran.h (working copy)
*************** typedef struct
*** 2221,2226 ****
--- 2221,2227 ----
int flag_d_lines;
int gfc_flag_openmp;
int flag_sign_zero;
+ int flag_stack_arrays;
int flag_module_private;
int flag_recursive;
int flag_init_local_zero;
Index: fortran/lang.opt
===================================================================
*** fortran/lang.opt (revision 172431)
--- fortran/lang.opt (working copy)
*************** fmax-stack-var-size=
*** 462,467 ****
--- 462,471 ----
Fortran RejectNegative Joined UInteger
-fmax-stack-var-size=<n> Size in bytes of the largest array that will be
put on the stack
+ fstack-arrays
+ Fortran
+ Put all local arrays on stack.
+
fmodule-private
Fortran
Set default accessibility of module entities to PRIVATE.
Index: fortran/invoke.texi
===================================================================
*** fortran/invoke.texi (revision 172431)
--- fortran/invoke.texi (working copy)
*************** and warnings}.
*** 167,172 ****
--- 167,173 ----
-fbounds-check -fcheck-array-temporaries -fmax-array-constructor =@var{n}
@gol
-fcheck=@var{<all|array-temps|bounds|do|mem|pointer|recursion>} @gol
-fcoarray=@var{<none|single|lib>} -fmax-stack-var-size=@var{n} @gol
+ -fstack-arrays @gol
-fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol
-fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol
-finit-integer=@var{n} -finit-real=@var{<zero|inf|-inf|nan|snan>} @gol
*************** Future versions of GNU Fortran may impro
*** 1370,1375 ****
--- 1371,1383 ----
The default value for @var{n} is 32768.
+ @item -fstack-arrays
+ @opindex @code{fstack-arrays}
+ Adding this option will make the fortran compiler put all local arrays,
+ even those of unknown size onto stack memory. If your program uses very
+ large local arrays it's possible that you'll have to extend your runtime
+ limits for stack memory on some operating systems.
+
@item -fpack-derived
@opindex @code{fpack-derived}
@cindex structure packing
Index: fortran/options.c
===================================================================
*** fortran/options.c (revision 172431)
--- fortran/options.c (working copy)
*************** gfc_init_options (unsigned int decoded_o
*** 124,129 ****
--- 124,130 ----
/* Default value of flag_max_stack_var_size is set in gfc_post_options. */
gfc_option.flag_max_stack_var_size = -2;
+ gfc_option.flag_stack_arrays = 0;
gfc_option.flag_range_check = 1;
gfc_option.flag_pack_derived = 0;
*************** gfc_handle_option (size_t scode, const c
*** 795,800 ****
--- 796,805 ----
gfc_option.flag_max_stack_var_size = value;
break;
+ case OPT_fstack_arrays:
+ gfc_option.flag_stack_arrays = value;
+ break;
+
case OPT_fmodule_private:
gfc_option.flag_module_private = value;
break;
