From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 23309 invoked by alias); 27 Oct 2011 23:32:01 -0000 Received: (qmail 20019 invoked by uid 22791); 27 Oct 2011 23:31:09 -0000 X-SWARE-Spam-Status: No, hits=1.3 required=5.0 tests=AWL,BAYES_00,KAM_STOCKTIP,RP_MATCHES_RCVD,TW_TM,TW_XS X-Spam-Check-By: sourceware.org Received: from smtp25.services.sfr.fr (HELO smtp25.services.sfr.fr) (93.17.128.120) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 27 Oct 2011 23:30:37 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2512.sfr.fr (SMTP Server) with ESMTP id AE51D7000040; Fri, 28 Oct 2011 01:30:34 +0200 (CEST) Received: from gimli.local (145.15.72.86.rev.sfr.net [86.72.15.145]) by msfrf2512.sfr.fr (SMTP Server) with ESMTP id CB4377000089; Fri, 28 Oct 2011 01:30:31 +0200 (CEST) X-SFR-UUID: 20111027233031832.CB4377000089@msfrf2512.sfr.fr Content-Type: multipart/mixed; boundary="===============2275985892752799265==" MIME-Version: 1.0 From: Mikael Morin To: gfortran , GCC patches Message-ID: <20111027233031.18581.58613@gimli.local> In-Reply-To: <20111027232818.18581.901@gimli.local> References: <20111027232818.18581.901@gimli.local> Subject: [Patch, fortran] [20..30/66] inline sum and product: Update core structs. Date: Thu, 27 Oct 2011 23:32:00 -0000 X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2011-10/txt/msg02537.txt.bz2 --===============2275985892752799265== Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-length: 5289 These patches introduce the new scalarizer structures. As explained earlier, the dim and dimen field are now part of the main gfc_ss structure. All the common fields (type, expr, shape, string length, union data and all its content) are moved to a new external structure gfc_ss_info to which a pointer is kept in the main gfc_ss structure. The former gfc_ss_info is renamed to gfc_array_info as it is only used for non-scalar case. The shape field is moved to gfc_array_info as it is not used in non-array cases. This is explained in the schema below (though I'm not sure it makes it more understandable). struct gfc_ss struct gfc_ss { { ---- new -------> struct gfc_ss_info * { ---- new ---------> int refcount; gfc_ss_type type; -------------+ +-> gfc_ss_type type; gfc_expr *expr; -------------+-- moved ----+-> gfc_expr *expr; mpz_t *shape; ----- moved ----|------+ | tree string_length; -------------+ | +-> tree string_length; union ----------------------+ | +-> union { | { struct | struct { | { tree expr; ------------ renamed --------------> tree value; } | } scalar; | scalar; | struct | struct { | { int dimen; ---------+ | int dimen; tree type; | | tree type; } | | } temp; |- merged --+ | temp; | | | struct gfc_ss_info --|- renamed -|---|----------> struct gfc_array_info { | | | { | | +-----------> mpz_t *shape; int dimen; ---------+ | gfc_ref *ref; | gfc_ref *ref; tree descriptor; + moved + tree descriptor; tree data; | | tree data; tree offset; | | tree offset; tree saved_offset; | | tree saved_offset; tree stride0; | | tree stride0; gfc_ss *subscript[]; | | gfc_ss *subscript[]; | | tree start[]; | | tree start[]; tree end[]; | | tree end[]; tree stride[]; | | tree stride[]; tree delta[]; | | tree delta[]; | | int dim[]; --------------------+ | } info; ---------- renamed ---|------> } array; } | } data; | data; | +-----------------|----> unsigned useflags:2; +-----------------|----> unsigned where:1; | | } moved | | +--> int dimen; | +--> int dim[]; | gfc_ss *loop_chain; | gfc_ss *loop_chain; gfc_ss *next; | gfc_ss *next; | unsigned useflags:2; ----+ unsigned where:1; ----+ unsigned is_alloc_lhs:1; unsigned is_alloc_lhs:1; } } gfc_ss; gfc_ss; The follow-up messages are the step-by-step patches to change the structures by moving fields one by one. This is for those prefering more straightforward patches (like me). For the masoch^W^W those who prefer one single patch the combined patch is attached to this mail. Patch 20: Rename gfc_ss_info to gfc_array_info. Patch 21: Move {dim,dimen} from gfc_array_info to gfc_ss. Patch 22: Move shape from gfc_ss to gfc_array_info. Patch 23: Move type from gfc_ss to a new gfc_ss_info. Patch 24: Move expr from gfc_ss to gfc_ss_info. Patch 25: Move string_length from gfc_ss to gfc_ss_info. Patch 26: Move scalar struct from gfc_ss to gfc_ss_info. Patch 27: Move temp struct from gfc_ss to gfc_ss_info. Patch 28: Move info struct from gfc_ss to gfc_ss_info. Patch 29: Move useflags from gfc_ss to gfc_ss_info. Patch 30: Move where from gfc_ss to gfc_ss_info. --===============2275985892752799265== Content-Type: text/x-diff; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="pr43829-20..30.diff" Content-length: 80302 diff --git a/trans-array.c b/trans-array.c index dc4dccd..045c426 100644 --- a/trans-array.c +++ b/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 *); @@ -486,20 +486,30 @@ 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->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_info->data.array.subscript[ss->dim[n]]) + gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]); } break; @@ -507,6 +517,7 @@ gfc_free_ss (gfc_ss * ss) break; } + free_ss_info (ss_info); free (ss); } @@ -517,17 +528,19 @@ 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_ss_info *ss_info; int i; + 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->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 +552,20 @@ 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_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->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; } @@ -557,11 +577,15 @@ 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_info->expr = expr; ss = gfc_get_ss (); + ss->info = ss_info; ss->next = next; - ss->type = GFC_SS_SCALAR; - ss->expr = expr; return ss; } @@ -642,7 +666,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) @@ -685,7 +709,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,15 +834,12 @@ static int 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]; + 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; @@ -845,7 +866,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; @@ -859,10 +880,10 @@ 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 (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 +891,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 +920,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 +958,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 +1024,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; } @@ -1857,19 +1878,19 @@ 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; - tmp = gfc_build_constant_array_constructor (ss->expr, 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); 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; @@ -1932,75 +1953,80 @@ 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. */ old_first_len = first_len; old_first_len_val = first_len_val; old_typespec_chararray_ctor = typespec_chararray_ctor; + 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. */ - 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; } - 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) + 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; + 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); - ss->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 (ss->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); } 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, @@ -2047,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; @@ -2099,7 +2125,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; @@ -2107,11 +2133,11 @@ 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++) { - dim = info->dim[n]; + dim = ss->dim[n]; if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR && loop->to[n] == NULL) { @@ -2120,10 +2146,10 @@ 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; + 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, @@ -2145,6 +2171,9 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, locus * where) { gfc_se se; + gfc_ss_info *ss_info; + gfc_array_info *info; + gfc_expr *expr; int n; /* TODO: This can generate bad code if there are ordering dependencies, @@ -2155,50 +2184,53 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gcc_assert (ss); - switch (ss->type) + ss_info = ss->info; + expr = ss_info->expr; + info = &ss_info->data.array; + + 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. */ 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); } else gfc_add_block_to_block (&loop->post, &se.post); - ss->data.scalar.expr = se.expr; - ss->string_length = se.string_length; + ss_info->data.scalar.value = se.expr; + ss_info->string_length = se.string_length; break; case GFC_SS_REFERENCE: /* 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); - ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre); - ss->string_length = se.string_length; + ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre); + ss_info->string_length = se.string_length; break; 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; @@ -2206,10 +2238,10 @@ 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; + info->descriptor = se.expr; break; case GFC_SS_INTRINSIC: @@ -2222,22 +2254,22 @@ 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; + ss_info->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_info->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; + ss_info->string_length = se.expr; gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); } @@ -2263,16 +2295,21 @@ static void 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->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; + info->descriptor = se.expr; + ss_info->string_length = se.string_length; if (base) { @@ -2286,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; } } @@ -2447,12 +2484,12 @@ 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); /* 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) @@ -2516,12 +2553,12 @@ 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; - info = &ss->data.info; + info = &ss->info->data.array; /* Get the index into the array for this dimension. */ if (ar) @@ -2535,9 +2572,9 @@ 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; + 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 @@ -2547,8 +2584,8 @@ 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); - desc = info->subscript[dim]->data.info.descriptor; + && info->subscript[dim]->info->type == GFC_SS_VECTOR); + desc = info->subscript[dim]->info->data.array.descriptor; /* Get a zero-based index into the vector. */ index = fold_build2_loc (input_location, MINUS_EXPR, @@ -2602,11 +2639,11 @@ 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 - && se->ss->expr - && se->ss->expr->symtree - && se->ss->expr->symtree->n.sym->result - && se->ss->expr->symtree->n.sym->result->attr.pointer) + if (se->ss && se->ss->info->type == GFC_SS_FUNCTION + && 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]); @@ -2629,31 +2666,33 @@ 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; + gfc_ss *ss; + gfc_expr *expr; int n; - info = &se->ss->data.info; + ss = se->ss; + expr = ss->info->expr; + info = &ss->info->data.array; 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)) 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); } @@ -2663,7 +2702,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); } @@ -2827,10 +2866,10 @@ 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; + info = &ss->info->data.array; gfc_init_se (&se, NULL); se.loop = loop; @@ -2854,7 +2893,9 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, stmtblock_t * pblock) { tree stride; - gfc_ss_info *info; + gfc_ss_info *ss_info; + gfc_array_info *info; + gfc_ss_type ss_type; gfc_ss *ss; gfc_array_ref *ar; int i; @@ -2863,18 +2904,22 @@ 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) { - if ((ss->useflags & flag) == 0) + ss_info = ss->info; + + if ((ss_info->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; + info = &ss_info->data.array; - 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 +2937,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 +2960,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) @@ -3103,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; } @@ -3135,15 +3180,22 @@ 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) { - if ((ss->useflags & 2) == 0) + gfc_ss_type ss_type; + gfc_ss_info *ss_info; + + ss_info = ss->info; + + if ((ss_info->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; + ss_info->data.array.offset = ss_info->data.array.saved_offset; } /* Restart all the inner loops we just finished. */ @@ -3205,12 +3257,12 @@ 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); + 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) @@ -3265,25 +3317,25 @@ 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: 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!. */ 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: 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: @@ -3303,21 +3355,29 @@ 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_ss_info *ss_info; + gfc_array_info *info; + gfc_expr *expr; + + ss_info = ss->info; + expr = ss_info->expr; + info = &ss_info->data.array; - switch (ss->type) + if (expr && expr->shape && !info->shape) + info->shape = expr->shape; + + switch (ss_info->type) { case GFC_SS_SECTION: /* 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: - switch (ss->expr->value.function.isym->id) + switch (expr->value.function.isym->id) { /* Fall through to supply start and stride. */ case GFC_ISYM_LBOUND: @@ -3333,13 +3393,13 @@ 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; - 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; @@ -3356,7 +3416,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; @@ -3368,18 +3428,27 @@ 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->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. */ - info = &ss->data.info; + info = &ss_info->data.array; /* This code only checks ranges. Elemental and vector dimensions are checked later. */ @@ -3387,7 +3456,7 @@ done: { bool check_upper; - dim = info->dim[n]; + dim = ss->dim[n]; if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE) continue; @@ -3401,12 +3470,12 @@ 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; + desc = info->descriptor; /* This is the run-time equivalent of resolve.c's check_dimension(). The logical is more readable there @@ -3460,14 +3529,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)); @@ -3482,9 +3551,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); @@ -3514,14 +3583,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)); @@ -3531,9 +3600,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); @@ -3560,10 +3629,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])); @@ -3577,10 +3646,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); @@ -3633,12 +3702,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; @@ -3656,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 = lss->expr->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; @@ -3676,7 +3749,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->info->data.array.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) @@ -3711,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 = rss->expr->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; @@ -3747,20 +3820,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->type != GFC_SS_SECTION) + 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; @@ -3768,18 +3846,18 @@ 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]); 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. */ @@ -3828,11 +3906,11 @@ 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); - 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); } @@ -3851,9 +3929,9 @@ void gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { int n, dim, spec_dim; - gfc_ss_info *info; - gfc_ss_info *specinfo; - gfc_ss *ss; + gfc_array_info *info; + gfc_array_info *specinfo; + gfc_ss *ss, *tmp_ss; tree tmp; gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; bool dynamic[GFC_MAX_DIMENSIONS]; @@ -3871,19 +3949,19 @@ 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) continue; - info = &ss->data.info; - dim = info->dim[n]; + info = &ss->info->data.array; + dim = ss->dim[n]; if (loopspec[n] != NULL) { - specinfo = &loopspec[n]->data.info; - spec_dim = specinfo->dim[n]; + specinfo = &loopspec[n]->info->data.array; + spec_dim = loopspec[n]->dim[n]; } else { @@ -3892,19 +3970,19 @@ 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; 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. @@ -3916,7 +3994,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; @@ -3925,7 +4003,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; @@ -3936,7 +4014,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]) @@ -3948,7 +4026,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]) @@ -3970,11 +4048,11 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) that's bad news. */ gcc_assert (loopspec[n]); - info = &loopspec[n]->data.info; - dim = info->dim[n]; + info = &loopspec[n]->info->data.array; + 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])) { @@ -3994,7 +4072,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 @@ -4047,30 +4125,30 @@ 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); + 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) - loop->temp_ss->data.temp.type + if (tmp_ss_info->string_length) + tmp_ss_info->data.temp.type = gfc_get_character_type_len_for_eltype - (TREE_TYPE (loop->temp_ss->data.temp.type), - loop->temp_ss->string_length); + (TREE_TYPE (tmp_ss_info->data.temp.type), + tmp_ss_info->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_ss_info)); - loop->temp_ss->type = GFC_SS_SECTION; - loop->temp_ss->data.info.dimen = n; + tmp = tmp_ss_info->data.temp.type; + memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info)); + tmp_ss_info->type = GFC_SS_SECTION; - 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); } @@ -4087,19 +4165,22 @@ 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; + info = &ss->info->data.array; - 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 +5738,15 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) } } + /* Helper function to check dimensions. */ static bool 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) + for (n = 0; n < ss->dimen; n++) + if (ss->dim[n] != n) return true; return false; } @@ -5703,8 +5783,10 @@ 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_ss_info *ss_info; gfc_loopinfo loop; - gfc_ss_info *info; + gfc_array_info *info; int need_tmp; int n; tree tmp; @@ -5714,11 +5796,15 @@ 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_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) { @@ -5726,9 +5812,9 @@ 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->expr == expr); - info = &ss->data.info; + gcc_assert (ss_type == GFC_SS_SECTION); + gcc_assert (ss_expr == expr); + info = &ss_info->data.array; /* Get the descriptor for the array. */ gfc_conv_ss_descriptor (&se->pre, ss, 0); @@ -5805,7 +5891,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) @@ -5817,16 +5903,16 @@ 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) || (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 @@ -5838,19 +5924,19 @@ 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; 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)) { need_tmp = 0; - info = &ss->data.info; + info = &ss_info->data.array; } else { @@ -5898,8 +5984,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) : NULL), loop.dimen); - se->string_length = loop.temp_ss->string_length; - gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen); + 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); } @@ -5950,12 +6036,12 @@ 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)) { desc = info->descriptor; - se->string_length = ss->string_length; + se->string_length = ss_info->string_length; } else { @@ -5972,7 +6058,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) { @@ -6056,8 +6142,8 @@ 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); - start = info->subscript[n]->data.scalar.expr; + && info->subscript[n]->info->type == GFC_SS_SCALAR); + start = info->subscript[n]->info->data.scalar.value; } else { @@ -6087,7 +6173,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. */ @@ -7143,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; @@ -7173,11 +7260,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. */ @@ -7188,17 +7275,19 @@ 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) 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; 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) @@ -7208,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); @@ -7278,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; @@ -7368,21 +7457,21 @@ 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++) { 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]); - 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. */ @@ -7446,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. */ @@ -7640,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. */ @@ -7658,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++) @@ -7672,14 +7761,14 @@ 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: /* 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: @@ -7688,9 +7777,9 @@ 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->data.info.dim[newss->data.info.dimen] = n; - newss->data.info.dimen++; + newss->info->data.array.subscript[n] = indexss; + newss->dim[newss->dimen] = n; + newss->dimen++; break; default: @@ -7700,8 +7789,8 @@ 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 - || newss->data.info.ref->u.ar.as->corank > 0); + gcc_assert (newss->dimen > 0 + || newss->info->data.array.ref->u.ar.as->corank > 0); ss = newss; break; @@ -7812,7 +7901,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; diff --git a/trans-const.c b/trans-const.c index 5fbe765..fa820ef 100644 --- a/trans-const.c +++ b/trans-const.c @@ -358,6 +358,8 @@ gfc_conv_constant_to_tree (gfc_expr * expr) void gfc_conv_constant (gfc_se * se, gfc_expr * expr) { + gfc_ss *ss; + /* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR. If so, the expr_type will not yet be an EXPR_CONSTANT. We need to make it so here. */ @@ -380,14 +382,18 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr) return; } - if (se->ss != NULL) + ss = se->ss; + if (ss != NULL) { - gcc_assert (se->ss != gfc_ss_terminator); - gcc_assert (se->ss->type == GFC_SS_SCALAR); - gcc_assert (se->ss->expr == expr); + gfc_ss_info *ss_info; + + ss_info = ss->info; + gcc_assert (ss != gfc_ss_terminator); + gcc_assert (ss_info->type == GFC_SS_SCALAR); + gcc_assert (ss_info->expr == expr); - se->expr = se->ss->data.scalar.expr; - se->string_length = se->ss->string_length; + se->expr = ss_info->data.scalar.value; + se->string_length = ss_info->string_length; gfc_advance_se_ss_chain (se); return; } diff --git a/trans-expr.c b/trans-expr.c index b2c1739..01d4ca3 100644 --- a/trans-expr.c +++ b/trans-expr.c @@ -613,6 +613,7 @@ conv_parent_component_references (gfc_se * se, gfc_ref * ref) static void gfc_conv_variable (gfc_se * se, gfc_expr * expr) { + gfc_ss *ss; gfc_ref *ref; gfc_symbol *sym; tree parent_decl = NULL_TREE; @@ -622,16 +623,19 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) bool entry_master; sym = expr->symtree->n.sym; - if (se->ss != NULL) + ss = se->ss; + if (ss != NULL) { + gfc_ss_info *ss_info = ss->info; + /* Check that something hasn't gone horribly wrong. */ - gcc_assert (se->ss != gfc_ss_terminator); - gcc_assert (se->ss->expr == expr); + gcc_assert (ss != gfc_ss_terminator); + gcc_assert (ss_info->expr == expr); /* A scalarized term. We already know the descriptor. */ - se->expr = se->ss->data.info.descriptor; - se->string_length = se->ss->string_length; - for (ref = se->ss->data.info.ref; ref; ref = ref->next) + se->expr = ss_info->data.array.descriptor; + se->string_length = ss_info->string_length; + for (ref = ss_info->data.array.ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) break; } @@ -2359,7 +2363,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, gfc_ss *rss; gfc_loopinfo loop; gfc_loopinfo loop2; - gfc_ss_info *info; + gfc_array_info *info; tree offset; tree tmp_index; tree tmp; @@ -2400,7 +2404,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, : NULL), loop.dimen); - parmse->string_length = loop.temp_ss->string_length; + parmse->string_length = loop.temp_ss->info->string_length; /* Associate the SS with the loop. */ gfc_add_ss_to_loop (&loop, loop.temp_ss); @@ -2409,7 +2413,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, gfc_conv_loop_setup (&loop, &expr->where); /* Pass the temporary descriptor back to the caller. */ - info = &loop.temp_ss->data.info; + info = &loop.temp_ss->info->data.array; parmse->expr = info->descriptor; /* Setup the gfc_se structures. */ @@ -2488,8 +2492,8 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, dimensions, so this is very simple. The offset is only computed outside the innermost loop, so the overall transfer could be optimized further. */ - info = &rse.ss->data.info; - dimen = info->dimen; + info = &rse.ss->info->data.array; + dimen = rse.ss->dimen; tmp_index = gfc_index_zero_node; for (n = dimen - 1; n > 0; n--) @@ -2854,7 +2858,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tree fntype; gfc_se parmse; gfc_ss *argss; - gfc_ss_info *info; + gfc_array_info *info; int byref; int parm_kind; tree type; @@ -2893,8 +2897,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { if (!sym->attr.elemental) { - gcc_assert (se->ss->type == GFC_SS_FUNCTION); - if (se->ss->useflags) + gcc_assert (se->ss->info->type == GFC_SS_FUNCTION); + if (se->ss->info->useflags) { gcc_assert ((!comp && gfc_return_by_reference (sym) && sym->result->attr.dimension) @@ -2906,7 +2910,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, return 0; } } - info = &se->ss->data.info; + info = &se->ss->info->data.array; } else info = NULL; @@ -2979,7 +2983,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_init_se (&parmse, se); gfc_conv_derived_to_class (&parmse, e, fsym->ts); } - else if (se->ss && se->ss->useflags) + else if (se->ss && se->ss->info->useflags) { /* An elemental function inside a scalarized loop. */ gfc_init_se (&parmse, se); @@ -3582,7 +3586,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Set the type of the array. */ tmp = gfc_typenode_for_spec (&comp->ts); - gcc_assert (info->dimen == se->loop->dimen); + gcc_assert (se->ss->dimen == se->loop->dimen); /* Evaluate the bounds of the result, if known. */ gfc_set_loop_bounds_from_array_spec (&mapping, se, comp->as); @@ -3604,8 +3608,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, callee_alloc = comp->attr.allocatable || comp->attr.pointer; gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, tmp, NULL_TREE, false, - !comp->attr.pointer, - callee_alloc, &se->ss->expr->where); + !comp->attr.pointer, callee_alloc, + &se->ss->info->expr->where); /* Pass the temporary as the first argument. */ result = info->descriptor; @@ -3618,7 +3622,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Set the type of the array. */ tmp = gfc_typenode_for_spec (&ts); - gcc_assert (info->dimen == se->loop->dimen); + gcc_assert (se->ss->dimen == se->loop->dimen); /* Evaluate the bounds of the result, if known. */ gfc_set_loop_bounds_from_array_spec (&mapping, se, sym->result->as); @@ -3640,8 +3644,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, callee_alloc = sym->attr.allocatable || sym->attr.pointer; gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, tmp, NULL_TREE, false, - !sym->attr.pointer, - callee_alloc, &se->ss->expr->where); + !sym->attr.pointer, callee_alloc, + &se->ss->info->expr->where); /* Pass the temporary as the first argument. */ result = info->descriptor; @@ -4239,8 +4243,11 @@ is_zero_initializer_p (gfc_expr * expr) static void gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr) { - gcc_assert (se->ss != NULL && se->ss != gfc_ss_terminator); - gcc_assert (se->ss->expr == expr && se->ss->type == GFC_SS_CONSTRUCTOR); + gfc_ss *ss; + + ss = se->ss; + gcc_assert (ss != NULL && ss != gfc_ss_terminator); + gcc_assert (ss->info->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR); gfc_conv_tmp_array_ref (se); } @@ -4344,6 +4351,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) gfc_se lse; gfc_ss *rss; gfc_ss *lss; + gfc_array_info *lss_array; stmtblock_t body; stmtblock_t block; gfc_loopinfo loop; @@ -4367,19 +4375,20 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) /* Create a SS for the destination. */ lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, GFC_SS_COMPONENT); - lss->shape = gfc_get_shape (cm->as->rank); - lss->data.info.descriptor = dest; - lss->data.info.data = gfc_conv_array_data (dest); - lss->data.info.offset = gfc_conv_array_offset (dest); + lss_array = &lss->info->data.array; + lss_array->shape = gfc_get_shape (cm->as->rank); + lss_array->descriptor = dest; + lss_array->data = gfc_conv_array_data (dest); + lss_array->offset = gfc_conv_array_offset (dest); for (n = 0; n < cm->as->rank; n++) { - lss->data.info.start[n] = gfc_conv_array_lbound (dest, n); - lss->data.info.stride[n] = gfc_index_one_node; + lss_array->start[n] = gfc_conv_array_lbound (dest, n); + lss_array->stride[n] = gfc_index_one_node; - mpz_init (lss->shape[n]); - mpz_sub (lss->shape[n], cm->as->upper[n]->value.integer, + mpz_init (lss_array->shape[n]); + mpz_sub (lss_array->shape[n], cm->as->upper[n]->value.integer, cm->as->lower[n]->value.integer); - mpz_add_ui (lss->shape[n], lss->shape[n], 1); + mpz_add_ui (lss_array->shape[n], lss_array->shape[n], 1); } /* Associate the SS with the loop. */ @@ -4422,8 +4431,8 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) gfc_add_block_to_block (&block, &loop.pre); gfc_add_block_to_block (&block, &loop.post); - gcc_assert (lss->shape != NULL); - gfc_free_shape (&lss->shape, cm->as->rank); + gcc_assert (lss_array->shape != NULL); + gfc_free_shape (&lss_array->shape, cm->as->rank); gfc_cleanup_loop (&loop); return gfc_finish_block (&block); @@ -4819,15 +4828,22 @@ gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr) void gfc_conv_expr (gfc_se * se, gfc_expr * expr) { - if (se->ss && se->ss->expr == expr - && (se->ss->type == GFC_SS_SCALAR || se->ss->type == GFC_SS_REFERENCE)) + gfc_ss *ss; + + ss = se->ss; + if (ss && ss->info->expr == expr + && (ss->info->type == GFC_SS_SCALAR + || ss->info->type == GFC_SS_REFERENCE)) { + gfc_ss_info *ss_info; + + ss_info = ss->info; /* Substitute a scalar expression evaluated outside the scalarization loop. */ - se->expr = se->ss->data.scalar.expr; - if (se->ss->type == GFC_SS_REFERENCE) + se->expr = ss_info->data.scalar.value; + if (ss_info->type == GFC_SS_REFERENCE) se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); - se->string_length = se->ss->string_length; + se->string_length = ss_info->string_length; gfc_advance_se_ss_chain (se); return; } @@ -4944,10 +4960,12 @@ gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree type) void gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) { + gfc_ss *ss; tree var; - if (se->ss && se->ss->expr == expr - && se->ss->type == GFC_SS_REFERENCE) + ss = se->ss; + if (ss && ss->info->expr == expr + && ss->info->type == GFC_SS_REFERENCE) { /* Returns a reference to the scalar evaluated outside the loop for this case. */ @@ -6152,7 +6170,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, /* Find a non-scalar SS from the lhs. */ while (lss_section != gfc_ss_terminator - && lss_section->type != GFC_SS_SECTION) + && lss_section->info->type != GFC_SS_SECTION) lss_section = lss_section->next; gcc_assert (lss_section != gfc_ss_terminator); diff --git a/trans-intrinsic.c b/trans-intrinsic.c index 95161f8..fcc59d7 100644 --- a/trans-intrinsic.c +++ b/trans-intrinsic.c @@ -1004,7 +1004,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) gcc_assert (!expr->value.function.actual->next->expr); gcc_assert (corank > 0); gcc_assert (se->loop->dimen == 1); - gcc_assert (se->ss->expr == expr); + gcc_assert (se->ss->info->expr == expr); dim_arg = se->loop->loopvar[0]; dim_arg = fold_build2_loc (input_location, PLUS_EXPR, @@ -1321,7 +1321,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) /* Create an implicit second parameter from the loop variable. */ gcc_assert (!arg2->expr); gcc_assert (se->loop->dimen == 1); - gcc_assert (se->ss->expr == expr); + gcc_assert (se->ss->info->expr == expr); gfc_advance_se_ss_chain (se); bound = se->loop->loopvar[0]; bound = fold_build2_loc (input_location, MINUS_EXPR, @@ -1515,7 +1515,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) gcc_assert (!arg2->expr); gcc_assert (corank > 0); gcc_assert (se->loop->dimen == 1); - gcc_assert (se->ss->expr == expr); + gcc_assert (se->ss->info->expr == expr); bound = se->loop->loopvar[0]; bound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, @@ -2323,7 +2323,7 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr) gfc_symbol *sym; VEC(tree,gc) *append_args; - gcc_assert (!se->ss || se->ss->expr == expr); + gcc_assert (!se->ss || se->ss->info->expr == expr); if (se->ss) gcc_assert (expr->rank > 0); @@ -5269,14 +5269,14 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) gfc_actual_arglist *arg; gfc_se argse; gfc_ss *ss; - gfc_ss_info *info; + gfc_array_info *info; stmtblock_t block; int n; bool scalar_mold; info = NULL; if (se->loop) - info = &se->ss->data.info; + info = &se->ss->info->data.array; /* Convert SOURCE. The output from this stage is:- source_bytes = length of the source in bytes @@ -6634,7 +6634,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) break; case GFC_ISYM_TRANSFER: - if (se->ss && se->ss->useflags) + if (se->ss && se->ss->info->useflags) /* Access the previously obtained result. */ gfc_conv_tmp_array_ref (se); else @@ -6753,19 +6753,17 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr) for (tmp_ss = arg_ss; ; tmp_ss = tmp_ss->next) { - if (tmp_ss->type != GFC_SS_SCALAR - && tmp_ss->type != GFC_SS_REFERENCE) + if (tmp_ss->info->type != GFC_SS_SCALAR + && tmp_ss->info->type != GFC_SS_REFERENCE) { int tmp_dim; - gfc_ss_info *info; - info = &tmp_ss->data.info; - gcc_assert (info->dimen == 2); + gcc_assert (tmp_ss->dimen == 2); /* We just invert dimensions. */ - tmp_dim = info->dim[0]; - info->dim[0] = info->dim[1]; - info->dim[1] = tmp_dim; + tmp_dim = tmp_ss->dim[0]; + tmp_ss->dim[0] = tmp_ss->dim[1]; + tmp_ss->dim[1] = tmp_dim; } /* Stop when tmp_ss points to the last valid element of the chain... */ @@ -6802,7 +6800,7 @@ walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr) void gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss) { - switch (ss->expr->value.function.isym->id) + switch (ss->info->expr->value.function.isym->id) { case GFC_ISYM_UBOUND: case GFC_ISYM_LBOUND: diff --git a/trans-io.c b/trans-io.c index bbf5a02..12dfcf8 100644 --- a/trans-io.c +++ b/trans-io.c @@ -1937,6 +1937,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) int n; gfc_ss *ss; gfc_se se; + gfc_array_info *ss_array; gfc_start_block (&block); gfc_init_se (&se, NULL); @@ -1948,19 +1949,20 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) ss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, GFC_SS_COMPONENT); - ss->shape = gfc_get_shape (cm->as->rank); - ss->data.info.descriptor = expr; - ss->data.info.data = gfc_conv_array_data (expr); - ss->data.info.offset = gfc_conv_array_offset (expr); + ss_array = &ss->info->data.array; + ss_array->shape = gfc_get_shape (cm->as->rank); + ss_array->descriptor = expr; + ss_array->data = gfc_conv_array_data (expr); + ss_array->offset = gfc_conv_array_offset (expr); for (n = 0; n < cm->as->rank; n++) { - ss->data.info.start[n] = gfc_conv_array_lbound (expr, n); - ss->data.info.stride[n] = gfc_index_one_node; + ss_array->start[n] = gfc_conv_array_lbound (expr, n); + ss_array->stride[n] = gfc_index_one_node; - mpz_init (ss->shape[n]); - mpz_sub (ss->shape[n], cm->as->upper[n]->value.integer, + mpz_init (ss_array->shape[n]); + mpz_sub (ss_array->shape[n], cm->as->upper[n]->value.integer, cm->as->lower[n]->value.integer); - mpz_add_ui (ss->shape[n], ss->shape[n], 1); + mpz_add_ui (ss_array->shape[n], ss_array->shape[n], 1); } /* Once we got ss, we use scalarizer to create the loop. */ @@ -1995,8 +1997,8 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) gfc_add_block_to_block (&block, &loop.pre); gfc_add_block_to_block (&block, &loop.post); - gcc_assert (ss->shape != NULL); - gfc_free_shape (&ss->shape, cm->as->rank); + gcc_assert (ss_array->shape != NULL); + gfc_free_shape (&ss_array->shape, cm->as->rank); gfc_cleanup_loop (&loop); return gfc_finish_block (&block); diff --git a/trans-stmt.c b/trans-stmt.c index c7ae360..86a56e8 100644 --- a/trans-stmt.c +++ b/trans-stmt.c @@ -193,7 +193,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, gfc_loopinfo tmp_loop; gfc_se parmse; gfc_ss *ss; - gfc_ss_info *info; + gfc_array_info *info; gfc_symbol *fsym; gfc_ref *ref; int n; @@ -220,9 +220,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, info = NULL; for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next) { - if (ss->expr != e) + if (ss->info->expr != e) continue; - info = &ss->data.info; + info = &ss->info->data.array; break; } @@ -241,8 +241,8 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, /* Make a local loopinfo for the temporary creation, so that none of the other ss->info's have to be renormalized. */ gfc_init_loopinfo (&tmp_loop); - tmp_loop.dimen = info->dimen; - for (n = 0; n < info->dimen; n++) + tmp_loop.dimen = ss->dimen; + for (n = 0; n < ss->dimen; n++) { tmp_loop.to[n] = loopse->loop->to[n]; tmp_loop.from[n] = loopse->loop->from[n]; @@ -320,7 +320,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, /* Calculate the offset for the temporary. */ offset = gfc_index_zero_node; - for (n = 0; n < info->dimen; n++) + for (n = 0; n < ss->dimen; n++) { tmp = gfc_conv_descriptor_stride_get (info->descriptor, gfc_rank_cst[n]); @@ -3306,7 +3306,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_ss *lss, *rss; gfc_se lse; gfc_se rse; - gfc_ss_info *info; + gfc_array_info *info; gfc_loopinfo loop; tree desc; tree parm; @@ -3388,7 +3388,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_conv_loop_setup (&loop, &expr2->where); - info = &rss->data.info; + info = &rss->info->data.array; desc = info->descriptor; /* Make a new descriptor. */ @@ -4048,7 +4048,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, /* Find a non-scalar SS from the lhs. */ while (lss_section != gfc_ss_terminator - && lss_section->type != GFC_SS_SECTION) + && lss_section->info->type != GFC_SS_SECTION) lss_section = lss_section->next; gcc_assert (lss_section != gfc_ss_terminator); @@ -4062,7 +4062,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, { /* The rhs is scalar. Add a ss for the expression. */ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2); - rss->where = 1; + rss->info->where = 1; } /* Associate the SS with the loop. */ @@ -4501,7 +4501,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock) if (tsss == gfc_ss_terminator) { tsss = gfc_get_scalar_ss (gfc_ss_terminator, tsrc); - tsss->where = 1; + tsss->info->where = 1; } gfc_add_ss_to_loop (&loop, tdss); gfc_add_ss_to_loop (&loop, tsss); @@ -4516,7 +4516,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock) if (esss == gfc_ss_terminator) { esss = gfc_get_scalar_ss (gfc_ss_terminator, esrc); - esss->where = 1; + esss->info->where = 1; } gfc_add_ss_to_loop (&loop, edss); gfc_add_ss_to_loop (&loop, esss); diff --git a/trans.h b/trans.h index 535c207..c35b1ae 100644 --- a/trans.h +++ b/trans.h @@ -108,17 +108,13 @@ typedef enum gfc_coarray_type; -/* Scalarization State chain. Created by walking an expression tree before - creating the scalarization loops. Then passed as part of a gfc_se structure - to translate the expression inside the loop. Note that these chains are - terminated by gfc_se_terminator, not NULL. A NULL pointer in a gfc_se - indicates to gfc_conv_* that this is a scalar expression. - Note that some member arrays correspond to scalarizer rank and others - are the variable rank. */ +/* The array-specific scalarization informations. The array members of + this struct are indexed by actual array index, and thus can be sparse. */ -typedef struct gfc_ss_info +typedef struct gfc_array_info { - int dimen; + mpz_t *shape; + /* The ref that holds information on this section. */ gfc_ref *ref; /* The descriptor of this array. */ @@ -139,12 +135,8 @@ typedef struct gfc_ss_info tree end[GFC_MAX_DIMENSIONS]; tree stride[GFC_MAX_DIMENSIONS]; tree delta[GFC_MAX_DIMENSIONS]; - - /* Translation from loop dimensions to actual dimensions. - actual_dim = dim[loop_dim] */ - int dim[GFC_MAX_DIMENSIONS]; } -gfc_ss_info; +gfc_array_info; typedef enum { @@ -190,47 +182,70 @@ typedef enum } gfc_ss_type; -/* SS structures can only belong to a single loopinfo. They must be added - otherwise they will not get freed. */ -typedef struct gfc_ss + +typedef struct gfc_ss_info { gfc_ss_type type; gfc_expr *expr; - mpz_t *shape; tree string_length; + union { /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ struct { - tree expr; + tree value; } scalar; /* GFC_SS_TEMP. */ struct { - /* The rank of the temporary. May be less than the rank of the - assigned expression. */ - int dimen; tree type; } temp; + /* All other types. */ - gfc_ss_info info; + gfc_array_info array; } data; + /* This is used by assignments requiring temporaries. The bits specify which + loops the terms appear in. This will be 1 for the RHS expressions, + 2 for the LHS expressions, and 3(=1|2) for the temporary. */ + unsigned useflags:2; + + /* Suppresses precalculation of scalars in WHERE assignments. */ + unsigned where:1; +} +gfc_ss_info; + +#define gfc_get_ss_info() XCNEW (gfc_ss_info) + + +/* Scalarization State chain. Created by walking an expression tree before + creating the scalarization loops. Then passed as part of a gfc_se structure + to translate the expression inside the loop. Note that these chains are + terminated by gfc_ss_terminator, not NULL. A NULL pointer in a gfc_se + indicates to gfc_conv_* that this is a scalar expression. + SS structures can only belong to a single loopinfo. They must be added + otherwise they will not get freed. */ + +typedef struct gfc_ss +{ + gfc_ss_info *info; + + int dimen; + /* Translation from loop dimensions to actual array dimensions. + actual_dim = dim[loop_dim] */ + int dim[GFC_MAX_DIMENSIONS]; + /* All the SS in a loop and linked through loop_chain. The SS for an expression are linked by the next pointer. */ struct gfc_ss *loop_chain; struct gfc_ss *next; - /* This is used by assignments requiring temporaries. The bits specify which - loops the terms appear in. This will be 1 for the RHS expressions, - 2 for the LHS expressions, and 3(=1|2) for the temporary. The bit - 'where' suppresses precalculation of scalars in WHERE assignments. */ - unsigned useflags:2, where:1, is_alloc_lhs:1; + unsigned is_alloc_lhs:1; } gfc_ss; #define gfc_get_ss() XCNEW (gfc_ss) --===============2275985892752799265==--