From 6370b5e07f646f123b1078a195e483b4fede9cc8 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:28:58 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Move array reference initialisation earlier. Factor subsequent array references. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180842 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3472804e4c6..4b21476d7d5 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2842,6 +2842,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, gfc_ss_info *info; gfc_ss *ss; gfc_se se; + gfc_array_ref *ar; int i; /* This code will be executed before entering the scalarization loop @@ -2861,6 +2862,18 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim >= info->dimen) continue; + if (info->ref) + { + ar = &info->ref->u.ar; + i = loop->order[dim + 1]; + } + else + { + ar = NULL; + i = dim + 1; + } + + if (dim == info->dimen - 1) { /* For the outermost loop calculate the offset due to any @@ -2868,9 +2881,9 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, base offset of the array. */ if (info->ref) { - for (i = 0; i < info->ref->u.ar.dimen; i++) + for (i = 0; i < ar->dimen; i++) { - if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT) + if (ar->dimen_type[i] != DIMEN_ELEMENT) continue; gfc_init_se (&se, NULL); @@ -2878,8 +2891,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, se.expr = info->descriptor; stride = gfc_conv_array_stride (info->descriptor, i); index = gfc_conv_array_index_offset (&se, info, i, -1, - &info->ref->u.ar, - stride); + ar, stride); gfc_add_block_to_block (pblock, &se.pre); info->offset = fold_build2_loc (input_location, PLUS_EXPR, @@ -2903,19 +2915,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, else { /* Add the offset for the previous loop dimension. */ - gfc_array_ref *ar; - - if (info->ref) - { - ar = &info->ref->u.ar; - i = loop->order[dim + 1]; - } - else - { - ar = NULL; - i = dim + 1; - } - gfc_init_se (&se, NULL); se.loop = loop; se.expr = info->descriptor; -- cgit v1.2.1 From 9e38215fde68f82c1a18aed0e76fe7eeee9b676e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:46:00 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Move code earlier. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180843 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 4b21476d7d5..91359e9c57e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2876,6 +2876,17 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim == info->dimen - 1) { + i = loop->order[0]; + /* For the time being, the innermost loop is unconditionally on + the first dimension of the scalarization loop. */ + gcc_assert (i == 0); + stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); + + /* Calculate the stride of the innermost loop. Hopefully this will + allow the backend optimizers to do their stuff more effectively. + */ + info->stride0 = gfc_evaluate_now (stride, pblock); + /* For the outermost loop calculate the offset due to any elemental dimensions. It will have been initialized with the base offset of the array. */ @@ -2900,17 +2911,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, info->offset = gfc_evaluate_now (info->offset, pblock); } } - - i = loop->order[0]; - /* For the time being, the innermost loop is unconditionally on - the first dimension of the scalarization loop. */ - gcc_assert (i == 0); - stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); - - /* Calculate the stride of the innermost loop. Hopefully this will - allow the backend optimizers to do their stuff more effectively. - */ - info->stride0 = gfc_evaluate_now (stride, pblock); } else { -- cgit v1.2.1 From 4d0a8b9d7a3cdf29a03dce0098f74fdcad38e81e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:49:14 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Factor loop index initialization. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180844 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 91359e9c57e..e3134f5efa9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2863,16 +2863,15 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, continue; if (info->ref) - { - ar = &info->ref->u.ar; - i = loop->order[dim + 1]; - } + ar = &info->ref->u.ar; else - { - ar = NULL; - i = dim + 1; - } + ar = NULL; + + i = dim + 1; + /* For the time being, there is no loop reordering. */ + gcc_assert (i == loop->order[i]); + i = loop->order[i]; if (dim == info->dimen - 1) { -- cgit v1.2.1 From 71b0aa655e8e16c1a215cce0b98aa1080c503213 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:52:14 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Remove redundant assertion. Special case outermost loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180846 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e3134f5efa9..f5e30ae4e7c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2867,7 +2867,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, else ar = NULL; - i = dim + 1; + if (dim == info->dimen - 1) + i = 0; + else + i = dim + 1; /* For the time being, there is no loop reordering. */ gcc_assert (i == loop->order[i]); @@ -2875,10 +2878,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim == info->dimen - 1) { - i = loop->order[0]; - /* For the time being, the innermost loop is unconditionally on - the first dimension of the scalarization loop. */ - gcc_assert (i == 0); stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); /* Calculate the stride of the innermost loop. Hopefully this will -- cgit v1.2.1 From 14bc1986acab91dac7f14f5e977d88eac3071078 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:56:19 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Use loop's dimension instead of array's dimention. Check that it is indeed the same. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180847 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f5e30ae4e7c..476978e5cce 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2861,13 +2861,14 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim >= info->dimen) continue; + gcc_assert (info->dimen == loop->dimen); if (info->ref) ar = &info->ref->u.ar; else ar = NULL; - if (dim == info->dimen - 1) + if (dim == loop->dimen - 1) i = 0; else i = dim + 1; @@ -2876,7 +2877,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, gcc_assert (i == loop->order[i]); i = loop->order[i]; - if (dim == info->dimen - 1) + if (dim == loop->dimen - 1) { stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); -- cgit v1.2.1 From b960d512b24965672f38cb89300e0fad1992ea41 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:00:41 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Move common code... (add_array_offset): ...into that new function. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180848 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 59 +++++++++++++++++++++++++---------------------- 1 file changed, 31 insertions(+), 28 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 476978e5cce..f615e4e6a10 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2830,6 +2830,34 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, } +/* Add the offset corresponding to array's ARRAY_DIM dimension and loop's + LOOP_DIM dimension (if any) to array's offset. */ + +static void +add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, + gfc_array_ref *ar, int array_dim, int loop_dim) +{ + gfc_se se; + gfc_ss_info *info; + tree stride, index; + + info = &ss->data.info; + + gfc_init_se (&se, NULL); + se.loop = loop; + se.expr = info->descriptor; + stride = gfc_conv_array_stride (info->descriptor, array_dim); + index = gfc_conv_array_index_offset (&se, info, array_dim, loop_dim, ar, + stride); + gfc_add_block_to_block (pblock, &se.pre); + + info->offset = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + info->offset, index); + info->offset = gfc_evaluate_now (info->offset, pblock); +} + + /* Generate the code to be executed immediately before entering a scalarization loop. */ @@ -2837,11 +2865,9 @@ static void gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, stmtblock_t * pblock) { - tree index; tree stride; gfc_ss_info *info; gfc_ss *ss; - gfc_se se; gfc_array_ref *ar; int i; @@ -2896,36 +2922,13 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (ar->dimen_type[i] != DIMEN_ELEMENT) continue; - gfc_init_se (&se, NULL); - se.loop = loop; - se.expr = info->descriptor; - stride = gfc_conv_array_stride (info->descriptor, i); - index = gfc_conv_array_index_offset (&se, info, i, -1, - ar, stride); - gfc_add_block_to_block (pblock, &se.pre); - - info->offset = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, - info->offset, index); - info->offset = gfc_evaluate_now (info->offset, pblock); + add_array_offset (pblock, loop, ss, ar, i, /* unused */ -1); } } } else - { - /* Add the offset for the previous loop dimension. */ - gfc_init_se (&se, NULL); - se.loop = loop; - se.expr = info->descriptor; - stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); - index = gfc_conv_array_index_offset (&se, info, info->dim[i], i, - ar, stride); - gfc_add_block_to_block (pblock, &se.pre); - info->offset = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, info->offset, - index); - info->offset = gfc_evaluate_now (info->offset, pblock); - } + /* Add the offset for the previous loop dimension. */ + add_array_offset (pblock, loop, ss, ar, info->dim[i], i); /* Remember this offset for the second loop. */ if (dim == loop->temp_dim - 1) -- cgit v1.2.1 From fcba1adee07f2256a1c386e44a95b8e02db2dea7 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:03:56 +0000 Subject: * trans-array.c (get_array_ref_dim): Remove redundant condition. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180849 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f615e4e6a10..c7eaf664b27 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -815,7 +815,7 @@ get_array_ref_dim (gfc_ss_info *info, int loop_dim) array_dim = info->dim[loop_dim]; for (n = 0; n < info->dimen; n++) - if (n != loop_dim && info->dim[n] < array_dim) + if (info->dim[n] < array_dim) array_ref_dim++; return array_ref_dim; -- cgit v1.2.1 From bc0c6a643dbefbee0c0a03e87e95839b2ab316cc Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:08:25 +0000 Subject: * trans-array.c (gfc_walk_array_ref): Skip coarray dimensions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180850 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c7eaf664b27..5500ec46b61 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7637,7 +7637,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) switch (ar->type) { case AR_ELEMENT: - for (n = ar->dimen + ar->codimen - 1; n >= 0; n--) + for (n = ar->dimen - 1; n >= 0; n--) ss = gfc_get_scalar_ss (ss, ar->start[n]); break; -- cgit v1.2.1 From 73ce7954f95f51289691fa2bb4bb9a9f89740d31 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:09:58 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Assertify one condition. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180851 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5500ec46b61..8359af2d9b2 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2885,8 +2885,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, info = &ss->data.info; - if (dim >= info->dimen) - continue; + gcc_assert (dim < info->dimen); gcc_assert (info->dimen == loop->dimen); if (info->ref) -- cgit v1.2.1 From a82b2774dadbf0821c50a66599694b2b0ac0a2c8 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:12:33 +0000 Subject: * trans-array.c (gfc_conv_ss_startstride): Access array bounds along array dimensions instead of loop dimensions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180852 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8359af2d9b2..f4d8a854327 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3347,9 +3347,11 @@ done: case GFC_SS_FUNCTION: for (n = 0; n < ss->data.info.dimen; n++) { - ss->data.info.start[n] = gfc_index_zero_node; - ss->data.info.end[n] = gfc_index_zero_node; - ss->data.info.stride[n] = gfc_index_one_node; + int dim = ss->data.info.dim[n]; + + ss->data.info.start[dim] = gfc_index_zero_node; + ss->data.info.end[dim] = gfc_index_zero_node; + ss->data.info.stride[dim] = gfc_index_one_node; } break; -- cgit v1.2.1 From 39ee9fa924979a477abc1999d062de24aab73583 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:14:19 +0000 Subject: * trans-array.c (gfc_conv_loop_setup): Also skip temporary arrays. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180853 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f4d8a854327..cfbe9095c49 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3881,7 +3881,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop for this dimension. We try to pick the simplest term. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - if (ss->type == GFC_SS_SCALAR || ss->type == GFC_SS_REFERENCE) + gfc_ss_type ss_type; + + ss_type = ss->type; + if (ss_type == GFC_SS_SCALAR + || ss_type == GFC_SS_TEMP + || ss_type == GFC_SS_REFERENCE) continue; info = &ss->data.info; -- cgit v1.2.1 From 7f03d4d9fd6f573b413a481adedf1152b592c2fc Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:16:54 +0000 Subject: * trans-array.c (gfc_trans_scalarizing_loops): Stop loop before end marker, not after it. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180855 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index cfbe9095c49..f6113020303 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3114,7 +3114,7 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body) gfc_add_expr_to_block (&loop->pre, tmp); /* Clear all the used flags. */ - for (ss = loop->ss; ss; ss = ss->loop_chain) + for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) ss->useflags = 0; } -- cgit v1.2.1 From b014e22f7a176deb8502813c5f81221f7e04828a Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:19:27 +0000 Subject: * trans-array.c (gfc_trans_constant_array_constructor, trans_constant_array_constructor): Rename the former to the latter. Don't set the rank of the temporary for the loop. Remove then unused loop argument. (gfc_trans_array_constructor): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180856 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f6113020303..c39fc9e29b4 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1849,8 +1849,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type) gfc_build_constant_array_constructor. */ static void -gfc_trans_constant_array_constructor (gfc_loopinfo * loop, - gfc_ss * ss, tree type) +trans_constant_array_constructor (gfc_ss * ss, tree type) { gfc_ss_info *info; tree tmp; @@ -1871,14 +1870,11 @@ gfc_trans_constant_array_constructor (gfc_loopinfo * loop, info->end[i] = gfc_index_zero_node; info->stride[i] = gfc_index_one_node; } - - if (info->dimen > loop->temp_dim) - loop->temp_dim = info->dimen; } /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough - to use with gfc_trans_constant_array_constructor. Returns the + to use with trans_constant_array_constructor. Returns the iteration count of the loop if suitable, and NULL_TREE otherwise. */ static tree @@ -2033,7 +2029,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) tree size = constant_array_constructor_loop_size (loop); if (size && compare_tree_int (size, nelem) == 0) { - gfc_trans_constant_array_constructor (loop, ss, type); + trans_constant_array_constructor (ss, type); goto finish; } } -- cgit v1.2.1 From aecc03acf6cf9a415e9d66c5dba822a3914620b4 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:21:30 +0000 Subject: * trans-array.c (gfc_trans_array_bound_check, trans_array_bound_check): Rename the former to the latter. Replace descriptor argument with ss argument. Get descriptor from ss. (gfc_conv_array_index_offset, conv_array_index_offset): Rename the former to the latter. Update call to trans_array_bound_check. Replace info argument with ss argument. Get info from ss. (gfc_conv_scalarized_array_ref): Update call to conv_array_index_offset. (add_array_offset): Ditto git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180857 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c39fc9e29b4..45bf6836f5b 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2426,17 +2426,20 @@ gfc_conv_array_ubound (tree descriptor, int dim) /* Generate code to perform an array index bound check. */ static tree -gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, - locus * where, bool check_upper) +trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, + locus * where, bool check_upper) { tree fault; tree tmp_lo, tmp_up; + tree descriptor; char *msg; const char * name = NULL; if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) return index; + descriptor = ss->data.info.descriptor; + index = gfc_evaluate_now (index, &se->pre); /* We find a name for the error message. */ @@ -2521,13 +2524,16 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, DIM is the array dimension, I is the loop dimension. */ static tree -gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, - gfc_array_ref * ar, tree stride) +conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, + gfc_array_ref * ar, tree stride) { + gfc_ss_info *info; tree index; tree desc; tree data; + info = &ss->data.info; + /* Get the index into the array for this dimension. */ if (ar) { @@ -2544,10 +2550,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, /* We've already translated this value outside the loop. */ index = info->subscript[dim]->data.scalar.expr; - index = gfc_trans_array_bound_check (se, info->descriptor, - index, dim, &ar->where, - ar->as->type != AS_ASSUMED_SIZE - || dim < ar->dimen - 1); + index = trans_array_bound_check (se, ss, index, dim, &ar->where, + ar->as->type != AS_ASSUMED_SIZE + || dim < ar->dimen - 1); break; case DIMEN_VECTOR: @@ -2574,10 +2579,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, index = fold_convert (gfc_array_index_type, index); /* Do any bounds checking on the final info->descriptor index. */ - index = gfc_trans_array_bound_check (se, info->descriptor, - index, dim, &ar->where, - ar->as->type != AS_ASSUMED_SIZE - || dim < ar->dimen - 1); + index = trans_array_bound_check (se, ss, index, dim, &ar->where, + ar->as->type != AS_ASSUMED_SIZE + || dim < ar->dimen - 1); break; case DIMEN_RANGE: @@ -2648,7 +2652,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) else n = 0; - index = gfc_conv_array_index_offset (se, info, info->dim[n], n, ar, + index = conv_array_index_offset (se, se->ss, info->dim[n], n, ar, info->stride0); /* Add the offset for this dimension to the stored offset for all other dimensions. */ @@ -2843,8 +2847,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, se.loop = loop; se.expr = info->descriptor; stride = gfc_conv_array_stride (info->descriptor, array_dim); - index = gfc_conv_array_index_offset (&se, info, array_dim, loop_dim, ar, - stride); + index = conv_array_index_offset (&se, ss, array_dim, loop_dim, ar, stride); gfc_add_block_to_block (pblock, &se.pre); info->offset = fold_build2_loc (input_location, PLUS_EXPR, -- cgit v1.2.1 From 8451ce2f70e6490314a641483356c5e397074e7a Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:24:24 +0000 Subject: * trans-array.c (gfc_trans_array_bound_check): Use ss argument to get name. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180858 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 24 ++---------------------- 1 file changed, 2 insertions(+), 22 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 45bf6836f5b..d8f5448ff87 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2443,28 +2443,8 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, index = gfc_evaluate_now (index, &se->pre); /* We find a name for the error message. */ - if (se->ss) - name = se->ss->expr->symtree->name; - - if (!name && se->loop && se->loop->ss && se->loop->ss->expr - && se->loop->ss->expr->symtree) - name = se->loop->ss->expr->symtree->name; - - if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain - && se->loop->ss->loop_chain->expr - && se->loop->ss->loop_chain->expr->symtree) - name = se->loop->ss->loop_chain->expr->symtree->name; - - if (!name && se->loop && se->loop->ss && se->loop->ss->expr) - { - if (se->loop->ss->expr->expr_type == EXPR_FUNCTION - && se->loop->ss->expr->value.function.name) - name = se->loop->ss->expr->value.function.name; - else - if (se->loop->ss->type == GFC_SS_CONSTRUCTOR - || se->loop->ss->type == GFC_SS_SCALAR) - name = "unnamed constant"; - } + name = ss->expr->symtree->n.sym->name; + gcc_assert (name != NULL); if (TREE_CODE (descriptor) == VAR_DECL) name = IDENTIFIER_POINTER (DECL_NAME (descriptor)); -- cgit v1.2.1 From 40386751ff4443cecb2d9704efac328b6dec66f1 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:28:26 +0000 Subject: * trans-array.h (gfc_trans_create_temp_array): Replace info argument with ss argument. * trans-array.c (gfc_trans_create_temp_array): Ditto. Get info from ss. (gfc_trans_array_constructor, gfc_conv_loop_setup): Update call to gfc_trans_create_temp_array. * trans-expr.c (gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180859 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d8f5448ff87..0e7c1c14c77 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -838,10 +838,11 @@ get_array_ref_dim (gfc_ss_info *info, int loop_dim) tree gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, - gfc_loopinfo * loop, gfc_ss_info * info, + gfc_loopinfo * loop, gfc_ss * ss, tree eltype, tree initial, bool dynamic, bool dealloc, bool callee_alloc, locus * where) { + gfc_ss_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; tree desc; @@ -855,6 +856,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, memset (from, 0, sizeof (from)); memset (to, 0, sizeof (to)); + info = &ss->data.info; + gcc_assert (info->dimen > 0); gcc_assert (loop->dimen == info->dimen); @@ -2038,7 +2041,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) if (TREE_CODE (loop->to[0]) == VAR_DECL) dynamic = true; - gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info, + gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss, type, NULL_TREE, dynamic, true, false, where); desc = ss->data.info.descriptor; @@ -4061,7 +4064,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop->temp_ss->data.info.dim[n] = n; gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, - &loop->temp_ss->data.info, tmp, NULL_TREE, + loop->temp_ss, tmp, NULL_TREE, false, true, false, where); } -- cgit v1.2.1 From adad4984d0f7a8e555cd6691a2dca987f8217bdf Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:31:12 +0000 Subject: * trans-array.c (gfc_set_vector_loop_bounds, set_vector_loop_bounds): Rename the former to the latter. Change type and name of argument. Get previous argument from the new one. (gfc_add_loop_ss_code): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180860 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0e7c1c14c77..6af4fd6174c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2094,8 +2094,9 @@ finish: loop bounds. */ static void -gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info) +set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) { + gfc_ss_info *info; gfc_se se; tree tmp; tree desc; @@ -2103,6 +2104,8 @@ gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info) int n; int dim; + info = &ss->data.info; + for (n = 0; n < loop->dimen; n++) { dim = info->dim[n]; @@ -2194,7 +2197,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true, where); - gfc_set_vector_loop_bounds (loop, &ss->data.info); + set_vector_loop_bounds (loop, ss); break; case GFC_SS_VECTOR: -- cgit v1.2.1 From 4d0d78fedde4684cac7d935d873903a1ce0bcea2 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:33:28 +0000 Subject: * trans-array.c (get_array_ref_dim): Change argument type and name. Obtain previous argument from the new argument in the body. (gfc_trans_create_temp_arry, gfc_conv_loop_setup): Update calls. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180861 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 6af4fd6174c..eeed8bb9ffa 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -807,9 +807,12 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, */ static int -get_array_ref_dim (gfc_ss_info *info, int loop_dim) +get_array_ref_dim (gfc_ss *ss, int loop_dim) { int n, array_dim, array_ref_dim; + gfc_ss_info *info; + + info = &ss->data.info; array_ref_dim = 0; array_dim = info->dim[loop_dim]; @@ -884,7 +887,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, to the n'th dimension of the array. We need to reconstruct loop infos in the right order before using it to set the descriptor bounds. */ - tmp_dim = get_array_ref_dim (info, n); + tmp_dim = get_array_ref_dim (ss, n); from[tmp_dim] = loop->from[n]; to[tmp_dim] = loop->to[n]; @@ -3976,7 +3979,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) && INTEGER_CST_P (info->stride[dim])) { loop->from[n] = info->start[dim]; - mpz_set (i, cshape[get_array_ref_dim (info, n)]); + mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]); mpz_sub_ui (i, i, 1); /* To = from + (size - 1) * stride. */ tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind); -- cgit v1.2.1 From 72a55e713ef10b233c16aefb8fcde71097721adc Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:35:35 +0000 Subject: * trans-array.c (dim_ok, transposed_dims): Rename the former to the latter. Change argument type. Invert return value. (gfc_conv_expr_descriptor): Update calls. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180862 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index eeed8bb9ffa..dc4dccd3fe7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5659,13 +5659,16 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) /* Helper function to check dimensions. */ static bool -dim_ok (gfc_ss_info *info) +transposed_dims (gfc_ss *ss) { + gfc_ss_info *info; int n; + + info = &ss->data.info; for (n = 0; n < info->dimen; n++) if (info->dim[n] != n) - return false; - return true; + return true; + return false; } /* Convert an array for passing as an actual argument. Expressions and @@ -5752,7 +5755,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else full = gfc_full_array_ref_p (info->ref, NULL); - if (full && dim_ok (info)) + if (full && !transposed_dims (ss)) { if (se->direct_byref && !se->byref_noassign) { @@ -5949,7 +5952,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) desc = loop.temp_ss->data.info.descriptor; } - else if (expr->expr_type == EXPR_FUNCTION && dim_ok (info)) + else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss)) { desc = info->descriptor; se->string_length = ss->string_length; -- cgit v1.2.1 From ea686fef727b69289f13168df39e10615632faf0 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:39:11 +0000 Subject: * trans.h (struct gfc_ss_info, struct gfc_array_info): Rename the former to the latter. * trans-array.c (gfc_get_array_ss, gfc_trans_allocate_array_storage, get_array_ref_dim, gfc_trans_create_temp_array, gfc_trans_constant_array_constructor, gfc_set_vector_loop_bounds, gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, add_array_offset, gfc_trans_preloop_setup, gfc_conv_section_startstride, gfc_conv_ss_startstride, gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor): Update all uses. * trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_transfer, walk_inline_intrinsic_transpose): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies, gfc_trans_pointer_assign_need_temp): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180864 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index dc4dccd3fe7..2e1a8d48885 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -517,7 +517,7 @@ gfc_ss * gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) { gfc_ss *ss; - gfc_ss_info *info; + gfc_array_info *info; int i; ss = gfc_get_ss (); @@ -685,7 +685,7 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, static void gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, - gfc_ss_info * info, tree size, tree nelem, + gfc_array_info * info, tree size, tree nelem, tree initial, bool dynamic, bool dealloc) { tree tmp; @@ -810,7 +810,7 @@ static int get_array_ref_dim (gfc_ss *ss, int loop_dim) { int n, array_dim, array_ref_dim; - gfc_ss_info *info; + gfc_array_info *info; info = &ss->data.info; @@ -845,7 +845,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tree eltype, tree initial, bool dynamic, bool dealloc, bool callee_alloc, locus * where) { - gfc_ss_info *info; + gfc_array_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; tree desc; @@ -1857,7 +1857,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type) static void trans_constant_array_constructor (gfc_ss * ss, tree type) { - gfc_ss_info *info; + gfc_array_info *info; tree tmp; int i; @@ -2099,7 +2099,7 @@ finish: static void set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) { - gfc_ss_info *info; + gfc_array_info *info; gfc_se se; tree tmp; tree desc; @@ -2516,7 +2516,7 @@ static tree conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, gfc_array_ref * ar, tree stride) { - gfc_ss_info *info; + gfc_array_info *info; tree index; tree desc; tree data; @@ -2629,7 +2629,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, static void gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) { - gfc_ss_info *info; + gfc_array_info *info; tree decl = NULL_TREE; tree index; tree tmp; @@ -2827,7 +2827,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, gfc_array_ref *ar, int array_dim, int loop_dim) { gfc_se se; - gfc_ss_info *info; + gfc_array_info *info; tree stride, index; info = &ss->data.info; @@ -2854,7 +2854,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, stmtblock_t * pblock) { tree stride; - gfc_ss_info *info; + gfc_array_info *info; gfc_ss *ss; gfc_array_ref *ar; int i; @@ -3205,7 +3205,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim) gfc_expr *stride = NULL; tree desc; gfc_se se; - gfc_ss_info *info; + gfc_array_info *info; gfc_array_ref *ar; gcc_assert (ss->type == GFC_SS_SECTION); @@ -3356,7 +3356,7 @@ done: tree end; tree size[GFC_MAX_DIMENSIONS]; tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3; - gfc_ss_info *info; + gfc_array_info *info; char *msg; int dim; @@ -3851,8 +3851,8 @@ void gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { int n, dim, spec_dim; - gfc_ss_info *info; - gfc_ss_info *specinfo; + gfc_array_info *info; + gfc_array_info *specinfo; gfc_ss *ss; tree tmp; gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; @@ -4061,7 +4061,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp = loop->temp_ss->data.temp.type; n = loop->temp_ss->data.temp.dimen; - memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info)); + memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); loop->temp_ss->type = GFC_SS_SECTION; loop->temp_ss->data.info.dimen = n; @@ -5661,7 +5661,7 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) static bool transposed_dims (gfc_ss *ss) { - gfc_ss_info *info; + gfc_array_info *info; int n; info = &ss->data.info; @@ -5704,7 +5704,7 @@ void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { gfc_loopinfo loop; - gfc_ss_info *info; + gfc_array_info *info; int need_tmp; int n; tree tmp; -- cgit v1.2.1 From 91c546541d44cf6b1de95dc80eb8b365519a4a68 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:44:56 +0000 Subject: * trans.h (struct gfc_array_info): Move dim and dimen fields... (struct gfc_ss): ... here. Remove gfc_ss::data::temp::dimen field. * trans-array.c (gfc_conv_loop_setup): Remove temp_ss dim array initialization. (gfc_get_temp_ss): Initialize dim and dimen. (gfc_free_ss, gfc_get_array_ss, gfc_get_temp_ss, gfc_set_loop_bounds_from_array_spec, get_array_ref_dim, gfc_trans_create_temp_array, gfc_trans_constant_array_constructor, gfc_set_vector_loop_bounds, gfc_conv_scalarized_array_ref, gfc_trans_preloop_setup, gfc_conv_ss_startstride, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment, gfc_walk_array_ref): Update field references. * trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (walk_inline_intrinsic_transpose): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180865 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 133 ++++++++++++++++++++++------------------------ 1 file changed, 64 insertions(+), 69 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 2e1a8d48885..6ff60dcfa99 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -496,10 +496,10 @@ gfc_free_ss (gfc_ss * ss) switch (ss->type) { case GFC_SS_SECTION: - for (n = 0; n < ss->data.info.dimen; n++) + for (n = 0; n < ss->dimen; n++) { - if (ss->data.info.subscript[ss->data.info.dim[n]]) - gfc_free_ss_chain (ss->data.info.subscript[ss->data.info.dim[n]]); + if (ss->data.info.subscript[ss->dim[n]]) + gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]); } break; @@ -517,17 +517,15 @@ gfc_ss * gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) { gfc_ss *ss; - gfc_array_info *info; int i; ss = gfc_get_ss (); ss->next = next; ss->type = type; ss->expr = expr; - info = &ss->data.info; - info->dimen = dimen; - for (i = 0; i < info->dimen; i++) - info->dim[i] = i; + ss->dimen = dimen; + for (i = 0; i < ss->dimen; i++) + ss->dim[i] = i; return ss; } @@ -539,13 +537,16 @@ gfc_ss * gfc_get_temp_ss (tree type, tree string_length, int dimen) { gfc_ss *ss; + int i; ss = gfc_get_ss (); ss->next = gfc_ss_terminator; ss->type = GFC_SS_TEMP; ss->string_length = string_length; - ss->data.temp.dimen = dimen; ss->data.temp.type = type; + ss->dimen = dimen; + for (i = 0; i < ss->dimen; i++) + ss->dim[i] = i; return ss; } @@ -642,7 +643,7 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, if (as && as->type == AS_EXPLICIT) for (n = 0; n < se->loop->dimen; n++) { - dim = se->ss->data.info.dim[n]; + dim = se->ss->dim[n]; gcc_assert (dim < as->rank); gcc_assert (se->loop->dimen == as->rank); if (se->loop->to[n] == NULL_TREE) @@ -810,15 +811,12 @@ static int get_array_ref_dim (gfc_ss *ss, int loop_dim) { int n, array_dim, array_ref_dim; - gfc_array_info *info; - - info = &ss->data.info; array_ref_dim = 0; - array_dim = info->dim[loop_dim]; + array_dim = ss->dim[loop_dim]; - for (n = 0; n < info->dimen; n++) - if (info->dim[n] < array_dim) + for (n = 0; n < ss->dimen; n++) + if (ss->dim[n] < array_dim) array_ref_dim++; return array_ref_dim; @@ -861,8 +859,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, info = &ss->data.info; - gcc_assert (info->dimen > 0); - gcc_assert (loop->dimen == info->dimen); + gcc_assert (ss->dimen > 0); + gcc_assert (loop->dimen == ss->dimen); if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); @@ -870,7 +868,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* Set the lower bound to zero. */ for (n = 0; n < loop->dimen; n++) { - dim = info->dim[n]; + dim = ss->dim[n]; /* Callee allocated arrays may not have a known bound yet. */ if (loop->to[n]) @@ -899,7 +897,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* Initialize the descriptor. */ type = - gfc_get_array_type_bounds (eltype, info->dimen, 0, from, to, 1, + gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1, GFC_ARRAY_UNKNOWN, true); desc = gfc_create_var (type, "atmp"); GFC_DECL_PACKED_ARRAY (desc) = 1; @@ -937,7 +935,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, for (n = 0; n < loop->dimen; n++) { - dim = info->dim[n]; + dim = ss->dim[n]; if (size == NULL_TREE) { @@ -1003,8 +1001,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, dynamic, dealloc); - if (info->dimen > loop->temp_dim) - loop->temp_dim = info->dimen; + if (ss->dimen > loop->temp_dim) + loop->temp_dim = ss->dimen; return size; } @@ -1869,7 +1867,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) info->data = gfc_build_addr_expr (NULL_TREE, tmp); info->offset = gfc_index_zero_node; - for (i = 0; i < info->dimen; i++) + for (i = 0; i < ss->dimen; i++) { info->delta[i] = gfc_index_zero_node; info->start[i] = gfc_index_zero_node; @@ -1950,7 +1948,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) first_len = true; } - gcc_assert (ss->data.info.dimen == loop->dimen); + gcc_assert (ss->dimen == loop->dimen); c = ss->expr->value.constructor; if (ss->expr->ts.type == BT_CHARACTER) @@ -2111,7 +2109,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) for (n = 0; n < loop->dimen; n++) { - dim = info->dim[n]; + dim = ss->dim[n]; if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR && loop->to[n] == NULL) { @@ -2633,16 +2631,17 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) tree decl = NULL_TREE; tree index; tree tmp; + gfc_ss *ss; int n; - info = &se->ss->data.info; + ss = se->ss; + info = &ss->data.info; if (ar) n = se->loop->order[0]; else n = 0; - index = conv_array_index_offset (se, se->ss, info->dim[n], n, ar, - info->stride0); + index = conv_array_index_offset (se, ss, ss->dim[n], n, ar, info->stride0); /* Add the offset for this dimension to the stored offset for all other dimensions. */ if (!integer_zerop (info->offset)) @@ -2873,8 +2872,8 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, info = &ss->data.info; - gcc_assert (dim < info->dimen); - gcc_assert (info->dimen == loop->dimen); + gcc_assert (dim < ss->dimen); + gcc_assert (ss->dimen == loop->dimen); if (info->ref) ar = &info->ref->u.ar; @@ -2892,7 +2891,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim == loop->dimen - 1) { - stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); + stride = gfc_conv_array_stride (info->descriptor, ss->dim[i]); /* Calculate the stride of the innermost loop. Hopefully this will allow the backend optimizers to do their stuff more effectively. @@ -2915,7 +2914,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, } else /* Add the offset for the previous loop dimension. */ - add_array_offset (pblock, loop, ss, ar, info->dim[i], i); + add_array_offset (pblock, loop, ss, ar, ss->dim[i], i); /* Remember this offset for the second loop. */ if (dim == loop->temp_dim - 1) @@ -3271,7 +3270,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_SS_CONSTRUCTOR: case GFC_SS_FUNCTION: case GFC_SS_COMPONENT: - loop->dimen = ss->data.info.dimen; + loop->dimen = ss->dimen; goto done; /* As usual, lbound and ubound are exceptions!. */ @@ -3283,7 +3282,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_ISYM_LCOBOUND: case GFC_ISYM_UCOBOUND: case GFC_ISYM_THIS_IMAGE: - loop->dimen = ss->data.info.dimen; + loop->dimen = ss->dimen; goto done; default: @@ -3312,8 +3311,8 @@ done: /* Get the descriptor for the array. */ gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter); - for (n = 0; n < ss->data.info.dimen; n++) - gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n]); + for (n = 0; n < ss->dimen; n++) + gfc_conv_section_startstride (loop, ss, ss->dim[n]); break; case GFC_SS_INTRINSIC: @@ -3333,9 +3332,9 @@ done: case GFC_SS_CONSTRUCTOR: case GFC_SS_FUNCTION: - for (n = 0; n < ss->data.info.dimen; n++) + for (n = 0; n < ss->dimen; n++) { - int dim = ss->data.info.dim[n]; + int dim = ss->dim[n]; ss->data.info.start[dim] = gfc_index_zero_node; ss->data.info.end[dim] = gfc_index_zero_node; @@ -3387,7 +3386,7 @@ done: { bool check_upper; - dim = info->dim[n]; + dim = ss->dim[n]; if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE) continue; @@ -3776,10 +3775,10 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, if (nDepend == 1) break; - for (i = 0; i < dest->data.info.dimen; i++) - for (j = 0; j < ss->data.info.dimen; j++) + for (i = 0; i < dest->dimen; i++) + for (j = 0; j < ss->dimen; j++) if (i != j - && dest->data.info.dim[i] == ss->data.info.dim[j]) + && dest->dim[i] == ss->dim[j]) { /* If we don't access array elements in the same order, there is a dependency. */ @@ -3853,7 +3852,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) int n, dim, spec_dim; gfc_array_info *info; gfc_array_info *specinfo; - gfc_ss *ss; + gfc_ss *ss, *tmp_ss; tree tmp; gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; bool dynamic[GFC_MAX_DIMENSIONS]; @@ -3878,12 +3877,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) continue; info = &ss->data.info; - dim = info->dim[n]; + dim = ss->dim[n]; if (loopspec[n] != NULL) { specinfo = &loopspec[n]->data.info; - spec_dim = specinfo->dim[n]; + spec_dim = loopspec[n]->dim[n]; } else { @@ -3971,7 +3970,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (loopspec[n]); info = &loopspec[n]->data.info; - dim = info->dim[n]; + dim = loopspec[n]->dim[n]; /* Set the extents of this range. */ cshape = loopspec[n]->shape; @@ -4047,8 +4046,9 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) allocating the temporary. */ gfc_add_loop_ss_code (loop, loop->ss, false, where); + tmp_ss = loop->temp_ss; /* If we want a temporary then create it. */ - if (loop->temp_ss != NULL) + if (tmp_ss != NULL) { gcc_assert (loop->temp_ss->type == GFC_SS_TEMP); @@ -4060,17 +4060,13 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop->temp_ss->string_length); tmp = loop->temp_ss->data.temp.type; - n = loop->temp_ss->data.temp.dimen; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); loop->temp_ss->type = GFC_SS_SECTION; - loop->temp_ss->data.info.dimen = n; - gcc_assert (loop->temp_ss->data.info.dimen != 0); - for (n = 0; n < loop->temp_ss->data.info.dimen; n++) - loop->temp_ss->data.info.dim[n] = n; + gcc_assert (tmp_ss->dimen != 0); gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, - loop->temp_ss, tmp, NULL_TREE, + tmp_ss, tmp, NULL_TREE, false, true, false, where); } @@ -4094,12 +4090,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) info = &ss->data.info; - for (n = 0; n < info->dimen; n++) + for (n = 0; n < ss->dimen; n++) { /* If we are specifying the range the delta is already set. */ if (loopspec[n] != ss) { - dim = ss->data.info.dim[n]; + dim = ss->dim[n]; /* Calculate the offset relative to the loop variable. First multiply by the stride. */ @@ -5657,16 +5653,15 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) } } + /* Helper function to check dimensions. */ static bool transposed_dims (gfc_ss *ss) { - gfc_array_info *info; int n; - info = &ss->data.info; - for (n = 0; n < info->dimen; n++) - if (info->dim[n] != n) + for (n = 0; n < ss->dimen; n++) + if (ss->dim[n] != n) return true; return false; } @@ -5899,7 +5894,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) loop.dimen); se->string_length = loop.temp_ss->string_length; - gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen); + gcc_assert (loop.temp_ss->dimen == loop.dimen); gfc_add_ss_to_loop (&loop, loop.temp_ss); } @@ -5972,7 +5967,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) tree to; tree base; - ndim = info->ref ? info->ref->u.ar.dimen : info->dimen; + ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen; if (se->want_coarray) { @@ -6087,7 +6082,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* look for the corresponding scalarizer dimension: dim. */ for (dim = 0; dim < ndim; dim++) - if (info->dim[dim] == n) + if (ss->dim[dim] == n) break; /* loop exited early: the DIM being looked for has been found. */ @@ -7376,7 +7371,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, for (n = 0; n < expr1->rank; n++) { tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]); - dim = lss->data.info.dim[n]; + dim = lss->dim[n]; tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, tmp, loop->from[dim]); @@ -7678,8 +7673,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) case DIMEN_RANGE: /* We don't add anything for sections, just remember this dimension for later. */ - newss->data.info.dim[newss->data.info.dimen] = n; - newss->data.info.dimen++; + newss->dim[newss->dimen] = n; + newss->dimen++; break; case DIMEN_VECTOR: @@ -7689,8 +7684,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) 1, GFC_SS_VECTOR); indexss->loop_chain = gfc_ss_terminator; newss->data.info.subscript[n] = indexss; - newss->data.info.dim[newss->data.info.dimen] = n; - newss->data.info.dimen++; + newss->dim[newss->dimen] = n; + newss->dimen++; break; default: @@ -7700,7 +7695,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) } /* We should have at least one non-elemental dimension, unless we are creating a descriptor for a (scalar) coarray. */ - gcc_assert (newss->data.info.dimen > 0 + gcc_assert (newss->dimen > 0 || newss->data.info.ref->u.ar.as->corank > 0); ss = newss; break; -- cgit v1.2.1 From f6b46ebcc27964a832aa2bf59be164269b7c9fee Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:47:49 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_array_info): Move shape field from the former struct to the latter. * trans-array.c (gfc_conv_ss_startstride, gfc_conv_loop_setup): Update field references. * trans-expr.c (gfc_trans_subarray_assign): Update field references and factor common reference chains. * trans-io.c (transfer_array_component): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180866 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 6ff60dcfa99..277a49e79e9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3302,8 +3302,12 @@ done: /* Loop over all the SS in the chain. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - if (ss->expr && ss->expr->shape && !ss->shape) - ss->shape = ss->expr->shape; + gfc_array_info *info; + + info = &ss->data.info; + + if (ss->expr && ss->expr->shape && !info->shape) + info->shape = ss->expr->shape; switch (ss->type) { @@ -3891,12 +3895,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) spec_dim = 0; } - if (ss->shape) + if (info->shape) { - gcc_assert (ss->shape[dim]); + gcc_assert (info->shape[dim]); /* The frontend has worked out the size for us. */ if (!loopspec[n] - || !loopspec[n]->shape + || !specinfo->shape || !integer_zerop (specinfo->start[spec_dim])) /* Prefer zero-based descriptors if possible. */ loopspec[n] = ss; @@ -3973,7 +3977,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) dim = loopspec[n]->dim[n]; /* Set the extents of this range. */ - cshape = loopspec[n]->shape; + cshape = info->shape; if (cshape && INTEGER_CST_P (info->start[dim]) && INTEGER_CST_P (info->stride[dim])) { -- cgit v1.2.1 From 45f3982640ef8034c09b1f99806122525801e62d Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:55:48 +0000 Subject: * trans.h (struct gfc_ss_info): New struct. (gfc_get_ss_info): New macro. (struct gfc_ss): Move type field to struct gfc_ss_info. Add an info field of type gfc_ss_info. * trans-array.c (free_ss_info): New function. (gfc_free_ss): Call free_ss_info. (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss): Allocate gfc_ss_info field. (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss, gfc_set_vector_loop_bounds, gfc_add_loop_ss_code, gfc_conv_array_index_offset, gfc_trans_preloop_setup, gfc_trans_scalarized_loop_boundary, gfc_conv_section_startstride, gfc_conv_ss_startstride, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor, gfc_walk_elemental_function_args): Update references to type. * trans-const.c (gfc_conv_constant): Factor common reference chains and update reference to type. * trans-expr.c (gfc_conv_procedure_call, gfc_trans_assignment_1): Update reference to type. (gfc_conv_array_constructor_expr, gfc_conv_expr, gfc_conv_expr_reference): Ditto. Factor common reference chains. * trans-intrinsic.c (walk_inline_intrinsic_transpose): Update references to type * trans-stmt.c (gfc_trans_where_assign): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180867 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 113 +++++++++++++++++++++++++++++++--------------- 1 file changed, 76 insertions(+), 37 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 277a49e79e9..80dadf4c4db 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -486,14 +486,24 @@ gfc_free_ss_chain (gfc_ss * ss) } +static void +free_ss_info (gfc_ss_info *ss_info) +{ + free (ss_info); +} + + /* Free a SS. */ static void gfc_free_ss (gfc_ss * ss) { + gfc_ss_info *ss_info; int n; - switch (ss->type) + ss_info = ss->info; + + switch (ss_info->type) { case GFC_SS_SECTION: for (n = 0; n < ss->dimen; n++) @@ -507,6 +517,7 @@ gfc_free_ss (gfc_ss * ss) break; } + free_ss_info (ss_info); free (ss); } @@ -517,11 +528,15 @@ gfc_ss * gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) { gfc_ss *ss; + gfc_ss_info *ss_info; int i; + ss_info = gfc_get_ss_info (); + ss_info->type = type; + ss = gfc_get_ss (); + ss->info = ss_info; ss->next = next; - ss->type = type; ss->expr = expr; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) @@ -537,11 +552,15 @@ gfc_ss * gfc_get_temp_ss (tree type, tree string_length, int dimen) { gfc_ss *ss; + gfc_ss_info *ss_info; int i; + ss_info = gfc_get_ss_info (); + ss_info->type = GFC_SS_TEMP; + ss = gfc_get_ss (); + ss->info = ss_info; ss->next = gfc_ss_terminator; - ss->type = GFC_SS_TEMP; ss->string_length = string_length; ss->data.temp.type = type; ss->dimen = dimen; @@ -558,10 +577,14 @@ gfc_ss * gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) { gfc_ss *ss; + gfc_ss_info *ss_info; + + ss_info = gfc_get_ss_info (); + ss_info->type = GFC_SS_SCALAR; ss = gfc_get_ss (); + ss->info = ss_info; ss->next = next; - ss->type = GFC_SS_SCALAR; ss->expr = expr; return ss; @@ -2118,7 +2141,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) difference between the vector's upper and lower bounds. */ gcc_assert (loop->from[n] == gfc_index_zero_node); gcc_assert (info->subscript[dim] - && info->subscript[dim]->type == GFC_SS_VECTOR); + && info->subscript[dim]->info->type == GFC_SS_VECTOR); gfc_init_se (&se, NULL); desc = info->subscript[dim]->data.info.descriptor; @@ -2153,7 +2176,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gcc_assert (ss); - switch (ss->type) + switch (ss->info->type) { case GFC_SS_SCALAR: /* Scalar expression. Evaluate this now. This includes elemental @@ -2533,7 +2556,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, case DIMEN_ELEMENT: /* Elemental dimension. */ gcc_assert (info->subscript[dim] - && info->subscript[dim]->type == GFC_SS_SCALAR); + && info->subscript[dim]->info->type == GFC_SS_SCALAR); /* We've already translated this value outside the loop. */ index = info->subscript[dim]->data.scalar.expr; @@ -2545,7 +2568,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, case DIMEN_VECTOR: gcc_assert (info && se->loop); gcc_assert (info->subscript[dim] - && info->subscript[dim]->type == GFC_SS_VECTOR); + && info->subscript[dim]->info->type == GFC_SS_VECTOR); desc = info->subscript[dim]->data.info.descriptor; /* Get a zero-based index into the vector. */ @@ -2600,7 +2623,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, /* Pointer functions can have stride[0] different from unity. Use the stride returned by the function call and stored in the descriptor for the temporary. */ - if (se->ss && se->ss->type == GFC_SS_FUNCTION + if (se->ss && se->ss->info->type == GFC_SS_FUNCTION && se->ss->expr && se->ss->expr->symtree && se->ss->expr->symtree->n.sym->result @@ -2854,6 +2877,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, { tree stride; gfc_array_info *info; + gfc_ss_type ss_type; gfc_ss *ss; gfc_array_ref *ar; int i; @@ -2865,9 +2889,11 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if ((ss->useflags & flag) == 0) continue; - if (ss->type != GFC_SS_SECTION - && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR - && ss->type != GFC_SS_COMPONENT) + ss_type = ss->info->type; + if (ss_type != GFC_SS_SECTION + && ss_type != GFC_SS_FUNCTION + && ss_type != GFC_SS_CONSTRUCTOR + && ss_type != GFC_SS_COMPONENT) continue; info = &ss->data.info; @@ -3134,12 +3160,16 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) /* Restore the initial offsets. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { + gfc_ss_type ss_type; + if ((ss->useflags & 2) == 0) continue; - if (ss->type != GFC_SS_SECTION - && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR - && ss->type != GFC_SS_COMPONENT) + ss_type = ss->info->type; + if (ss_type != GFC_SS_SECTION + && ss_type != GFC_SS_FUNCTION + && ss_type != GFC_SS_CONSTRUCTOR + && ss_type != GFC_SS_COMPONENT) continue; ss->data.info.offset = ss->data.info.saved_offset; @@ -3207,7 +3237,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim) gfc_array_info *info; gfc_array_ref *ar; - gcc_assert (ss->type == GFC_SS_SECTION); + gcc_assert (ss->info->type == GFC_SS_SECTION); info = &ss->data.info; ar = &info->ref->u.ar; @@ -3264,7 +3294,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) /* Determine the rank of the loop. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - switch (ss->type) + switch (ss->info->type) { case GFC_SS_SECTION: case GFC_SS_CONSTRUCTOR: @@ -3309,7 +3339,7 @@ done: if (ss->expr && ss->expr->shape && !info->shape) info->shape = ss->expr->shape; - switch (ss->type) + switch (ss->info->type) { case GFC_SS_SECTION: /* Get the descriptor for the array. */ @@ -3372,7 +3402,7 @@ done: { stmtblock_t inner; - if (ss->type != GFC_SS_SECTION) + if (ss->info->type != GFC_SS_SECTION) continue; /* Catch allocatable lhs in f2003. */ @@ -3757,7 +3787,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, for (ss = rss; ss != gfc_ss_terminator; ss = ss->next) { - if (ss->type != GFC_SS_SECTION) + if (ss->info->type != GFC_SS_SECTION) continue; if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym) @@ -3874,7 +3904,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { gfc_ss_type ss_type; - ss_type = ss->type; + ss_type = ss->info->type; if (ss_type == GFC_SS_SCALAR || ss_type == GFC_SS_TEMP || ss_type == GFC_SS_REFERENCE) @@ -3907,7 +3937,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) continue; } - if (ss->type == GFC_SS_CONSTRUCTOR) + if (ss_type == GFC_SS_CONSTRUCTOR) { gfc_constructor_base base; /* An unknown size constructor will always be rank one. @@ -3928,7 +3958,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* TODO: Pick the best bound if we have a choice between a function and something else. */ - if (ss->type == GFC_SS_FUNCTION) + if (ss_type == GFC_SS_FUNCTION) { loopspec[n] = ss; continue; @@ -3939,7 +3969,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) if (loopspec[n] && ss->is_alloc_lhs) continue; - if (ss->type != GFC_SS_SECTION) + if (ss_type != GFC_SS_SECTION) continue; if (!loopspec[n]) @@ -3951,7 +3981,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) known lower bound known upper bound */ - else if ((loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n]) + else if ((loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n]) || n >= loop->dimen) loopspec[n] = ss; else if (integer_onep (info->stride[dim]) @@ -3997,7 +4027,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) else { loop->from[n] = info->start[dim]; - switch (loopspec[n]->type) + switch (loopspec[n]->info->type) { case GFC_SS_CONSTRUCTOR: /* The upper bound is calculated when we expand the @@ -4054,7 +4084,10 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* If we want a temporary then create it. */ if (tmp_ss != NULL) { - gcc_assert (loop->temp_ss->type == GFC_SS_TEMP); + gfc_ss_info *tmp_ss_info; + + tmp_ss_info = tmp_ss->info; + gcc_assert (tmp_ss_info->type == GFC_SS_TEMP); /* Make absolutely sure that this is a complete type. */ if (loop->temp_ss->string_length) @@ -4065,7 +4098,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp = loop->temp_ss->data.temp.type; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); - loop->temp_ss->type = GFC_SS_SECTION; + tmp_ss_info->type = GFC_SS_SECTION; gcc_assert (tmp_ss->dimen != 0); @@ -4087,9 +4120,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* Calculate the translation from loop variables to array indices. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT - && ss->type != GFC_SS_CONSTRUCTOR) + gfc_ss_type ss_type; + ss_type = ss->info->type; + if (ss_type != GFC_SS_SECTION + && ss_type != GFC_SS_COMPONENT + && ss_type != GFC_SS_CONSTRUCTOR) continue; info = &ss->data.info; @@ -5702,6 +5738,7 @@ transposed_dims (gfc_ss *ss) void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { + gfc_ss_type ss_type; gfc_loopinfo loop; gfc_array_info *info; int need_tmp; @@ -5718,6 +5755,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gcc_assert (ss != NULL); gcc_assert (ss != gfc_ss_terminator); + ss_type = ss->info->type; + /* Special case things we know we can pass easily. */ switch (expr->expr_type) { @@ -5725,7 +5764,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* If we have a linear array section, we can pass it directly. Otherwise we need to copy it into a temporary. */ - gcc_assert (ss->type == GFC_SS_SECTION); + gcc_assert (ss_type == GFC_SS_SECTION); gcc_assert (ss->expr == expr); info = &ss->data.info; @@ -5804,7 +5843,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) if (se->direct_byref) { - gcc_assert (ss->type == GFC_SS_FUNCTION && ss->expr == expr); + gcc_assert (ss_type == GFC_SS_FUNCTION && ss->expr == expr); /* For pointer assignments pass the descriptor directly. */ if (se->ss == NULL) @@ -5816,7 +5855,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) return; } - if (ss->expr != expr || ss->type != GFC_SS_FUNCTION) + if (ss->expr != expr || ss_type != GFC_SS_FUNCTION) { if (ss->expr != expr) /* Elemental function. */ @@ -5825,7 +5864,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) || (expr->value.function.isym != NULL && expr->value.function.isym->elemental)); else - gcc_assert (ss->type == GFC_SS_INTRINSIC); + gcc_assert (ss_type == GFC_SS_INTRINSIC); need_tmp = 1; if (expr->ts.type == BT_CHARACTER @@ -5844,7 +5883,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) case EXPR_ARRAY: /* Constant array constructors don't need a temporary. */ - if (ss->type == GFC_SS_CONSTRUCTOR + if (ss_type == GFC_SS_CONSTRUCTOR && expr->ts.type != BT_CHARACTER && gfc_constant_array_constructor_p (expr->value.constructor)) { @@ -6055,7 +6094,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT) { gcc_assert (info->subscript[n] - && info->subscript[n]->type == GFC_SS_SCALAR); + && info->subscript[n]->info->type == GFC_SS_SCALAR); start = info->subscript[n]->data.scalar.expr; } else @@ -7811,7 +7850,7 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, /* Scalar argument. */ gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE); newss = gfc_get_scalar_ss (head, arg->expr); - newss->type = type; + newss->info->type = type; } else scalar = 0; -- cgit v1.2.1 From bfa437805588fe031de39fef8eed00cc0a244a41 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:01:46 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field expr from the former struct to the latter. * trans-array.c (gfc_get_array_ss, gfc_get_scalar_ss, gfc_trans_constant_array_constructor, gfc_trans_array_constructor, gfc_add_loop_ss_code, gfc_conv_ss_descriptor, gfc_trans_array_bound_check, gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, gfc_conv_ss_startstride, gfc_could_be_alias, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment): Update references to expr and factor common reference chains where possible. * trans-const.c (gfc_conv_constant): Ditto. * trans-expr.c (gfc_conv_variable, gfc_conv_procedure_call, gfc_conv_array_constructor_expr, gfc_conv_expr, gfc_conv_expr_reference): Ditto. * trans-intrinsic.c (trans_this_image, gfc_conv_intrinsic_bound, gfc_conv_intrinsic_cobound, gfc_conv_intrinsic_funcall, gfc_add_intrinsic_ss_code): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180868 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 203 +++++++++++++++++++++++++++------------------- 1 file changed, 120 insertions(+), 83 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 80dadf4c4db..65f7aded2d6 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -533,11 +533,11 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) ss_info = gfc_get_ss_info (); ss_info->type = type; + ss_info->expr = expr; ss = gfc_get_ss (); ss->info = ss_info; ss->next = next; - ss->expr = expr; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) ss->dim[i] = i; @@ -581,11 +581,11 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) ss_info = gfc_get_ss_info (); ss_info->type = GFC_SS_SCALAR; + ss_info->expr = expr; ss = gfc_get_ss (); ss->info = ss_info; ss->next = next; - ss->expr = expr; return ss; } @@ -1882,7 +1882,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) tree tmp; int i; - tmp = gfc_build_constant_array_constructor (ss->expr, type); + tmp = gfc_build_constant_array_constructor (ss->info->expr, type); info = &ss->data.info; @@ -1953,19 +1953,22 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; + gfc_expr *expr; /* Save the old values for nested checking. */ old_first_len = first_len; old_first_len_val = first_len_val; old_typespec_chararray_ctor = typespec_chararray_ctor; + expr = ss->info->expr; + /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no typespec was given for the array constructor. */ - typespec_chararray_ctor = (ss->expr->ts.u.cl - && ss->expr->ts.u.cl->length_from_typespec); + typespec_chararray_ctor = (expr->ts.u.cl + && expr->ts.u.cl->length_from_typespec); if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) - && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor) + && expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor) { first_len_val = gfc_create_var (gfc_charlen_type_node, "len"); first_len = true; @@ -1973,22 +1976,22 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) gcc_assert (ss->dimen == loop->dimen); - c = ss->expr->value.constructor; - if (ss->expr->ts.type == BT_CHARACTER) + c = expr->value.constructor; + if (expr->ts.type == BT_CHARACTER) { bool const_string; /* get_array_ctor_strlen walks the elements of the constructor, if a typespec was given, we already know the string length and want the one specified there. */ - if (typespec_chararray_ctor && ss->expr->ts.u.cl->length - && ss->expr->ts.u.cl->length->expr_type != EXPR_CONSTANT) + if (typespec_chararray_ctor && expr->ts.u.cl->length + && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT) { gfc_se length_se; const_string = false; gfc_init_se (&length_se, NULL); - gfc_conv_expr_type (&length_se, ss->expr->ts.u.cl->length, + gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_charlen_type_node); ss->string_length = length_se.expr; gfc_add_block_to_block (&loop->pre, &length_se.pre); @@ -2002,26 +2005,26 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) and not end up here. */ gcc_assert (ss->string_length); - ss->expr->ts.u.cl->backend_decl = ss->string_length; + expr->ts.u.cl->backend_decl = ss->string_length; - type = gfc_get_character_type_len (ss->expr->ts.kind, ss->string_length); + type = gfc_get_character_type_len (expr->ts.kind, ss->string_length); if (const_string) type = build_pointer_type (type); } else - type = gfc_typenode_for_spec (&ss->expr->ts); + type = gfc_typenode_for_spec (&expr->ts); /* See if the constructor determines the loop bounds. */ dynamic = false; - if (ss->expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) + if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) { /* We have a multidimensional parameter. */ int n; - for (n = 0; n < ss->expr->rank; n++) + for (n = 0; n < expr->rank; n++) { loop->from[n] = gfc_index_zero_node; - loop->to[n] = gfc_conv_mpz_to_tree (ss->expr->shape [n], + loop->to[n] = gfc_conv_mpz_to_tree (expr->shape [n], gfc_index_integer_kind); loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, @@ -2166,6 +2169,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, locus * where) { gfc_se se; + gfc_ss_info *ss_info; + gfc_expr *expr; int n; /* TODO: This can generate bad code if there are ordering dependencies, @@ -2176,16 +2181,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gcc_assert (ss); - switch (ss->info->type) + ss_info = ss->info; + expr = ss_info->expr; + + switch (ss_info->type) { case GFC_SS_SCALAR: /* Scalar expression. Evaluate this now. This includes elemental dimension indices, but not array section bounds. */ gfc_init_se (&se, NULL); - gfc_conv_expr (&se, ss->expr); + gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); - if (ss->expr->ts.type != BT_CHARACTER) + if (expr->ts.type != BT_CHARACTER) { /* Move the evaluation of scalar expressions outside the scalarization loop, except for WHERE assignments. */ @@ -2206,7 +2214,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, /* Scalar argument to elemental procedure. Evaluate this now. */ gfc_init_se (&se, NULL); - gfc_conv_expr (&se, ss->expr); + gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); @@ -2227,7 +2235,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, case GFC_SS_VECTOR: /* Get the vector's descriptor and store it in SS. */ gfc_init_se (&se, NULL); - gfc_conv_expr_descriptor (&se, ss->expr, gfc_walk_expr (ss->expr)); + gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr)); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); ss->data.info.descriptor = se.expr; @@ -2243,20 +2251,20 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_init_se (&se, NULL); se.loop = loop; se.ss = ss; - gfc_conv_expr (&se, ss->expr); + gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); ss->string_length = se.string_length; break; case GFC_SS_CONSTRUCTOR: - if (ss->expr->ts.type == BT_CHARACTER - && ss->string_length == NULL - && ss->expr->ts.u.cl - && ss->expr->ts.u.cl->length) + if (expr->ts.type == BT_CHARACTER + && ss->string_length == NULL + && expr->ts.u.cl + && expr->ts.u.cl->length) { gfc_init_se (&se, NULL); - gfc_conv_expr_type (&se, ss->expr->ts.u.cl->length, + gfc_conv_expr_type (&se, expr->ts.u.cl->length, gfc_charlen_type_node); ss->string_length = se.expr; gfc_add_block_to_block (&loop->pre, &se.pre); @@ -2284,13 +2292,16 @@ static void gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) { gfc_se se; + gfc_ss_info *ss_info; tree tmp; + ss_info = ss->info; + /* Get the descriptor for the array to be scalarized. */ - gcc_assert (ss->expr->expr_type == EXPR_VARIABLE); + gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE); gfc_init_se (&se, NULL); se.descriptor_only = 1; - gfc_conv_expr_lhs (&se, ss->expr); + gfc_conv_expr_lhs (&se, ss_info->expr); gfc_add_block_to_block (block, &se.pre); ss->data.info.descriptor = se.expr; ss->string_length = se.string_length; @@ -2473,7 +2484,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, index = gfc_evaluate_now (index, &se->pre); /* We find a name for the error message. */ - name = ss->expr->symtree->n.sym->name; + name = ss->info->expr->symtree->n.sym->name; gcc_assert (name != NULL); if (TREE_CODE (descriptor) == VAR_DECL) @@ -2624,10 +2635,10 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, Use the stride returned by the function call and stored in the descriptor for the temporary. */ if (se->ss && se->ss->info->type == GFC_SS_FUNCTION - && se->ss->expr - && se->ss->expr->symtree - && se->ss->expr->symtree->n.sym->result - && se->ss->expr->symtree->n.sym->result->attr.pointer) + && se->ss->info->expr + && se->ss->info->expr->symtree + && se->ss->info->expr->symtree->n.sym->result + && se->ss->info->expr->symtree->n.sym->result->attr.pointer) stride = gfc_conv_descriptor_stride_get (info->descriptor, gfc_rank_cst[dim]); @@ -2655,9 +2666,11 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) tree index; tree tmp; gfc_ss *ss; + gfc_expr *expr; int n; ss = se->ss; + expr = ss->info->expr; info = &ss->data.info; if (ar) n = se->loop->order[0]; @@ -2671,11 +2684,10 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, index, info->offset); - if (se->ss->expr && is_subref_array (se->ss->expr)) - decl = se->ss->expr->symtree->n.sym->backend_decl; + if (expr && is_subref_array (expr)) + decl = expr->symtree->n.sym->backend_decl; - tmp = build_fold_indirect_ref_loc (input_location, - info->data); + tmp = build_fold_indirect_ref_loc (input_location, info->data); se->expr = gfc_build_array_ref (tmp, index, decl); } @@ -3305,7 +3317,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) /* As usual, lbound and ubound are exceptions!. */ case GFC_SS_INTRINSIC: - switch (ss->expr->value.function.isym->id) + switch (ss->info->expr->value.function.isym->id) { case GFC_ISYM_LBOUND: case GFC_ISYM_UBOUND: @@ -3332,14 +3344,18 @@ done: /* Loop over all the SS in the chain. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { + gfc_ss_info *ss_info; gfc_array_info *info; + gfc_expr *expr; + ss_info = ss->info; + expr = ss_info->expr; info = &ss->data.info; - if (ss->expr && ss->expr->shape && !info->shape) - info->shape = ss->expr->shape; + if (expr && expr->shape && !info->shape) + info->shape = expr->shape; - switch (ss->info->type) + switch (ss_info->type) { case GFC_SS_SECTION: /* Get the descriptor for the array. */ @@ -3350,7 +3366,7 @@ done: break; case GFC_SS_INTRINSIC: - switch (ss->expr->value.function.isym->id) + switch (expr->value.function.isym->id) { /* Fall through to supply start and stride. */ case GFC_ISYM_LBOUND: @@ -3401,14 +3417,23 @@ done: for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { stmtblock_t inner; + gfc_ss_info *ss_info; + gfc_expr *expr; + locus *expr_loc; + const char *expr_name; - if (ss->info->type != GFC_SS_SECTION) + ss_info = ss->info; + if (ss_info->type != GFC_SS_SECTION) continue; /* Catch allocatable lhs in f2003. */ if (gfc_option.flag_realloc_lhs && ss->is_alloc_lhs) continue; + expr = ss_info->expr; + expr_loc = &expr->where; + expr_name = expr->symtree->name; + gfc_start_block (&inner); /* TODO: range checking for mapped dimensions. */ @@ -3434,9 +3459,9 @@ done: tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, info->stride[dim], gfc_index_zero_node); asprintf (&msg, "Zero stride is not allowed, for dimension %d " - "of array '%s'", dim + 1, ss->expr->symtree->name); + "of array '%s'", dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg); + expr_loc, msg); free (msg); desc = ss->data.info.descriptor; @@ -3493,14 +3518,14 @@ done: non_zerosized, tmp2); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "outside of expected range (%%ld:%%ld)", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, info->start[dim]), fold_convert (long_integer_type_node, lbound), fold_convert (long_integer_type_node, ubound)); gfc_trans_runtime_check (true, false, tmp2, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, info->start[dim]), fold_convert (long_integer_type_node, lbound), fold_convert (long_integer_type_node, ubound)); @@ -3515,9 +3540,9 @@ done: boolean_type_node, non_zerosized, tmp); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "below lower bound of %%ld", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, info->start[dim]), fold_convert (long_integer_type_node, lbound)); free (msg); @@ -3547,14 +3572,14 @@ done: boolean_type_node, non_zerosized, tmp3); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "outside of expected range (%%ld:%%ld)", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp2, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, ubound), fold_convert (long_integer_type_node, lbound)); gfc_trans_runtime_check (true, false, tmp3, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, ubound), fold_convert (long_integer_type_node, lbound)); @@ -3564,9 +3589,9 @@ done: { asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "below lower bound of %%ld", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp2, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, lbound)); free (msg); @@ -3593,10 +3618,10 @@ done: boolean_type_node, tmp, size[n]); asprintf (&msg, "Array bound mismatch for dimension %d " "of array '%s' (%%ld/%%ld)", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp3, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, size[n])); @@ -3610,10 +3635,10 @@ done: /* For optional arguments, only check bounds if the argument is present. */ - if (ss->expr->symtree->n.sym->attr.optional - || ss->expr->symtree->n.sym->attr.not_always_present) + if (expr->symtree->n.sym->attr.optional + || expr->symtree->n.sym->attr.not_always_present) tmp = build3_v (COND_EXPR, - gfc_conv_expr_present (ss->expr->symtree->n.sym), + gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&block, tmp); @@ -3666,12 +3691,16 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) { gfc_ref *lref; gfc_ref *rref; + gfc_expr *lexpr, *rexpr; gfc_symbol *lsym; gfc_symbol *rsym; bool lsym_pointer, lsym_target, rsym_pointer, rsym_target; - lsym = lss->expr->symtree->n.sym; - rsym = rss->expr->symtree->n.sym; + lexpr = lss->info->expr; + rexpr = rss->info->expr; + + lsym = lexpr->symtree->n.sym; + rsym = rexpr->symtree->n.sym; lsym_pointer = lsym->attr.pointer; lsym_target = lsym->attr.target; @@ -3689,7 +3718,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) /* For derived types we must check all the component types. We can ignore array references as these will have the same base type as the previous component ref. */ - for (lref = lss->expr->ref; lref != lss->data.info.ref; lref = lref->next) + for (lref = lexpr->ref; lref != lss->data.info.ref; lref = lref->next) { if (lref->type != REF_COMPONENT) continue; @@ -3709,7 +3738,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) return 1; } - for (rref = rss->expr->ref; rref != rss->data.info.ref; + for (rref = rexpr->ref; rref != rss->data.info.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) @@ -3744,7 +3773,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) lsym_pointer = lsym->attr.pointer; lsym_target = lsym->attr.target; - for (rref = rss->expr->ref; rref != rss->data.info.ref; rref = rref->next) + for (rref = rexpr->ref; rref != rss->data.info.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) break; @@ -3780,20 +3809,25 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, gfc_ss *ss; gfc_ref *lref; gfc_ref *rref; + gfc_expr *dest_expr; + gfc_expr *ss_expr; int nDepend = 0; int i, j; loop->temp_ss = NULL; + dest_expr = dest->info->expr; for (ss = rss; ss != gfc_ss_terminator; ss = ss->next) { if (ss->info->type != GFC_SS_SECTION) continue; - if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym) + ss_expr = ss->info->expr; + + if (dest_expr->symtree->n.sym != ss_expr->symtree->n.sym) { if (gfc_could_be_alias (dest, ss) - || gfc_are_equivalenced_arrays (dest->expr, ss->expr)) + || gfc_are_equivalenced_arrays (dest_expr, ss_expr)) { nDepend = 1; break; @@ -3801,8 +3835,8 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, } else { - lref = dest->expr->ref; - rref = ss->expr->ref; + lref = dest_expr->ref; + rref = ss_expr->ref; nDepend = gfc_dep_resolver (lref, rref, &loop->reverse[0]); @@ -3861,7 +3895,7 @@ temporary: if (nDepend == 1) { - tree base_type = gfc_typenode_for_spec (&dest->expr->ts); + tree base_type = gfc_typenode_for_spec (&dest_expr->ts); if (GFC_ARRAY_TYPE_P (base_type) || GFC_DESCRIPTOR_TYPE_P (base_type)) base_type = gfc_get_element_type (base_type); @@ -3949,7 +3983,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) can be determined at compile time. Prefer not to otherwise, since the general case involves realloc, and it's better to avoid that overhead if possible. */ - base = ss->expr->value.constructor; + base = ss->info->expr->value.constructor; dynamic[n] = gfc_get_array_constructor_size (&i, base); if (!dynamic[n] || !loopspec[n]) loopspec[n] = ss; @@ -5739,6 +5773,7 @@ void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { gfc_ss_type ss_type; + gfc_ss_info *ss_info; gfc_loopinfo loop; gfc_array_info *info; int need_tmp; @@ -5750,12 +5785,14 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) tree offset; int full; bool subref_array_target = false; - gfc_expr *arg; + gfc_expr *arg, *ss_expr; gcc_assert (ss != NULL); gcc_assert (ss != gfc_ss_terminator); - ss_type = ss->info->type; + ss_info = ss->info; + ss_type = ss_info->type; + ss_expr = ss_info->expr; /* Special case things we know we can pass easily. */ switch (expr->expr_type) @@ -5765,7 +5802,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) Otherwise we need to copy it into a temporary. */ gcc_assert (ss_type == GFC_SS_SECTION); - gcc_assert (ss->expr == expr); + gcc_assert (ss_expr == expr); info = &ss->data.info; /* Get the descriptor for the array. */ @@ -5843,7 +5880,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) if (se->direct_byref) { - gcc_assert (ss_type == GFC_SS_FUNCTION && ss->expr == expr); + gcc_assert (ss_type == GFC_SS_FUNCTION && ss_expr == expr); /* For pointer assignments pass the descriptor directly. */ if (se->ss == NULL) @@ -5855,9 +5892,9 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) return; } - if (ss->expr != expr || ss_type != GFC_SS_FUNCTION) + if (ss_expr != expr || ss_type != GFC_SS_FUNCTION) { - if (ss->expr != expr) + if (ss_expr != expr) /* Elemental function. */ gcc_assert ((expr->value.function.esym != NULL && expr->value.function.esym->attr.elemental) @@ -7211,11 +7248,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Find the ss for the lhs. */ lss = loop->ss; for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain) - if (lss->expr && lss->expr->expr_type == EXPR_VARIABLE) + if (lss->info->expr && lss->info->expr->expr_type == EXPR_VARIABLE) break; if (lss == gfc_ss_terminator) return NULL_TREE; - expr1 = lss->expr; + expr1 = lss->info->expr; } /* Bail out if this is not a valid allocate on assignment. */ @@ -7226,7 +7263,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Find the ss for the lhs. */ lss = loop->ss; for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain) - if (lss->expr == expr1) + if (lss->info->expr == expr1) break; if (lss == gfc_ss_terminator) @@ -7236,7 +7273,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, ss's for the operands. Any one of these will do. */ rss = loop->ss; for (; rss && rss != gfc_ss_terminator; rss = rss->loop_chain) - if (rss->expr != expr1 && rss != loop->temp_ss) + if (rss->info->expr != expr1 && rss != loop->temp_ss) break; if (expr2 && rss == gfc_ss_terminator) -- cgit v1.2.1 From 3d653dea0f9e13fd2484d3ee3135800c2c93a0eb Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:04:50 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field string_length from the former struct to the latter. * trans-array.c (gfc_get_temp_ss, gfc_trans_array_constructor, gfc_add_loop_ss_code, gfc_conv_ss_descriptor, gfc_conv_scalarized_array_ref, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, gfc_conv_expr_descriptor): Update references to string_length and factor common reference chains where possible. * trans-const.c (gfc_conv_constant): Ditto. * trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg, gfc_conv_expr): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180869 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 65f7aded2d6..827d13d3946 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -557,11 +557,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen) ss_info = gfc_get_ss_info (); ss_info->type = GFC_SS_TEMP; + ss_info->string_length = string_length; ss = gfc_get_ss (); ss->info = ss_info; ss->next = gfc_ss_terminator; - ss->string_length = string_length; ss->data.temp.type = type; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) @@ -1953,6 +1953,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; + gfc_ss_info *ss_info; gfc_expr *expr; /* Save the old values for nested checking. */ @@ -1960,7 +1961,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) old_first_len_val = first_len_val; old_typespec_chararray_ctor = typespec_chararray_ctor; - expr = ss->info->expr; + ss_info = ss->info; + expr = ss_info->expr; /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no typespec was given for the array constructor. */ @@ -1993,21 +1995,21 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) gfc_init_se (&length_se, NULL); gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_charlen_type_node); - ss->string_length = length_se.expr; + ss_info->string_length = length_se.expr; gfc_add_block_to_block (&loop->pre, &length_se.pre); gfc_add_block_to_block (&loop->post, &length_se.post); } else const_string = get_array_ctor_strlen (&loop->pre, c, - &ss->string_length); + &ss_info->string_length); /* Complex character array constructors should have been taken care of and not end up here. */ - gcc_assert (ss->string_length); + gcc_assert (ss_info->string_length); - expr->ts.u.cl->backend_decl = ss->string_length; + expr->ts.u.cl->backend_decl = ss_info->string_length; - type = gfc_get_character_type_len (expr->ts.kind, ss->string_length); + type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length); if (const_string) type = build_pointer_type (type); } @@ -2207,7 +2209,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->post, &se.post); ss->data.scalar.expr = se.expr; - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; break; case GFC_SS_REFERENCE: @@ -2219,7 +2221,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->post, &se.post); ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre); - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; break; case GFC_SS_SECTION: @@ -2254,19 +2256,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; break; case GFC_SS_CONSTRUCTOR: if (expr->ts.type == BT_CHARACTER - && ss->string_length == NULL + && ss_info->string_length == NULL && expr->ts.u.cl && expr->ts.u.cl->length) { gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, expr->ts.u.cl->length, gfc_charlen_type_node); - ss->string_length = se.expr; + ss_info->string_length = se.expr; gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); } @@ -2304,7 +2306,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) gfc_conv_expr_lhs (&se, ss_info->expr); gfc_add_block_to_block (block, &se.pre); ss->data.info.descriptor = se.expr; - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; if (base) { @@ -2697,7 +2699,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) void gfc_conv_tmp_array_ref (gfc_se * se) { - se->string_length = se->ss->string_length; + se->string_length = se->ss->info->string_length; gfc_conv_scalarized_array_ref (se, NULL); gfc_advance_se_ss_chain (se); } @@ -3899,7 +3901,7 @@ temporary: if (GFC_ARRAY_TYPE_P (base_type) || GFC_DESCRIPTOR_TYPE_P (base_type)) base_type = gfc_get_element_type (base_type); - loop->temp_ss = gfc_get_temp_ss (base_type, dest->string_length, + loop->temp_ss = gfc_get_temp_ss (base_type, dest->info->string_length, loop->dimen); gfc_add_ss_to_loop (loop, loop->temp_ss); } @@ -4124,11 +4126,11 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (tmp_ss_info->type == GFC_SS_TEMP); /* Make absolutely sure that this is a complete type. */ - if (loop->temp_ss->string_length) + if (tmp_ss_info->string_length) loop->temp_ss->data.temp.type = gfc_get_character_type_len_for_eltype (TREE_TYPE (loop->temp_ss->data.temp.type), - loop->temp_ss->string_length); + tmp_ss_info->string_length); tmp = loop->temp_ss->data.temp.type; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); @@ -5973,7 +5975,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) : NULL), loop.dimen); - se->string_length = loop.temp_ss->string_length; + se->string_length = loop.temp_ss->info->string_length; gcc_assert (loop.temp_ss->dimen == loop.dimen); gfc_add_ss_to_loop (&loop, loop.temp_ss); } @@ -6030,7 +6032,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss)) { desc = info->descriptor; - se->string_length = ss->string_length; + se->string_length = ss_info->string_length; } else { -- cgit v1.2.1 From aaaf75f7383104e9da85f377bf647e21f79049dd Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:10:25 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct gfc_ss::data::scalar into newly created union gfc_ss_info::data, and rename subfield expr to value. * trans-array.c (gfc_add_loop_ss_code, gfc_conv_array_index_offset, gfc_conv_expr_descriptor): Update reference chains. * trans-const.c (gfc_conv_constant): Ditto. * trans-expr.c (gfc_conv_expr): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180870 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 827d13d3946..eef0f097f2a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2208,7 +2208,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, else gfc_add_block_to_block (&loop->post, &se.post); - ss->data.scalar.expr = se.expr; + ss_info->data.scalar.value = se.expr; ss_info->string_length = se.string_length; break; @@ -2220,7 +2220,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); - ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre); + ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre); ss_info->string_length = se.string_length; break; @@ -2571,7 +2571,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, gcc_assert (info->subscript[dim] && info->subscript[dim]->info->type == GFC_SS_SCALAR); /* We've already translated this value outside the loop. */ - index = info->subscript[dim]->data.scalar.expr; + index = info->subscript[dim]->info->data.scalar.value; index = trans_array_bound_check (se, ss, index, dim, &ar->where, ar->as->type != AS_ASSUMED_SIZE @@ -6134,7 +6134,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { gcc_assert (info->subscript[n] && info->subscript[n]->info->type == GFC_SS_SCALAR); - start = info->subscript[n]->data.scalar.expr; + start = info->subscript[n]->info->data.scalar.value; } else { -- cgit v1.2.1 From 0a9ca5de5663f6e84b301bd4b08f6590de0c8c5d Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:16:29 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct gfc_ss::data::temp into gfc_ss_info::data. * trans-array.c (gfc_get_temp_ss, gfc_conv_loop_setup): Update reference chains. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180872 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index eef0f097f2a..173e52b299e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -558,11 +558,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen) ss_info = gfc_get_ss_info (); ss_info->type = GFC_SS_TEMP; ss_info->string_length = string_length; + ss_info->data.temp.type = type; ss = gfc_get_ss (); ss->info = ss_info; ss->next = gfc_ss_terminator; - ss->data.temp.type = type; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) ss->dim[i] = i; @@ -4127,12 +4127,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* Make absolutely sure that this is a complete type. */ if (tmp_ss_info->string_length) - loop->temp_ss->data.temp.type + tmp_ss_info->data.temp.type = gfc_get_character_type_len_for_eltype - (TREE_TYPE (loop->temp_ss->data.temp.type), + (TREE_TYPE (tmp_ss_info->data.temp.type), tmp_ss_info->string_length); - tmp = loop->temp_ss->data.temp.type; + tmp = tmp_ss_info->data.temp.type; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); tmp_ss_info->type = GFC_SS_SECTION; -- cgit v1.2.1 From b8f3834798a7071af579131273d8beefa4db1bdb Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:21:36 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field gfc_ss::data::info into gfc_ss_info::data and remove empty union gfc_ss::data. * trans-array.c (gfc_free_ss, gfc_trans_create_temp_array, gfc_trans_constant_array_constructor, gfc_trans_array_constructor, gfc_set_vector_loop_bounds, gfc_add_loop_ss_code, gfc_conv_ss_descriptor, gfc_trans_array_bound_check, gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, add_array_offset, gfc_trans_preloop_setup, gfc_trans_scalarized_boundary, gfc_conv_section_startstride, gfc_conv_ss_startstride, gfc_could_be_alias, gfc_conv_loop_setup, gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment, gfc_walk_array_ref): Update reference chains and factor them where possible. * trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg, gfc_conv_procedure_call, gfc_trans_subarray_assign): Updata reference chains. * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. * trans-io.c (transfer_array_component): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies, gfc_trans_pointer_assign_need_temp): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180873 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 130 +++++++++++++++++++++++++--------------------- 1 file changed, 71 insertions(+), 59 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 173e52b299e..78e1443fecf 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -508,8 +508,8 @@ gfc_free_ss (gfc_ss * ss) case GFC_SS_SECTION: for (n = 0; n < ss->dimen; n++) { - if (ss->data.info.subscript[ss->dim[n]]) - gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]); + if (ss_info->data.array.subscript[ss->dim[n]]) + gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]); } break; @@ -880,7 +880,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, memset (from, 0, sizeof (from)); memset (to, 0, sizeof (to)); - info = &ss->data.info; + info = &ss->info->data.array; gcc_assert (ss->dimen > 0); gcc_assert (loop->dimen == ss->dimen); @@ -1884,7 +1884,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) tmp = gfc_build_constant_array_constructor (ss->info->expr, type); - info = &ss->data.info; + info = &ss->info->data.array; info->descriptor = tmp; info->data = gfc_build_addr_expr (NULL_TREE, tmp); @@ -2073,7 +2073,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss, type, NULL_TREE, dynamic, true, false, where); - desc = ss->data.info.descriptor; + desc = ss_info->data.array.descriptor; offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); TREE_NO_WARNING (offsetvar) = 1; @@ -2133,7 +2133,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) int n; int dim; - info = &ss->data.info; + info = &ss->info->data.array; for (n = 0; n < loop->dimen; n++) { @@ -2149,7 +2149,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) && info->subscript[dim]->info->type == GFC_SS_VECTOR); gfc_init_se (&se, NULL); - desc = info->subscript[dim]->data.info.descriptor; + desc = info->subscript[dim]->info->data.array.descriptor; zero = gfc_rank_cst[0]; tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, @@ -2172,6 +2172,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gfc_se se; gfc_ss_info *ss_info; + gfc_array_info *info; gfc_expr *expr; int n; @@ -2185,6 +2186,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, ss_info = ss->info; expr = ss_info->expr; + info = &ss_info->data.array; switch (ss_info->type) { @@ -2227,9 +2229,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, case GFC_SS_SECTION: /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) - if (ss->data.info.subscript[n]) - gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true, - where); + if (info->subscript[n]) + gfc_add_loop_ss_code (loop, info->subscript[n], true, where); set_vector_loop_bounds (loop, ss); break; @@ -2240,7 +2241,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr)); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); - ss->data.info.descriptor = se.expr; + info->descriptor = se.expr; break; case GFC_SS_INTRINSIC: @@ -2295,9 +2296,11 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) { gfc_se se; gfc_ss_info *ss_info; + gfc_array_info *info; tree tmp; ss_info = ss->info; + info = &ss_info->data.array; /* Get the descriptor for the array to be scalarized. */ gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE); @@ -2305,7 +2308,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) se.descriptor_only = 1; gfc_conv_expr_lhs (&se, ss_info->expr); gfc_add_block_to_block (block, &se.pre); - ss->data.info.descriptor = se.expr; + info->descriptor = se.expr; ss_info->string_length = se.string_length; if (base) @@ -2320,15 +2323,15 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) || (TREE_CODE (tmp) == ADDR_EXPR && DECL_P (TREE_OPERAND (tmp, 0))))) tmp = gfc_evaluate_now (tmp, block); - ss->data.info.data = tmp; + info->data = tmp; tmp = gfc_conv_array_offset (se.expr); - ss->data.info.offset = gfc_evaluate_now (tmp, block); + info->offset = gfc_evaluate_now (tmp, block); /* Make absolutely sure that the saved_offset is indeed saved so that the variable is still accessible after the loops are translated. */ - ss->data.info.saved_offset = ss->data.info.offset; + info->saved_offset = info->offset; } } @@ -2481,7 +2484,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) return index; - descriptor = ss->data.info.descriptor; + descriptor = ss->info->data.array.descriptor; index = gfc_evaluate_now (index, &se->pre); @@ -2555,7 +2558,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, tree desc; tree data; - info = &ss->data.info; + info = &ss->info->data.array; /* Get the index into the array for this dimension. */ if (ar) @@ -2582,7 +2585,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, gcc_assert (info && se->loop); gcc_assert (info->subscript[dim] && info->subscript[dim]->info->type == GFC_SS_VECTOR); - desc = info->subscript[dim]->data.info.descriptor; + desc = info->subscript[dim]->info->data.array.descriptor; /* Get a zero-based index into the vector. */ index = fold_build2_loc (input_location, MINUS_EXPR, @@ -2673,7 +2676,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) ss = se->ss; expr = ss->info->expr; - info = &ss->data.info; + info = &ss->info->data.array; if (ar) n = se->loop->order[0]; else @@ -2866,7 +2869,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, gfc_array_info *info; tree stride, index; - info = &ss->data.info; + info = &ss->info->data.array; gfc_init_se (&se, NULL); se.loop = loop; @@ -2890,6 +2893,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, stmtblock_t * pblock) { tree stride; + gfc_ss_info *ss_info; gfc_array_info *info; gfc_ss_type ss_type; gfc_ss *ss; @@ -2900,17 +2904,19 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, for this dimension. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { + ss_info = ss->info; + if ((ss->useflags & flag) == 0) continue; - ss_type = ss->info->type; + ss_type = ss_info->type; if (ss_type != GFC_SS_SECTION && ss_type != GFC_SS_FUNCTION && ss_type != GFC_SS_CONSTRUCTOR && ss_type != GFC_SS_COMPONENT) continue; - info = &ss->data.info; + info = &ss_info->data.array; gcc_assert (dim < ss->dimen); gcc_assert (ss->dimen == loop->dimen); @@ -3175,18 +3181,21 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { gfc_ss_type ss_type; + gfc_ss_info *ss_info; + + ss_info = ss->info; if ((ss->useflags & 2) == 0) continue; - ss_type = ss->info->type; + ss_type = ss_info->type; if (ss_type != GFC_SS_SECTION && ss_type != GFC_SS_FUNCTION && ss_type != GFC_SS_CONSTRUCTOR && ss_type != GFC_SS_COMPONENT) continue; - ss->data.info.offset = ss->data.info.saved_offset; + ss_info->data.array.offset = ss_info->data.array.saved_offset; } /* Restart all the inner loops we just finished. */ @@ -3253,7 +3262,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim) gcc_assert (ss->info->type == GFC_SS_SECTION); - info = &ss->data.info; + info = &ss->info->data.array; ar = &info->ref->u.ar; if (ar->dimen_type[dim] == DIMEN_VECTOR) @@ -3352,7 +3361,7 @@ done: ss_info = ss->info; expr = ss_info->expr; - info = &ss->data.info; + info = &ss_info->data.array; if (expr && expr->shape && !info->shape) info->shape = expr->shape; @@ -3388,9 +3397,9 @@ done: { int dim = ss->dim[n]; - ss->data.info.start[dim] = gfc_index_zero_node; - ss->data.info.end[dim] = gfc_index_zero_node; - ss->data.info.stride[dim] = gfc_index_one_node; + info->start[dim] = gfc_index_zero_node; + info->end[dim] = gfc_index_zero_node; + info->stride[dim] = gfc_index_one_node; } break; @@ -3439,7 +3448,7 @@ done: gfc_start_block (&inner); /* TODO: range checking for mapped dimensions. */ - info = &ss->data.info; + info = &ss_info->data.array; /* This code only checks ranges. Elemental and vector dimensions are checked later. */ @@ -3466,7 +3475,7 @@ done: expr_loc, msg); free (msg); - desc = ss->data.info.descriptor; + desc = info->descriptor; /* This is the run-time equivalent of resolve.c's check_dimension(). The logical is more readable there @@ -3720,7 +3729,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) /* For derived types we must check all the component types. We can ignore array references as these will have the same base type as the previous component ref. */ - for (lref = lexpr->ref; lref != lss->data.info.ref; lref = lref->next) + for (lref = lexpr->ref; lref != lss->info->data.array.ref; lref = lref->next) { if (lref->type != REF_COMPONENT) continue; @@ -3740,7 +3749,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) return 1; } - for (rref = rexpr->ref; rref != rss->data.info.ref; + for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) @@ -3775,7 +3784,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) lsym_pointer = lsym->attr.pointer; lsym_target = lsym->attr.target; - for (rref = rexpr->ref; rref != rss->data.info.ref; rref = rref->next) + for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) break; @@ -3946,12 +3955,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) || ss_type == GFC_SS_REFERENCE) continue; - info = &ss->data.info; + info = &ss->info->data.array; dim = ss->dim[n]; if (loopspec[n] != NULL) { - specinfo = &loopspec[n]->data.info; + specinfo = &loopspec[n]->info->data.array; spec_dim = loopspec[n]->dim[n]; } else @@ -4039,7 +4048,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) that's bad news. */ gcc_assert (loopspec[n]); - info = &loopspec[n]->data.info; + info = &loopspec[n]->info->data.array; dim = loopspec[n]->dim[n]; /* Set the extents of this range. */ @@ -4133,7 +4142,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp_ss_info->string_length); tmp = tmp_ss_info->data.temp.type; - memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); + memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info)); tmp_ss_info->type = GFC_SS_SECTION; gcc_assert (tmp_ss->dimen != 0); @@ -4164,7 +4173,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) && ss_type != GFC_SS_CONSTRUCTOR) continue; - info = &ss->data.info; + info = &ss->info->data.array; for (n = 0; n < ss->dimen; n++) { @@ -5805,7 +5814,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gcc_assert (ss_type == GFC_SS_SECTION); gcc_assert (ss_expr == expr); - info = &ss->data.info; + info = &ss_info->data.array; /* Get the descriptor for the array. */ gfc_conv_ss_descriptor (&se->pre, ss, 0); @@ -5915,7 +5924,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else { /* Transformational function. */ - info = &ss->data.info; + info = &ss_info->data.array; need_tmp = 0; } break; @@ -5927,7 +5936,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) && gfc_constant_array_constructor_p (expr->value.constructor)) { need_tmp = 0; - info = &ss->data.info; + info = &ss_info->data.array; } else { @@ -6027,7 +6036,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* Finish the copying loops. */ gfc_trans_scalarizing_loops (&loop, &block); - desc = loop.temp_ss->data.info.descriptor; + desc = loop.temp_ss->info->data.array.descriptor; } else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss)) { @@ -7220,6 +7229,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, stmtblock_t fblock; gfc_ss *rss; gfc_ss *lss; + gfc_array_info *linfo; tree realloc_expr; tree alloc_expr; tree size1; @@ -7271,6 +7281,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, if (lss == gfc_ss_terminator) return NULL_TREE; + linfo = &lss->info->data.array; + /* Find an ss for the rhs. For operator expressions, we see the ss's for the operands. Any one of these will do. */ rss = loop->ss; @@ -7285,7 +7297,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Since the lhs is allocatable, this must be a descriptor type. Get the data and array size. */ - desc = lss->data.info.descriptor; + desc = linfo->descriptor; gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))); array1 = gfc_conv_descriptor_data_get (desc); @@ -7355,7 +7367,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Get the rhs size. Fix both sizes. */ if (expr2) - desc2 = rss->data.info.descriptor; + desc2 = rss->info->data.array.descriptor; else desc2 = NULL_TREE; size2 = gfc_index_one_node; @@ -7445,9 +7457,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, running offset. Use the saved_offset instead. */ tmp = gfc_conv_descriptor_offset (desc); gfc_add_modify (&fblock, tmp, offset); - if (lss->data.info.saved_offset - && TREE_CODE (lss->data.info.saved_offset) == VAR_DECL) - gfc_add_modify (&fblock, lss->data.info.saved_offset, tmp); + if (linfo->saved_offset + && TREE_CODE (linfo->saved_offset) == VAR_DECL) + gfc_add_modify (&fblock, linfo->saved_offset, tmp); /* Now set the deltas for the lhs. */ for (n = 0; n < expr1->rank; n++) @@ -7457,9 +7469,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, tmp, loop->from[dim]); - if (lss->data.info.delta[dim] - && TREE_CODE (lss->data.info.delta[dim]) == VAR_DECL) - gfc_add_modify (&fblock, lss->data.info.delta[dim], tmp); + if (linfo->delta[dim] + && TREE_CODE (linfo->delta[dim]) == VAR_DECL) + gfc_add_modify (&fblock, linfo->delta[dim], tmp); } /* Get the new lhs size in bytes. */ @@ -7523,11 +7535,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_expr_to_block (&fblock, tmp); /* Make sure that the scalarizer data pointer is updated. */ - if (lss->data.info.data - && TREE_CODE (lss->data.info.data) == VAR_DECL) + if (linfo->data + && TREE_CODE (linfo->data) == VAR_DECL) { tmp = gfc_conv_descriptor_data_get (desc); - gfc_add_modify (&fblock, lss->data.info.data, tmp); + gfc_add_modify (&fblock, linfo->data, tmp); } /* Add the exit label. */ @@ -7717,7 +7729,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) case AR_FULL: newss = gfc_get_array_ss (ss, expr, ar->as->rank, GFC_SS_SECTION); - newss->data.info.ref = ref; + newss->info->data.array.ref = ref; /* Make sure array is the same as array(:,:), this way we don't need to special case all the time. */ @@ -7735,7 +7747,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) case AR_SECTION: newss = gfc_get_array_ss (ss, expr, 0, GFC_SS_SECTION); - newss->data.info.ref = ref; + newss->info->data.array.ref = ref; /* We add SS chains for all the subscripts in the section. */ for (n = 0; n < ar->dimen; n++) @@ -7749,7 +7761,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) gcc_assert (ar->start[n]); indexss = gfc_get_scalar_ss (gfc_ss_terminator, ar->start[n]); indexss->loop_chain = gfc_ss_terminator; - newss->data.info.subscript[n] = indexss; + newss->info->data.array.subscript[n] = indexss; break; case DIMEN_RANGE: @@ -7765,7 +7777,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) indexss = gfc_get_array_ss (gfc_ss_terminator, ar->start[n], 1, GFC_SS_VECTOR); indexss->loop_chain = gfc_ss_terminator; - newss->data.info.subscript[n] = indexss; + newss->info->data.array.subscript[n] = indexss; newss->dim[newss->dimen] = n; newss->dimen++; break; @@ -7778,7 +7790,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) /* We should have at least one non-elemental dimension, unless we are creating a descriptor for a (scalar) coarray. */ gcc_assert (newss->dimen > 0 - || newss->data.info.ref->u.ar.as->corank > 0); + || newss->info->data.array.ref->u.ar.as->corank > 0); ss = newss; break; -- cgit v1.2.1 From 1b3fff24b46c1fbc5686b62512a1bc496524cf15 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:24:37 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field gfc_ss::useflags into gfc_ss_info. * trans-array.c (gfc_mark_ss_chain_used, gfc_trans_preloop_setup, gfc_trans_scalarizing_loops, gfc_trans_scalarized_boundary): Update reference chains. * trans-expr.c (gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_function): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180875 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 78e1443fecf..427bb7b53d1 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -463,7 +463,7 @@ void gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags) { for (; ss != gfc_ss_terminator; ss = ss->next) - ss->useflags = flags; + ss->info->useflags = flags; } static void gfc_free_ss (gfc_ss *); @@ -2906,7 +2906,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, { ss_info = ss->info; - if ((ss->useflags & flag) == 0) + if ((ss_info->useflags & flag) == 0) continue; ss_type = ss_info->type; @@ -3148,7 +3148,7 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body) /* Clear all the used flags. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) - ss->useflags = 0; + ss->info->useflags = 0; } @@ -3185,7 +3185,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) ss_info = ss->info; - if ((ss->useflags & 2) == 0) + if ((ss_info->useflags & 2) == 0) continue; ss_type = ss_info->type; -- cgit v1.2.1 From 77e80024c9a3ed5a229e1cb4a5afe6b639eebf47 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:29:25 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field gfc_ss::where into gfc_ss_info. * trans-array.c (gfc_add_loop_ss_code): Update reference chains. * trans-stmt.c (gfc_trans_where_assign, gfc_trans_where_3): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180877 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 427bb7b53d1..045c426cab1 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2203,7 +2203,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, scalarization loop, except for WHERE assignments. */ if (subscript) se.expr = convert(gfc_array_index_type, se.expr); - if (!ss->where) + if (!ss_info->where) se.expr = gfc_evaluate_now (se.expr, &loop->pre); gfc_add_block_to_block (&loop->pre, &se.post); } -- cgit v1.2.1 From 899cad3ef7f3eaa60ddcf9072d54c381a44812bb Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:40:55 +0000 Subject: * trans-array.c (set_loop_bounds): Separate the beginning of gfc_conv_loop_setup into a function of its own. (set_delta): Separate the end of gfc_conv_loop_setup into a function of its own. (gfc_conv_loop_setup): Call set_loop_bounds and set delta. (set_loop_bounds, set_delta, gfc_conv_loop_setup): Make loopspec a pointer to the specloop field from the loop struct. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180880 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 60 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 48 insertions(+), 12 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 045c426cab1..302f937989c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3919,25 +3919,25 @@ temporary: } -/* Initialize the scalarization loop. Creates the loop variables. Determines - the range of the loop variables. Creates a temporary if required. - Calculates how to transform from loop variables to array indices for each - expression. Also generates code for scalar expressions which have been - moved outside the loop. */ +/* Browse through each array's information from the scalarizer and set the loop + bounds according to the "best" one (per dimension), i.e. the one which + provides the most information (constant bounds, shape, etc). */ -void -gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) +static void +set_loop_bounds (gfc_loopinfo *loop) { int n, dim, spec_dim; gfc_array_info *info; gfc_array_info *specinfo; - gfc_ss *ss, *tmp_ss; + gfc_ss *ss; tree tmp; - gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; + gfc_ss **loopspec; bool dynamic[GFC_MAX_DIMENSIONS]; mpz_t *cshape; mpz_t i; + loopspec = loop->specloop; + mpz_init (i); for (n = 0; n < loop->dimen; n++) { @@ -4119,6 +4119,26 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop->from[n] = gfc_index_zero_node; } } + mpz_clear (i); +} + + +static void set_delta (gfc_loopinfo *loop); + + +/* Initialize the scalarization loop. Creates the loop variables. Determines + the range of the loop variables. Creates a temporary if required. + Also generates code for scalar expressions which have been + moved outside the loop. */ + +void +gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) +{ + gfc_ss *tmp_ss; + tree tmp; + int n; + + set_loop_bounds (loop); /* Add all the scalar code that can be taken out of the loops. This may include calculating the loop bounds, so do it before @@ -4153,15 +4173,31 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) } for (n = 0; n < loop->temp_dim; n++) - loopspec[loop->order[n]] = NULL; - - mpz_clear (i); + loop->specloop[loop->order[n]] = NULL; /* For array parameters we don't have loop variables, so don't calculate the translations. */ if (loop->array_parameter) return; + set_delta (loop); +} + + +/* Calculates how to transform from loop variables to array indices for each + array: once loop bounds are chosen, sets the difference (DELTA field) between + loop bounds and array reference bounds, for each array info. */ + +static void +set_delta (gfc_loopinfo *loop) +{ + gfc_ss *ss, **loopspec; + gfc_array_info *info; + tree tmp; + int n, dim; + + loopspec = loop->specloop; + /* Calculate the translation from loop variables to array indices. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { -- cgit v1.2.1 From 8a598e134238d6bd3420e50eb04355bdd139cbfa Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:42:58 +0000 Subject: * trans-array.c (gfc_conv_loop_setup, gfc_trans_create_temp_array): Move specloop arrays clearing from the former to the latter. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180881 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 302f937989c..545f2fb21a9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -902,6 +902,11 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, pre); loop->from[n] = gfc_index_zero_node; + /* We have just changed the loop bounds, we must clear the + corresponding specloop, so that delta calculation is not skipped + later in set_delta. */ + loop->specloop[n] = NULL; + /* We are constructing the temporary's descriptor based on the loop dimensions. As the dimensions may be accessed in arbitrary order (think of transpose) the size taken from the n'th loop may not map @@ -4136,7 +4141,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { gfc_ss *tmp_ss; tree tmp; - int n; set_loop_bounds (loop); @@ -4172,9 +4176,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) false, true, false, where); } - for (n = 0; n < loop->temp_dim; n++) - loop->specloop[loop->order[n]] = NULL; - /* For array parameters we don't have loop variables, so don't calculate the translations. */ if (loop->array_parameter) -- cgit v1.2.1 From 04d28f1f9e5a1d1f5b4e4a0b8e40f98b71528750 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:45:41 +0000 Subject: * trans-array.c (gfc_trans_create_temp_array): Move invariant condition out of the containing loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180882 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 57 +++++++++++++++++++++++++---------------------- 1 file changed, 30 insertions(+), 27 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 545f2fb21a9..663d12e6e69 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -961,12 +961,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, break; } - for (n = 0; n < loop->dimen; n++) + if (size == NULL_TREE) { - dim = ss->dim[n]; - - if (size == NULL_TREE) + for (n = 0; n < loop->dimen; n++) { + dim = ss->dim[n]; + /* For a callee allocated array express the loop bounds in terms of the descriptor fields. */ tmp = fold_build2_loc (input_location, @@ -974,39 +974,42 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]), gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim])); loop->to[n] = tmp; - continue; } - - /* Store the stride and bound components in the descriptor. */ - gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); + } + else + { + for (n = 0; n < loop->dimen; n++) + { + /* Store the stride and bound components in the descriptor. */ + gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); - gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n], - gfc_index_zero_node); + gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n], + gfc_index_zero_node); - gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], - to[n]); + gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]); - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - to[n], gfc_index_one_node); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + to[n], gfc_index_one_node); - /* Check whether the size for this dimension is negative. */ - cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp, - gfc_index_zero_node); - cond = gfc_evaluate_now (cond, pre); + /* Check whether the size for this dimension is negative. */ + cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + tmp, gfc_index_zero_node); + cond = gfc_evaluate_now (cond, pre); - if (n == 0) - or_expr = cond; - else - or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, or_expr, cond); + if (n == 0) + or_expr = cond; + else + or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR, + boolean_type_node, or_expr, cond); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, tmp); - size = gfc_evaluate_now (size, pre); + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, tmp); + size = gfc_evaluate_now (size, pre); + } } /* Get the size of the array. */ - if (size && !callee_alloc) { /* If or_expr is true, then the extent in at least one -- cgit v1.2.1 From 2092de0642f48458576e6f34c5f48f55a378c58f Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:50:06 +0000 Subject: * trans.h (struct gfc_ss_info): New field refcount. * trans-array.c (free_ss_info): Decrement refcount. Return early if still non-zero. (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss): Increment refcount. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180883 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 663d12e6e69..abb6db2a97f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -489,6 +489,11 @@ gfc_free_ss_chain (gfc_ss * ss) static void free_ss_info (gfc_ss_info *ss_info) { + ss_info->refcount--; + if (ss_info->refcount > 0) + return; + + gcc_assert (ss_info->refcount == 0); free (ss_info); } @@ -532,6 +537,7 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) int i; ss_info = gfc_get_ss_info (); + ss_info->refcount++; ss_info->type = type; ss_info->expr = expr; @@ -556,6 +562,7 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen) int i; ss_info = gfc_get_ss_info (); + ss_info->refcount++; ss_info->type = GFC_SS_TEMP; ss_info->string_length = string_length; ss_info->data.temp.type = type; @@ -580,6 +587,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) gfc_ss_info *ss_info; ss_info = gfc_get_ss_info (); + ss_info->refcount++; ss_info->type = GFC_SS_SCALAR; ss_info->expr = expr; -- cgit v1.2.1 From 5e3e355bb34e3261542c1198e46e835c4d91fb68 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:54:37 +0000 Subject: * trans.h (struct gfc_ss): New field loop. * trans-array.c (set_ss_loop): New function. (gfc_add_ss_to_loop): Call set_ss_loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180884 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index abb6db2a97f..e64767a2010 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -618,6 +618,27 @@ gfc_cleanup_loop (gfc_loopinfo * loop) } +static void +set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop) +{ + int n; + + for (; ss != gfc_ss_terminator; ss = ss->next) + { + ss->loop = loop; + + if (ss->info->type == GFC_SS_SCALAR + || ss->info->type == GFC_SS_REFERENCE + || ss->info->type == GFC_SS_TEMP) + continue; + + for (n = 0; n < GFC_MAX_DIMENSIONS; n++) + if (ss->info->data.array.subscript[n] != NULL) + set_ss_loop (ss->info->data.array.subscript[n], loop); + } +} + + /* Associate a SS chain with a loop. */ void @@ -628,6 +649,8 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) if (head == gfc_ss_terminator) return; + set_ss_loop (head, loop); + ss = head; for (; ss && ss != gfc_ss_terminator; ss = ss->next) { -- cgit v1.2.1 From 1c26be96ff66f2911fb4650c83deea91a9f54e33 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:56:12 +0000 Subject: * trans-array.c (gfc_set_vector_loop_bounds): Get loop from ss. Remove loop argument. (gfc_add_loop_ss_code): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180885 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e64767a2010..a305ac38cff 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2162,8 +2162,9 @@ finish: loop bounds. */ static void -set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) +set_vector_loop_bounds (gfc_ss * ss) { + gfc_loopinfo *loop; gfc_array_info *info; gfc_se se; tree tmp; @@ -2173,6 +2174,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) int dim; info = &ss->info->data.array; + loop = ss->loop; for (n = 0; n < loop->dimen; n++) { @@ -2271,7 +2273,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, if (info->subscript[n]) gfc_add_loop_ss_code (loop, info->subscript[n], true, where); - set_vector_loop_bounds (loop, ss); + set_vector_loop_bounds (ss); break; case GFC_SS_VECTOR: -- cgit v1.2.1 From b219b10831f574eb14f52b2285310481237bf65e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:59:29 +0000 Subject: * trans-array.c (gfc_trans_array_constructor, trans_array_constructor): Rename the former to the later. Get loop from ss. Remove loop argument. (gfc_add_loop_ss_code): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180886 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a305ac38cff..01a411a0508 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1981,7 +1981,7 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop) simplest method. */ static void -gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) +trans_array_constructor (gfc_ss * ss, locus * where) { gfc_constructor_base c; tree offset; @@ -1992,6 +1992,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; + gfc_loopinfo *loop; gfc_ss_info *ss_info; gfc_expr *expr; @@ -2000,6 +2001,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) old_first_len_val = first_len_val; old_typespec_chararray_ctor = typespec_chararray_ctor; + loop = ss->loop; ss_info = ss->info; expr = ss_info->expr; @@ -2314,7 +2316,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); } - gfc_trans_array_constructor (loop, ss, where); + trans_array_constructor (ss, where); break; case GFC_SS_TEMP: -- cgit v1.2.1 From b310f6ff18798f156ca4d5606237324f87467bed Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:02:03 +0000 Subject: * trans-array.c (gfc_trans_create_temp_array): New variable total_dim. Set total_dim to loop's rank. Replace usages of loop's rank. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180887 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 01a411a0508..b2388c12f24 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -907,6 +907,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tree cond; tree or_expr; int n, dim, tmp_dim; + int total_dim = 0; memset (from, 0, sizeof (from)); memset (to, 0, sizeof (to)); @@ -919,6 +920,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); + total_dim = loop->dimen; /* Set the lower bound to zero. */ for (n = 0; n < loop->dimen; n++) { @@ -956,7 +958,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* Initialize the descriptor. */ type = - gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1, + gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1, GFC_ARRAY_UNKNOWN, true); desc = gfc_create_var (type, "atmp"); GFC_DECL_PACKED_ARRAY (desc) = 1; @@ -985,8 +987,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* If there is at least one null loop->to[n], it is a callee allocated array. */ - for (n = 0; n < loop->dimen; n++) - if (loop->to[n] == NULL_TREE) + for (n = 0; n < total_dim; n++) + if (to[n] == NULL_TREE) { size = NULL_TREE; break; @@ -1009,7 +1011,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, } else { - for (n = 0; n < loop->dimen; n++) + for (n = 0; n < total_dim; n++) { /* Store the stride and bound components in the descriptor. */ gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); -- cgit v1.2.1 From fc09773a52dc0ffe8235e4d6608a1469eaa39158 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:06:22 +0000 Subject: * trans-array.h (gfc_trans_create_temp_array): Remove loop argument. * trans-array.c (gfc_trans_create_temp_array): Ditto. Get loop from ss. Update reference to loop. Remove loop argument. (gfc_trans_array_constructor, gfc_conv_loop_setup): Update calls to gfc_trans_create_temp_array. * trans-expr.c (gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. Set loop before calling gfc_trans_create_temp_array. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180888 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b2388c12f24..d386a228a0e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -888,15 +888,14 @@ get_array_ref_dim (gfc_ss *ss, int loop_dim) callee allocated array. PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for - gfc_trans_allocate_array_storage. - */ + gfc_trans_allocate_array_storage. */ tree -gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, - gfc_loopinfo * loop, gfc_ss * ss, +gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, tree eltype, tree initial, bool dynamic, bool dealloc, bool callee_alloc, locus * where) { + gfc_loopinfo *loop; gfc_array_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; @@ -915,11 +914,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, info = &ss->info->data.array; gcc_assert (ss->dimen > 0); - gcc_assert (loop->dimen == ss->dimen); + gcc_assert (ss->loop->dimen == ss->dimen); if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); + loop = ss->loop; total_dim = loop->dimen; /* Set the lower bound to zero. */ for (n = 0; n < loop->dimen; n++) @@ -1065,8 +1065,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, dynamic, dealloc); - if (ss->dimen > loop->temp_dim) - loop->temp_dim = ss->dimen; + if (ss->dimen > ss->loop->temp_dim) + ss->loop->temp_dim = ss->dimen; return size; } @@ -2113,8 +2113,8 @@ trans_array_constructor (gfc_ss * ss, locus * where) if (TREE_CODE (loop->to[0]) == VAR_DECL) dynamic = true; - gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss, - type, NULL_TREE, dynamic, true, false, where); + gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE, + dynamic, true, false, where); desc = ss_info->data.array.descriptor; offset = gfc_index_zero_node; @@ -4211,9 +4211,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (tmp_ss->dimen != 0); - gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, - tmp_ss, tmp, NULL_TREE, - false, true, false, where); + gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp, + NULL_TREE, false, true, false, where); } /* For array parameters we don't have loop variables, so don't calculate the -- cgit v1.2.1 From 7a516fb346b6fccae85af8e3068068bfead8e845 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:17:08 +0000 Subject: * trans.h (struct gfc_ss): New field parent. * trans-array.c (gfc_trans_scalarizing_loops): Skip clearing if a parent exists. * trans-expr.c (gfc_advance_se_ss_chain): Move to parent ss at the end of the chain. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180889 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d386a228a0e..abff8b5dc73 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3193,7 +3193,8 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body) /* Clear all the used flags. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) - ss->info->useflags = 0; + if (ss->parent == NULL) + ss->info->useflags = 0; } -- cgit v1.2.1 From 5bbc46bd13bb278329e01231711642416dc92c06 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:22:13 +0000 Subject: * trans-array.c (gfc_set_loop_bounds_from_array_spec): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180890 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 73 ++++++++++++++++++++++++++++------------------- 1 file changed, 43 insertions(+), 30 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index abff8b5dc73..83542f66811 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -688,41 +688,54 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, gfc_se * se, gfc_array_spec * as) { - int n, dim; + int n, dim, total_dim; gfc_se tmpse; + gfc_ss *ss; tree lower; tree upper; tree tmp; - if (as && as->type == AS_EXPLICIT) - for (n = 0; n < se->loop->dimen; n++) - { - dim = se->ss->dim[n]; - gcc_assert (dim < as->rank); - gcc_assert (se->loop->dimen == as->rank); - if (se->loop->to[n] == NULL_TREE) - { - /* Evaluate the lower bound. */ - gfc_init_se (&tmpse, NULL); - gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); - gfc_add_block_to_block (&se->pre, &tmpse.pre); - gfc_add_block_to_block (&se->post, &tmpse.post); - lower = fold_convert (gfc_array_index_type, tmpse.expr); - - /* ...and the upper bound. */ - gfc_init_se (&tmpse, NULL); - gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); - gfc_add_block_to_block (&se->pre, &tmpse.pre); - gfc_add_block_to_block (&se->post, &tmpse.post); - upper = fold_convert (gfc_array_index_type, tmpse.expr); - - /* Set the upper bound of the loop to UPPER - LOWER. */ - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, upper, lower); - tmp = gfc_evaluate_now (tmp, &se->pre); - se->loop->to[n] = tmp; - } - } + total_dim = 0; + + if (!as || as->type != AS_EXPLICIT) + return; + + for (ss = se->ss; ss; ss = ss->parent) + { + total_dim += ss->loop->dimen; + for (n = 0; n < ss->loop->dimen; n++) + { + /* The bound is known, nothing to do. */ + if (ss->loop->to[n] != NULL_TREE) + continue; + + dim = ss->dim[n]; + gcc_assert (dim < as->rank); + gcc_assert (ss->loop->dimen <= as->rank); + + /* Evaluate the lower bound. */ + gfc_init_se (&tmpse, NULL); + gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); + gfc_add_block_to_block (&se->pre, &tmpse.pre); + gfc_add_block_to_block (&se->post, &tmpse.post); + lower = fold_convert (gfc_array_index_type, tmpse.expr); + + /* ...and the upper bound. */ + gfc_init_se (&tmpse, NULL); + gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); + gfc_add_block_to_block (&se->pre, &tmpse.pre); + gfc_add_block_to_block (&se->post, &tmpse.post); + upper = fold_convert (gfc_array_index_type, tmpse.expr); + + /* Set the upper bound of the loop to UPPER - LOWER. */ + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, upper, lower); + tmp = gfc_evaluate_now (tmp, &se->pre); + ss->loop->to[n] = tmp; + } + } + + gcc_assert (total_dim == as->rank); } -- cgit v1.2.1 From a9a5a41415bca8c0bc6c6e13dd9f7f2279fb4edf Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:25:34 +0000 Subject: * trans-array.c (gfc_trans_array_constructor): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180891 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 83542f66811..463a0a2cf6f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1953,6 +1953,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) } } + /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough to use with trans_constant_array_constructor. Returns the @@ -2010,6 +2011,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_loopinfo *loop; gfc_ss_info *ss_info; gfc_expr *expr; + gfc_ss *s; /* Save the old values for nested checking. */ old_first_len = first_len; @@ -2078,16 +2080,20 @@ trans_array_constructor (gfc_ss * ss, locus * where) if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) { /* We have a multidimensional parameter. */ - int n; - for (n = 0; n < expr->rank; n++) - { - loop->from[n] = gfc_index_zero_node; - loop->to[n] = gfc_conv_mpz_to_tree (expr->shape [n], - gfc_index_integer_kind); - loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - loop->to[n], gfc_index_one_node); - } + for (s = ss; s; s = s->parent) + { + int n; + for (n = 0; n < s->loop->dimen; n++) + { + s->loop->from[n] = gfc_index_zero_node; + s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]], + gfc_index_integer_kind); + s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + s->loop->to[n], + gfc_index_one_node); + } + } } if (loop->to[0] == NULL_TREE) -- cgit v1.2.1 From 13d8bc14db87f1f59ee25ad7e39a40c464cb43df Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:28:25 +0000 Subject: * trans-array.c (set_vector_loop_bounds): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180892 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 463a0a2cf6f..25d9a37675c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2197,14 +2197,18 @@ set_vector_loop_bounds (gfc_ss * ss) int dim; info = &ss->info->data.array; - loop = ss->loop; - for (n = 0; n < loop->dimen; n++) + for (; ss; ss = ss->parent) { - dim = ss->dim[n]; - if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR - && loop->to[n] == NULL) + loop = ss->loop; + + for (n = 0; n < loop->dimen; n++) { + dim = ss->dim[n]; + if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR + || loop->to[n] != NULL) + continue; + /* Loop variable N indexes vector dimension DIM, and we don't yet know the upper bound of loop variable N. Set it to the difference between the vector's upper and lower bounds. */ -- cgit v1.2.1 From 7e7e695867898829e5026279ef986271a18a66c7 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:34:53 +0000 Subject: * trans-array.c (get_array_ref_dim, get_scalarizer_dim_for_array_dim): Rename the former to the latter and loop over the parents. (innermost_ss): New function. (get_array_ref_dim_for_loop_dim): New function. (gfc_trans_create_temp_array): Use get_scalarizer_dim_for_array_dim. (set_loop_bounds): Use get_array_dim_for_loop_dim). git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180894 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 62 ++++++++++++++++++++++++++++++++++++----------- 1 file changed, 48 insertions(+), 14 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 25d9a37675c..d918fa82009 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -868,28 +868,62 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, } -/* Get the array reference dimension corresponding to the given loop dimension. - It is different from the true array dimension given by the dim array in - the case of a partial array reference - It is different from the loop dimension in the case of a transposed array. - */ +/* Get the scalarizer array dimension corresponding to actual array dimension + given by ARRAY_DIM. + + For example, if SS represents the array ref a(1,:,:,1), it is a + bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1, + and 1 for ARRAY_DIM=2. + If SS represents transpose(a(:,1,1,:)), it is again a bidimensional + scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for + ARRAY_DIM=3. + If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer + array. If called on the inner ss, the result would be respectively 0,1,2 for + ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1 + for ARRAY_DIM=1,2. */ static int -get_array_ref_dim (gfc_ss *ss, int loop_dim) +get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim) { - int n, array_dim, array_ref_dim; + int array_ref_dim; + int n; array_ref_dim = 0; - array_dim = ss->dim[loop_dim]; - for (n = 0; n < ss->dimen; n++) - if (ss->dim[n] < array_dim) - array_ref_dim++; + for (; ss; ss = ss->parent) + for (n = 0; n < ss->dimen; n++) + if (ss->dim[n] < array_dim) + array_ref_dim++; return array_ref_dim; } +static gfc_ss * +innermost_ss (gfc_ss *ss) +{ + while (ss->nested_ss != NULL) + ss = ss->nested_ss; + + return ss; +} + + + +/* Get the array reference dimension corresponding to the given loop dimension. + It is different from the true array dimension given by the dim array in + the case of a partial array reference (i.e. a(:,:,1,:) for example) + It is different from the loop dimension in the case of a transposed array. + */ + +static int +get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim) +{ + return get_scalarizer_dim_for_array_dim (innermost_ss (ss), + ss->dim[loop_dim]); +} + + /* Generate code to create and initialize the descriptor for a temporary array. This is used for both temporaries needed by the scalarizer, and functions returning arrays. Adjusts the loop variables to be @@ -959,7 +993,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, to the n'th dimension of the array. We need to reconstruct loop infos in the right order before using it to set the descriptor bounds. */ - tmp_dim = get_array_ref_dim (ss, n); + tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim); from[tmp_dim] = loop->from[n]; to[tmp_dim] = loop->to[n]; @@ -1011,7 +1045,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, { for (n = 0; n < loop->dimen; n++) { - dim = ss->dim[n]; + dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]); /* For a callee allocated array express the loop bounds in terms of the descriptor fields. */ @@ -4126,7 +4160,7 @@ set_loop_bounds (gfc_loopinfo *loop) && INTEGER_CST_P (info->stride[dim])) { loop->from[n] = info->start[dim]; - mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]); + mpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]); mpz_sub_ui (i, i, 1); /* To = from + (size - 1) * stride. */ tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind); -- cgit v1.2.1 From 478de4e6ba8d020b3448153bdb91685a6a3d4d3b Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:37:24 +0000 Subject: * trans-array.c (gfc_trans_create_temp_array): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180895 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 71 ++++++++++++++++++++++++++--------------------- 1 file changed, 39 insertions(+), 32 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d918fa82009..1a86ae66c59 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -943,6 +943,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, bool dealloc, bool callee_alloc, locus * where) { gfc_loopinfo *loop; + gfc_ss *s; gfc_array_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; @@ -966,41 +967,45 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); - loop = ss->loop; - total_dim = loop->dimen; /* Set the lower bound to zero. */ - for (n = 0; n < loop->dimen; n++) + for (s = ss; s; s = s->parent) { - dim = ss->dim[n]; + loop = s->loop; + + total_dim += loop->dimen; + for (n = 0; n < loop->dimen; n++) + { + dim = s->dim[n]; - /* Callee allocated arrays may not have a known bound yet. */ - if (loop->to[n]) - loop->to[n] = gfc_evaluate_now ( + /* Callee allocated arrays may not have a known bound yet. */ + if (loop->to[n]) + loop->to[n] = gfc_evaluate_now ( fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n]), pre); - loop->from[n] = gfc_index_zero_node; - - /* We have just changed the loop bounds, we must clear the - corresponding specloop, so that delta calculation is not skipped - later in set_delta. */ - loop->specloop[n] = NULL; - - /* We are constructing the temporary's descriptor based on the loop - dimensions. As the dimensions may be accessed in arbitrary order - (think of transpose) the size taken from the n'th loop may not map - to the n'th dimension of the array. We need to reconstruct loop infos - in the right order before using it to set the descriptor - bounds. */ - tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim); - from[tmp_dim] = loop->from[n]; - to[tmp_dim] = loop->to[n]; - - info->delta[dim] = gfc_index_zero_node; - info->start[dim] = gfc_index_zero_node; - info->end[dim] = gfc_index_zero_node; - info->stride[dim] = gfc_index_one_node; + loop->from[n] = gfc_index_zero_node; + + /* We have just changed the loop bounds, we must clear the + corresponding specloop, so that delta calculation is not skipped + later in set_delta. */ + loop->specloop[n] = NULL; + + /* We are constructing the temporary's descriptor based on the loop + dimensions. As the dimensions may be accessed in arbitrary order + (think of transpose) the size taken from the n'th loop may not map + to the n'th dimension of the array. We need to reconstruct loop + infos in the right order before using it to set the descriptor + bounds. */ + tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim); + from[tmp_dim] = loop->from[n]; + to[tmp_dim] = loop->to[n]; + + info->delta[dim] = gfc_index_zero_node; + info->start[dim] = gfc_index_zero_node; + info->end[dim] = gfc_index_zero_node; + info->stride[dim] = gfc_index_one_node; + } } /* Initialize the descriptor. */ @@ -1042,8 +1047,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, } if (size == NULL_TREE) - { - for (n = 0; n < loop->dimen; n++) + for (s = ss; s; s = s->parent) + for (n = 0; n < s->loop->dimen; n++) { dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]); @@ -1053,9 +1058,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, MINUS_EXPR, gfc_array_index_type, gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]), gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim])); - loop->to[n] = tmp; + s->loop->to[n] = tmp; } - } else { for (n = 0; n < total_dim; n++) @@ -1112,6 +1116,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, dynamic, dealloc); + while (ss->parent) + ss = ss->parent; + if (ss->dimen > ss->loop->temp_dim) ss->loop->temp_dim = ss->dimen; -- cgit v1.2.1 From e390313110b6f6d77d0adc77e82b830bc8b15d39 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:39:11 +0000 Subject: * trans.h (struct gfc_loopinfo): New fields nested and next. * trans-array.c (gfc_add_ss_to_loop): Update list of nested list if ss has non-null nested_ss field. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180897 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 1a86ae66c59..0c1dc895d0d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -645,6 +645,7 @@ void gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) { gfc_ss *ss; + gfc_loopinfo *nested_loop; if (head == gfc_ss_terminator) return; @@ -654,6 +655,21 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) ss = head; for (; ss && ss != gfc_ss_terminator; ss = ss->next) { + if (ss->nested_ss) + { + nested_loop = ss->nested_ss->loop; + + /* More than one ss can belong to the same loop. Hence, we add the + loop to the chain only if it is different from the previously + added one, to avoid duplicate nested loops. */ + if (nested_loop != loop->nested) + { + gcc_assert (nested_loop->next == NULL); + nested_loop->next = loop->nested; + loop->nested = nested_loop; + } + } + if (ss->next == gfc_ss_terminator) ss->loop_chain = loop->ss; else -- cgit v1.2.1 From dded49d253260180d3a2253d75f152100a2db695 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:41:28 +0000 Subject: * trans-array.c (gfc_add_loop_ss_code): Skip non-nestedmost ss. Call recursively gfc_add_loop_ss_code for all the nested loops. (gfc_conv_ss_startstride): Only get the descriptor for the outermost ss. Call recursively gfc_conv_ss_startstride for all the nested loops. (set_loop_bounds): Call recursively for all the nested loops. (set_delta): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180898 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 33 ++++++++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0c1dc895d0d..27356a1a1d3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2295,10 +2295,12 @@ static void gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, locus * where) { + gfc_loopinfo *nested_loop; gfc_se se; gfc_ss_info *ss_info; gfc_array_info *info; gfc_expr *expr; + bool skip_nested = false; int n; /* TODO: This can generate bad code if there are ordering dependencies, @@ -2309,6 +2311,10 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gcc_assert (ss); + /* Cross loop arrays are handled from within the most nested loop. */ + if (ss->nested_ss != NULL) + continue; + ss_info = ss->info; expr = ss_info->expr; info = &ss_info->data.array; @@ -2355,7 +2361,12 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) if (info->subscript[n]) - gfc_add_loop_ss_code (loop, info->subscript[n], true, where); + { + gfc_add_loop_ss_code (loop, info->subscript[n], true, where); + /* The recursive call will have taken care of the nested loops. + No need to do it twice. */ + skip_nested = true; + } set_vector_loop_bounds (ss); break; @@ -2410,6 +2421,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gcc_unreachable (); } } + + if (!skip_nested) + for (nested_loop = loop->nested; nested_loop; + nested_loop = nested_loop->next) + gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where); } @@ -3495,8 +3511,10 @@ done: switch (ss_info->type) { case GFC_SS_SECTION: - /* Get the descriptor for the array. */ - gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter); + /* Get the descriptor for the array. If it is a cross loops array, + we got the descriptor already in the outermost loop. */ + if (ss->parent == NULL) + gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter); for (n = 0; n < ss->dimen; n++) gfc_conv_section_startstride (loop, ss, ss->dim[n]); @@ -3785,6 +3803,9 @@ done: tmp = gfc_finish_block (&block); gfc_add_expr_to_block (&loop->pre, tmp); } + + for (loop = loop->nested; loop; loop = loop->next) + gfc_conv_ss_startstride (loop); } /* Return true if both symbols could refer to the same data object. Does @@ -4246,6 +4267,9 @@ set_loop_bounds (gfc_loopinfo *loop) } } mpz_clear (i); + + for (loop = loop->nested; loop; loop = loop->next) + set_loop_bounds (loop); } @@ -4356,6 +4380,9 @@ set_delta (gfc_loopinfo *loop) } } } + + for (loop = loop->nested; loop; loop = loop->next) + set_delta (loop); } -- cgit v1.2.1 From 9de941c0b8cd7c36f63ecd6681b89f2a962055b0 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:45:19 +0000 Subject: * trans.h (struct gfc_loopinfo): New field parent. * trans-array.c (gfc_cleanup_loop): Free nested loops. (gfc_add_ss_to_loop): Set nested_loop's parent loop. (gfc_trans_array_constructor): Update assertion. (gfc_conv_loop_setup): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180899 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 27356a1a1d3..5659b70846e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -604,6 +604,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) void gfc_cleanup_loop (gfc_loopinfo * loop) { + gfc_loopinfo *loop_next, **ploop; gfc_ss *ss; gfc_ss *next; @@ -615,6 +616,23 @@ gfc_cleanup_loop (gfc_loopinfo * loop) gfc_free_ss (ss); ss = next; } + + /* Remove reference to self in the parent loop. */ + if (loop->parent) + for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next) + if (*ploop == loop) + { + *ploop = loop->next; + break; + } + + /* Free non-freed nested loops. */ + for (loop = loop->nested; loop; loop = loop_next) + { + loop_next = loop->next; + gfc_cleanup_loop (loop); + free (loop); + } } @@ -664,10 +682,15 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) added one, to avoid duplicate nested loops. */ if (nested_loop != loop->nested) { + gcc_assert (nested_loop->parent == NULL); + nested_loop->parent = loop; + gcc_assert (nested_loop->next == NULL); nested_loop->next = loop->nested; loop->nested = nested_loop; } + else + gcc_assert (nested_loop->parent == loop); } if (ss->next == gfc_ss_terminator) @@ -2158,6 +2181,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) mpz_t size; /* We should have a 1-dimensional, zero-based loop. */ + gcc_assert (loop->parent == NULL && loop->nested == NULL); gcc_assert (loop->dimen == 1); gcc_assert (integer_zerop (loop->from[0])); @@ -4302,6 +4326,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp_ss_info = tmp_ss->info; gcc_assert (tmp_ss_info->type == GFC_SS_TEMP); + gcc_assert (loop->parent == NULL); /* Make absolutely sure that this is a complete type. */ if (tmp_ss_info->string_length) -- cgit v1.2.1 From 705974ff25145107542123005f7c2947ad25f11e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:48:29 +0000 Subject: * trans-array.c (get_rank, get_loop_upper_bound_for_array): New functions. (gfc_trans_array_constructor): Handle multiple loops. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180900 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 47 ++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 40 insertions(+), 7 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5659b70846e..083ce5c77ee 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2034,6 +2034,19 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) } +static int +get_rank (gfc_loopinfo *loop) +{ + int rank; + + rank = 0; + for (; loop; loop = loop->parent) + rank += loop->dimen; + + return rank; +} + + /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough to use with trans_constant_array_constructor. Returns the @@ -2072,6 +2085,23 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop) } +static tree * +get_loop_upper_bound_for_array (gfc_ss *array, int array_dim) +{ + gfc_ss *ss; + int n; + + gcc_assert (array->nested_ss == NULL); + + for (ss = array; ss; ss = ss->parent) + for (n = 0; n < ss->loop->dimen; n++) + if (array_dim == get_array_ref_dim_for_loop_dim (ss, n)) + return &(ss->loop->to[n]); + + gcc_unreachable (); +} + + /* Array constructors are handled by constructing a temporary, then using that within the scalarization loop. This is not optimal, but seems by far the simplest method. */ @@ -2085,6 +2115,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) tree desc; tree type; tree tmp; + tree *loop_ubound0; bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; @@ -2114,7 +2145,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) first_len = true; } - gcc_assert (ss->dimen == loop->dimen); + gcc_assert (ss->dimen == ss->loop->dimen); c = expr->value.constructor; if (expr->ts.type == BT_CHARACTER) @@ -2157,7 +2188,9 @@ trans_array_constructor (gfc_ss * ss, locus * where) /* See if the constructor determines the loop bounds. */ dynamic = false; - if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) + loop_ubound0 = get_loop_upper_bound_for_array (ss, 0); + + if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE) { /* We have a multidimensional parameter. */ for (s = ss; s; s = s->parent) @@ -2176,7 +2209,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) } } - if (loop->to[0] == NULL_TREE) + if (*loop_ubound0 == NULL_TREE) { mpz_t size; @@ -2210,7 +2243,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) } } - if (TREE_CODE (loop->to[0]) == VAR_DECL) + if (TREE_CODE (*loop_ubound0) == VAR_DECL) dynamic = true; gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE, @@ -2233,10 +2266,10 @@ trans_array_constructor (gfc_ss * ss, locus * where) offsetvar, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, &loop->pre); gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); - if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL) - gfc_add_modify (&loop->pre, loop->to[0], tmp); + if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL) + gfc_add_modify (&loop->pre, *loop_ubound0, tmp); else - loop->to[0] = tmp; + *loop_ubound0 = tmp; } if (TREE_USED (offsetvar)) -- cgit v1.2.1 From 2a0320a7dedb6f5c9b47813321836d826aec60f5 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:51:04 +0000 Subject: * trans-array.c (constant_array_constructor_loop_size): Handle multiple loops. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180901 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 083ce5c77ee..299bd807564 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2053,32 +2053,38 @@ get_rank (gfc_loopinfo *loop) iteration count of the loop if suitable, and NULL_TREE otherwise. */ static tree -constant_array_constructor_loop_size (gfc_loopinfo * loop) +constant_array_constructor_loop_size (gfc_loopinfo * l) { + gfc_loopinfo *loop; tree size = gfc_index_one_node; tree tmp; - int i; + int i, total_dim; + + total_dim = get_rank (l); - for (i = 0; i < loop->dimen; i++) + for (loop = l; loop; loop = loop->parent) { - /* If the bounds aren't constant, return NULL_TREE. */ - if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i])) - return NULL_TREE; - if (!integer_zerop (loop->from[i])) + for (i = 0; i < loop->dimen; i++) { - /* Only allow nonzero "from" in one-dimensional arrays. */ - if (loop->dimen != 1) + /* If the bounds aren't constant, return NULL_TREE. */ + if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i])) return NULL_TREE; - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - loop->to[i], loop->from[i]); + if (!integer_zerop (loop->from[i])) + { + /* Only allow nonzero "from" in one-dimensional arrays. */ + if (total_dim != 1) + return NULL_TREE; + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + loop->to[i], loop->from[i]); + } + else + tmp = loop->to[i]; + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tmp, gfc_index_one_node); + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, tmp); } - else - tmp = loop->to[i]; - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - tmp, gfc_index_one_node); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, tmp); } return size; -- cgit v1.2.1 From 7e10f24355cf3115066a3825f8ca44ebc271bdbe Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:53:42 +0000 Subject: * trans-array.c (outermost_loop): New function. (gfc_trans_array_constructor, gfc_set_vector_loop_bounds, gfc_add_loop_ss_code): Put generated code out of the outermost loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180902 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 66 +++++++++++++++++++++++++++++------------------ 1 file changed, 41 insertions(+), 25 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 299bd807564..0f3d1718521 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2108,6 +2108,16 @@ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim) } +static gfc_loopinfo * +outermost_loop (gfc_loopinfo * loop) +{ + while (loop->parent != NULL) + loop = loop->parent; + + return loop; +} + + /* Array constructors are handled by constructing a temporary, then using that within the scalarization loop. This is not optimal, but seems by far the simplest method. */ @@ -2125,7 +2135,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; - gfc_loopinfo *loop; + gfc_loopinfo *loop, *outer_loop; gfc_ss_info *ss_info; gfc_expr *expr; gfc_ss *s; @@ -2136,6 +2146,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) old_typespec_chararray_ctor = typespec_chararray_ctor; loop = ss->loop; + outer_loop = outermost_loop (loop); ss_info = ss->info; expr = ss_info->expr; @@ -2171,11 +2182,11 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_charlen_type_node); ss_info->string_length = length_se.expr; - gfc_add_block_to_block (&loop->pre, &length_se.pre); - gfc_add_block_to_block (&loop->post, &length_se.post); + gfc_add_block_to_block (&outer_loop->pre, &length_se.pre); + gfc_add_block_to_block (&outer_loop->post, &length_se.post); } else - const_string = get_array_ctor_strlen (&loop->pre, c, + const_string = get_array_ctor_strlen (&outer_loop->pre, c, &ss_info->string_length); /* Complex character array constructors should have been taken care of @@ -2252,15 +2263,15 @@ trans_array_constructor (gfc_ss * ss, locus * where) if (TREE_CODE (*loop_ubound0) == VAR_DECL) dynamic = true; - gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE, - dynamic, true, false, where); + gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type, + NULL_TREE, dynamic, true, false, where); desc = ss_info->data.array.descriptor; offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); TREE_NO_WARNING (offsetvar) = 1; TREE_USED (offsetvar) = 0; - gfc_trans_array_constructor_value (&loop->pre, type, desc, c, + gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c, &offset, &offsetvar, dynamic); /* If the array grows dynamically, the upper bound of the loop variable @@ -2270,10 +2281,10 @@ trans_array_constructor (gfc_ss * ss, locus * where) tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, offsetvar, gfc_index_one_node); - tmp = gfc_evaluate_now (tmp, &loop->pre); + tmp = gfc_evaluate_now (tmp, &outer_loop->pre); gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL) - gfc_add_modify (&loop->pre, *loop_ubound0, tmp); + gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp); else *loop_ubound0 = tmp; } @@ -2307,7 +2318,7 @@ finish: static void set_vector_loop_bounds (gfc_ss * ss) { - gfc_loopinfo *loop; + gfc_loopinfo *loop, *outer_loop; gfc_array_info *info; gfc_se se; tree tmp; @@ -2316,6 +2327,8 @@ set_vector_loop_bounds (gfc_ss * ss) int n; int dim; + outer_loop = outermost_loop (ss->loop); + info = &ss->info->data.array; for (; ss; ss = ss->parent) @@ -2343,7 +2356,7 @@ set_vector_loop_bounds (gfc_ss * ss) gfc_array_index_type, gfc_conv_descriptor_ubound_get (desc, zero), gfc_conv_descriptor_lbound_get (desc, zero)); - tmp = gfc_evaluate_now (tmp, &loop->pre); + tmp = gfc_evaluate_now (tmp, &outer_loop->pre); loop->to[n] = tmp; } } @@ -2358,7 +2371,7 @@ static void gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, locus * where) { - gfc_loopinfo *nested_loop; + gfc_loopinfo *nested_loop, *outer_loop; gfc_se se; gfc_ss_info *ss_info; gfc_array_info *info; @@ -2366,6 +2379,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, bool skip_nested = false; int n; + outer_loop = outermost_loop (loop); + /* TODO: This can generate bad code if there are ordering dependencies, e.g., a callee allocated function and an unknown size constructor. */ gcc_assert (ss != NULL); @@ -2389,7 +2404,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, dimension indices, but not array section bounds. */ gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); - gfc_add_block_to_block (&loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); if (expr->ts.type != BT_CHARACTER) { @@ -2398,11 +2413,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, if (subscript) se.expr = convert(gfc_array_index_type, se.expr); if (!ss_info->where) - se.expr = gfc_evaluate_now (se.expr, &loop->pre); - gfc_add_block_to_block (&loop->pre, &se.post); + se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre); + gfc_add_block_to_block (&outer_loop->pre, &se.post); } else - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->post, &se.post); ss_info->data.scalar.value = se.expr; ss_info->string_length = se.string_length; @@ -2413,10 +2428,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, now. */ gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); - ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre); + ss_info->data.scalar.value = gfc_evaluate_now (se.expr, + &outer_loop->pre); ss_info->string_length = se.string_length; break; @@ -2438,8 +2454,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, /* Get the vector's descriptor and store it in SS. */ gfc_init_se (&se, NULL); gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr)); - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); info->descriptor = se.expr; break; @@ -2454,8 +2470,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, se.loop = loop; se.ss = ss; gfc_conv_expr (&se, expr); - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); ss_info->string_length = se.string_length; break; @@ -2469,8 +2485,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_conv_expr_type (&se, expr->ts.u.cl->length, gfc_charlen_type_node); ss_info->string_length = se.expr; - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); } trans_array_constructor (ss, where); break; -- cgit v1.2.1 From 5e8f57eb418d5e7f43d7dfc23a0edfeb461fdf93 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:56:20 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): New pointers to outer dimension's ss and loop. Use them. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180903 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0f3d1718521..3c0c1103807 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3116,7 +3116,8 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, gfc_ss_info *ss_info; gfc_array_info *info; gfc_ss_type ss_type; - gfc_ss *ss; + gfc_ss *ss, *pss; + gfc_loopinfo *ploop; gfc_array_ref *ar; int i; @@ -3146,18 +3147,37 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, else ar = NULL; + if (dim == loop->dimen - 1 && loop->parent != NULL) + { + /* If we are in the outermost dimension of this loop, the previous + dimension shall be in the parent loop. */ + gcc_assert (ss->parent != NULL); + + pss = ss->parent; + ploop = loop->parent; + + /* ss and ss->parent are about the same array. */ + gcc_assert (ss_info == pss->info); + } + else + { + ploop = loop; + pss = ss; + } + if (dim == loop->dimen - 1) i = 0; else i = dim + 1; /* For the time being, there is no loop reordering. */ - gcc_assert (i == loop->order[i]); - i = loop->order[i]; + gcc_assert (i == ploop->order[i]); + i = ploop->order[i]; - if (dim == loop->dimen - 1) + if (dim == loop->dimen - 1 && loop->parent == NULL) { - stride = gfc_conv_array_stride (info->descriptor, ss->dim[i]); + stride = gfc_conv_array_stride (info->descriptor, + innermost_ss (ss)->dim[i]); /* Calculate the stride of the innermost loop. Hopefully this will allow the backend optimizers to do their stuff more effectively. @@ -3180,10 +3200,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, } else /* Add the offset for the previous loop dimension. */ - add_array_offset (pblock, loop, ss, ar, ss->dim[i], i); + add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i); /* Remember this offset for the second loop. */ - if (dim == loop->temp_dim - 1) + if (dim == loop->temp_dim - 1 && loop->parent == NULL) info->saved_offset = info->offset; } } -- cgit v1.2.1 From 6e7db166fd97d22395e0022879d43c19234697a1 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:00:23 +0000 Subject: * trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes. * trans-array.c (gfc_free_ss): Remove forward declaration. Make non-static. (set_delta, gfc_set_delta): Remove forward declaration. Make non-static and rename the former to the later. Update uses. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180905 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3c0c1103807..acd9aec18fe 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -466,8 +466,6 @@ gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags) ss->info->useflags = flags; } -static void gfc_free_ss (gfc_ss *); - /* Free a gfc_ss chain. */ @@ -500,7 +498,7 @@ free_ss_info (gfc_ss_info *ss_info) /* Free a SS. */ -static void +void gfc_free_ss (gfc_ss * ss) { gfc_ss_info *ss_info; @@ -1027,7 +1025,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, /* We have just changed the loop bounds, we must clear the corresponding specloop, so that delta calculation is not skipped - later in set_delta. */ + later in gfc_set_delta. */ loop->specloop[n] = NULL; /* We are constructing the temporary's descriptor based on the loop @@ -4372,9 +4370,6 @@ set_loop_bounds (gfc_loopinfo *loop) } -static void set_delta (gfc_loopinfo *loop); - - /* Initialize the scalarization loop. Creates the loop variables. Determines the range of the loop variables. Creates a temporary if required. Also generates code for scalar expressions which have been @@ -4422,10 +4417,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* For array parameters we don't have loop variables, so don't calculate the translations. */ - if (loop->array_parameter) - return; - - set_delta (loop); + if (!loop->array_parameter) + gfc_set_delta (loop); } @@ -4433,8 +4426,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) array: once loop bounds are chosen, sets the difference (DELTA field) between loop bounds and array reference bounds, for each array info. */ -static void -set_delta (gfc_loopinfo *loop) +void +gfc_set_delta (gfc_loopinfo *loop) { gfc_ss *ss, **loopspec; gfc_array_info *info; @@ -4482,7 +4475,7 @@ set_delta (gfc_loopinfo *loop) } for (loop = loop->nested; loop; loop = loop->next) - set_delta (loop); + gfc_set_delta (loop); } -- cgit v1.2.1 From 88df5e2fe380ded681c7058f6b1ab1db7ceb10a6 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:31:19 +0000 Subject: PR fortran/43829 * trans-array.c (gfc_conv_expr_descriptor): Accept the inline intrinsic case in the assertion. * trans-intrinsic (enter_nested_loop): New function. (gfc_conv_intrinsic_arith): Support non-scalar cases. (nest_loop_dimension, walk_inline_intrinsic_arith): New functions. (walk_inline_intrinsic_function): Handle sum and product. (gfc_inline_intrinsic_function_p): Ditto. * trans.h (gfc_get_loopinfo): New macro. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180920 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/trans-array.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index acd9aec18fe..262743d0d37 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6187,7 +6187,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gcc_assert ((expr->value.function.esym != NULL && expr->value.function.esym->attr.elemental) || (expr->value.function.isym != NULL - && expr->value.function.isym->elemental)); + && expr->value.function.isym->elemental) + || gfc_inline_intrinsic_function_p (expr)); else gcc_assert (ss_type == GFC_SS_INTRINSIC); -- cgit v1.2.1