Bug Summary

File:build/gcc/vec.h
Warning:line 815, column 10
Called C++ object pointer is null

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-unknown-linux-gnu -analyze -disable-free -disable-llvm-verifier -discard-value-names -main-file-name trans-array.c -analyzer-store=region -analyzer-opt-analyze-nested-blocks -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -fno-rounding-math -mconstructor-aliases -munwind-tables -target-cpu x86-64 -fno-split-dwarf-inlining -debugger-tuning=gdb -resource-dir /usr/lib64/clang/11.0.0 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/10/../../../../include/c++/10 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/10/../../../../include/c++/10/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/10/../../../../include/c++/10/backward -internal-isystem /usr/local/include -internal-isystem /usr/lib64/clang/11.0.0/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-error=format-diag -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -o /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2021-01-16-135054-17580-1/report-OFQst9.plist -x c++ /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c

/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c

1/* Array translation routines
2 Copyright (C) 2002-2021 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
4 and Steven Bosscher <s.bosscher@student.tudelft.nl>
5
6This file is part of GCC.
7
8GCC is free software; you can redistribute it and/or modify it under
9the terms of the GNU General Public License as published by the Free
10Software Foundation; either version 3, or (at your option) any later
11version.
12
13GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14WARRANTY; without even the implied warranty of MERCHANTABILITY or
15FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16for more details.
17
18You should have received a copy of the GNU General Public License
19along with GCC; see the file COPYING3. If not see
20<http://www.gnu.org/licenses/>. */
21
22/* trans-array.c-- Various array related code, including scalarization,
23 allocation, initialization and other support routines. */
24
25/* How the scalarizer works.
26 In gfortran, array expressions use the same core routines as scalar
27 expressions.
28 First, a Scalarization State (SS) chain is built. This is done by walking
29 the expression tree, and building a linear list of the terms in the
30 expression. As the tree is walked, scalar subexpressions are translated.
31
32 The scalarization parameters are stored in a gfc_loopinfo structure.
33 First the start and stride of each term is calculated by
34 gfc_conv_ss_startstride. During this process the expressions for the array
35 descriptors and data pointers are also translated.
36
37 If the expression is an assignment, we must then resolve any dependencies.
38 In Fortran all the rhs values of an assignment must be evaluated before
39 any assignments take place. This can require a temporary array to store the
40 values. We also require a temporary when we are passing array expressions
41 or vector subscripts as procedure parameters.
42
43 Array sections are passed without copying to a temporary. These use the
44 scalarizer to determine the shape of the section. The flag
45 loop->array_parameter tells the scalarizer that the actual values and loop
46 variables will not be required.
47
48 The function gfc_conv_loop_setup generates the scalarization setup code.
49 It determines the range of the scalarizing loop variables. If a temporary
50 is required, this is created and initialized. Code for scalar expressions
51 taken outside the loop is also generated at this time. Next the offset and
52 scaling required to translate from loop variables to array indices for each
53 term is calculated.
54
55 A call to gfc_start_scalarized_body marks the start of the scalarized
56 expression. This creates a scope and declares the loop variables. Before
57 calling this gfc_make_ss_chain_used must be used to indicate which terms
58 will be used inside this loop.
59
60 The scalar gfc_conv_* functions are then used to build the main body of the
61 scalarization loop. Scalarization loop variables and precalculated scalar
62 values are automatically substituted. Note that gfc_advance_se_ss_chain
63 must be used, rather than changing the se->ss directly.
64
65 For assignment expressions requiring a temporary two sub loops are
66 generated. The first stores the result of the expression in the temporary,
67 the second copies it to the result. A call to
68 gfc_trans_scalarized_loop_boundary marks the end of the main loop code and
69 the start of the copying loop. The temporary may be less than full rank.
70
71 Finally gfc_trans_scalarizing_loops is called to generate the implicit do
72 loops. The loops are added to the pre chain of the loopinfo. The post
73 chain may still contain cleanup code.
74
75 After the loop code has been added into its parent scope gfc_cleanup_loop
76 is called to free all the SS allocated by the scalarizer. */
77
78#include "config.h"
79#include "system.h"
80#include "coretypes.h"
81#include "options.h"
82#include "tree.h"
83#include "gfortran.h"
84#include "gimple-expr.h"
85#include "trans.h"
86#include "fold-const.h"
87#include "constructor.h"
88#include "trans-types.h"
89#include "trans-array.h"
90#include "trans-const.h"
91#include "dependency.h"
92
93static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
94
95/* The contents of this structure aren't actually used, just the address. */
96static gfc_ss gfc_ss_terminator_var;
97gfc_ss * const gfc_ss_terminator = &gfc_ss_terminator_var;
98
99
100static tree
101gfc_array_dataptr_type (tree desc)
102{
103 return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc))(((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 103, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 103, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
);
104}
105
106
107/* Build expressions to access the members of an array descriptor.
108 It's surprisingly easy to mess up here, so never access
109 an array descriptor by "brute force", always use these
110 functions. This also avoids problems if we change the format
111 of an array descriptor.
112
113 To understand these magic numbers, look at the comments
114 before gfc_build_array_type() in trans-types.c.
115
116 The code within these defines should be the only code which knows the format
117 of an array descriptor.
118
119 Any code just needing to read obtain the bounds of an array should use
120 gfc_conv_array_* rather than the following functions as these will return
121 know constant values, and work with arrays which do not have descriptors.
122
123 Don't forget to #undef these! */
124
125#define DATA_FIELD 0
126#define OFFSET_FIELD 1
127#define DTYPE_FIELD 2
128#define SPAN_FIELD 3
129#define DIMENSION_FIELD 4
130#define CAF_TOKEN_FIELD 5
131
132#define STRIDE_SUBFIELD 0
133#define LBOUND_SUBFIELD 1
134#define UBOUND_SUBFIELD 2
135
136static tree
137gfc_get_descriptor_field (tree desc, unsigned field_idx)
138{
139 tree type = TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 139, __FUNCTION__))->typed.type)
;
140 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 140, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 140, __FUNCTION__), 0 : 0))
;
141
142 tree field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 142, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, field_idx);
143 gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 143, __FUNCTION__), 0 : 0))
;
144
145 return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 145, __FUNCTION__))->typed.type)
,
146 desc, field, NULL_TREE(tree) __null);
147}
148
149/* This provides READ-ONLY access to the data field. The field itself
150 doesn't have the proper type. */
151
152tree
153gfc_conv_descriptor_data_get (tree desc)
154{
155 tree type = TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 155, __FUNCTION__))->typed.type)
;
156 if (TREE_CODE (type)((enum tree_code) (type)->base.code) == REFERENCE_TYPE)
157 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 157, __FUNCTION__))
;
158
159 tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
160 return fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), field)fold_convert_loc (((location_t) 0), (((tree_class_check ((type
), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 160, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type), field)
;
161}
162
163/* This provides WRITE access to the data field.
164
165 TUPLES_P is true if we are generating tuples.
166
167 This function gets called through the following macros:
168 gfc_conv_descriptor_data_set
169 gfc_conv_descriptor_data_set. */
170
171void
172gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
173{
174 tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
175 gfc_add_modify (block, field, fold_convert (TREE_TYPE (field), value)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 175, __FUNCTION__))->typed.type), value)
);
176}
177
178
179/* This provides address access to the data field. This should only be
180 used by array allocation, passing this on to the runtime. */
181
182tree
183gfc_conv_descriptor_data_addr (tree desc)
184{
185 tree field = gfc_get_descriptor_field (desc, DATA_FIELD);
186 return gfc_build_addr_expr (NULL_TREE(tree) __null, field);
187}
188
189static tree
190gfc_conv_descriptor_offset (tree desc)
191{
192 tree field = gfc_get_descriptor_field (desc, OFFSET_FIELD);
193 gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 193, __FUNCTION__))->typed.type) == gfc_array_index_type
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 193, __FUNCTION__), 0 : 0))
;
194 return field;
195}
196
197tree
198gfc_conv_descriptor_offset_get (tree desc)
199{
200 return gfc_conv_descriptor_offset (desc);
201}
202
203void
204gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
205 tree value)
206{
207 tree t = gfc_conv_descriptor_offset (desc);
208 gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 208, __FUNCTION__))->typed.type), value)
);
209}
210
211
212tree
213gfc_conv_descriptor_dtype (tree desc)
214{
215 tree field = gfc_get_descriptor_field (desc, DTYPE_FIELD);
216 gcc_assert (TREE_TYPE (field) == get_dtype_type_node ())((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 216, __FUNCTION__))->typed.type) == get_dtype_type_node (
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 216, __FUNCTION__), 0 : 0))
;
217 return field;
218}
219
220static tree
221gfc_conv_descriptor_span (tree desc)
222{
223 tree field = gfc_get_descriptor_field (desc, SPAN_FIELD);
224 gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 224, __FUNCTION__))->typed.type) == gfc_array_index_type
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 224, __FUNCTION__), 0 : 0))
;
225 return field;
226}
227
228tree
229gfc_conv_descriptor_span_get (tree desc)
230{
231 return gfc_conv_descriptor_span (desc);
232}
233
234void
235gfc_conv_descriptor_span_set (stmtblock_t *block, tree desc,
236 tree value)
237{
238 tree t = gfc_conv_descriptor_span (desc);
239 gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 239, __FUNCTION__))->typed.type), value)
);
240}
241
242
243tree
244gfc_conv_descriptor_rank (tree desc)
245{
246 tree tmp;
247 tree dtype;
248
249 dtype = gfc_conv_descriptor_dtype (desc);
250 tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype))((tree_check3 ((((contains_struct_check ((dtype), (TS_TYPED),
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 250, __FUNCTION__))->typed.type)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 250, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, GFC_DTYPE_RANK2);
251 gcc_assert (tmp != NULL_TREE((void)(!(tmp != (tree) __null && ((contains_struct_check
((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 252, __FUNCTION__))->typed.type) == integer_types[itk_signed_char
]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 252, __FUNCTION__), 0 : 0))
252 && TREE_TYPE (tmp) == signed_char_type_node)((void)(!(tmp != (tree) __null && ((contains_struct_check
((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 252, __FUNCTION__))->typed.type) == integer_types[itk_signed_char
]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 252, __FUNCTION__), 0 : 0))
;
253 return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 253, __FUNCTION__))->typed.type)
,
254 dtype, tmp, NULL_TREE(tree) __null);
255}
256
257
258/* Return the element length from the descriptor dtype field. */
259
260tree
261gfc_conv_descriptor_elem_len (tree desc)
262{
263 tree tmp;
264 tree dtype;
265
266 dtype = gfc_conv_descriptor_dtype (desc);
267 tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype))((tree_check3 ((((contains_struct_check ((dtype), (TS_TYPED),
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 267, __FUNCTION__))->typed.type)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 267, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
,
268 GFC_DTYPE_ELEM_LEN0);
269 gcc_assert (tmp != NULL_TREE((void)(!(tmp != (tree) __null && ((contains_struct_check
((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 270, __FUNCTION__))->typed.type) == global_trees[TI_SIZE_TYPE
]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 270, __FUNCTION__), 0 : 0))
270 && TREE_TYPE (tmp) == size_type_node)((void)(!(tmp != (tree) __null && ((contains_struct_check
((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 270, __FUNCTION__))->typed.type) == global_trees[TI_SIZE_TYPE
]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 270, __FUNCTION__), 0 : 0))
;
271 return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 271, __FUNCTION__))->typed.type)
,
272 dtype, tmp, NULL_TREE(tree) __null);
273}
274
275
276tree
277gfc_conv_descriptor_attribute (tree desc)
278{
279 tree tmp;
280 tree dtype;
281
282 dtype = gfc_conv_descriptor_dtype (desc);
283 tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype))((tree_check3 ((((contains_struct_check ((dtype), (TS_TYPED),
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 283, __FUNCTION__))->typed.type)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 283, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
,
284 GFC_DTYPE_ATTRIBUTE4);
285 gcc_assert (tmp!= NULL_TREE((void)(!(tmp!= (tree) __null && ((contains_struct_check
((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 286, __FUNCTION__))->typed.type) == integer_types[itk_short
]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 286, __FUNCTION__), 0 : 0))
286 && TREE_TYPE (tmp) == short_integer_type_node)((void)(!(tmp!= (tree) __null && ((contains_struct_check
((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 286, __FUNCTION__))->typed.type) == integer_types[itk_short
]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 286, __FUNCTION__), 0 : 0))
;
287 return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 287, __FUNCTION__))->typed.type)
,
288 dtype, tmp, NULL_TREE(tree) __null);
289}
290
291tree
292gfc_get_descriptor_dimension (tree desc)
293{
294 tree field = gfc_get_descriptor_field (desc, DIMENSION_FIELD);
295 gcc_assert (TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE((void)(!(((enum tree_code) (((contains_struct_check ((field)
, (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 295, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE
&& ((enum tree_code) (((contains_struct_check ((((contains_struct_check
((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 296, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 296, __FUNCTION__))->typed.type))->base.code) == RECORD_TYPE
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 296, __FUNCTION__), 0 : 0))
296 && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE)((void)(!(((enum tree_code) (((contains_struct_check ((field)
, (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 295, __FUNCTION__))->typed.type))->base.code) == ARRAY_TYPE
&& ((enum tree_code) (((contains_struct_check ((((contains_struct_check
((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 296, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 296, __FUNCTION__))->typed.type))->base.code) == RECORD_TYPE
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 296, __FUNCTION__), 0 : 0))
;
297 return field;
298}
299
300
301static tree
302gfc_conv_descriptor_dimension (tree desc, tree dim)
303{
304 tree tmp;
305
306 tmp = gfc_get_descriptor_dimension (desc);
307
308 return gfc_build_array_ref (tmp, dim, NULL__null);
309}
310
311
312tree
313gfc_conv_descriptor_token (tree desc)
314{
315 gcc_assert (flag_coarray == GFC_FCOARRAY_LIB)((void)(!(global_options.x_flag_coarray == GFC_FCOARRAY_LIB) ?
fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 315, __FUNCTION__), 0 : 0))
;
316 tree field = gfc_get_descriptor_field (desc, CAF_TOKEN_FIELD);
317 /* Should be a restricted pointer - except in the finalization wrapper. */
318 gcc_assert (TREE_TYPE (field) == prvoid_type_node((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 318, __FUNCTION__))->typed.type) == prvoid_type_node || (
(contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 319, __FUNCTION__))->typed.type) == pvoid_type_node) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 319, __FUNCTION__), 0 : 0))
319 || TREE_TYPE (field) == pvoid_type_node)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 318, __FUNCTION__))->typed.type) == prvoid_type_node || (
(contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 319, __FUNCTION__))->typed.type) == pvoid_type_node) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 319, __FUNCTION__), 0 : 0))
;
320 return field;
321}
322
323static tree
324gfc_conv_descriptor_subfield (tree desc, tree dim, unsigned field_idx)
325{
326 tree tmp = gfc_conv_descriptor_dimension (desc, dim);
327 tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp))((tree_check3 ((((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 327, __FUNCTION__))->typed.type)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 327, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, field_idx);
328 gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 328, __FUNCTION__), 0 : 0))
;
329
330 return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 330, __FUNCTION__))->typed.type)
,
331 tmp, field, NULL_TREE(tree) __null);
332}
333
334static tree
335gfc_conv_descriptor_stride (tree desc, tree dim)
336{
337 tree field = gfc_conv_descriptor_subfield (desc, dim, STRIDE_SUBFIELD);
338 gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 338, __FUNCTION__))->typed.type) == gfc_array_index_type
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 338, __FUNCTION__), 0 : 0))
;
339 return field;
340}
341
342tree
343gfc_conv_descriptor_stride_get (tree desc, tree dim)
344{
345 tree type = TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 345, __FUNCTION__))->typed.type)
;
346 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 346, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 346, __FUNCTION__), 0 : 0))
;
347 if (integer_zerop (dim)
348 && (GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 348, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ALLOCATABLE
349 ||GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 349, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_SHAPE_CONT
350 ||GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 350, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_RANK_CONT
351 ||GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 351, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_POINTER_CONT))
352 return gfc_index_one_nodegfc_rank_cst[1];
353
354 return gfc_conv_descriptor_stride (desc, dim);
355}
356
357void
358gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
359 tree dim, tree value)
360{
361 tree t = gfc_conv_descriptor_stride (desc, dim);
362 gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 362, __FUNCTION__))->typed.type), value)
);
363}
364
365static tree
366gfc_conv_descriptor_lbound (tree desc, tree dim)
367{
368 tree field = gfc_conv_descriptor_subfield (desc, dim, LBOUND_SUBFIELD);
369 gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 369, __FUNCTION__))->typed.type) == gfc_array_index_type
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 369, __FUNCTION__), 0 : 0))
;
370 return field;
371}
372
373tree
374gfc_conv_descriptor_lbound_get (tree desc, tree dim)
375{
376 return gfc_conv_descriptor_lbound (desc, dim);
377}
378
379void
380gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
381 tree dim, tree value)
382{
383 tree t = gfc_conv_descriptor_lbound (desc, dim);
384 gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 384, __FUNCTION__))->typed.type), value)
);
385}
386
387static tree
388gfc_conv_descriptor_ubound (tree desc, tree dim)
389{
390 tree field = gfc_conv_descriptor_subfield (desc, dim, UBOUND_SUBFIELD);
391 gcc_assert (TREE_TYPE (field) == gfc_array_index_type)((void)(!(((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 391, __FUNCTION__))->typed.type) == gfc_array_index_type
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 391, __FUNCTION__), 0 : 0))
;
392 return field;
393}
394
395tree
396gfc_conv_descriptor_ubound_get (tree desc, tree dim)
397{
398 return gfc_conv_descriptor_ubound (desc, dim);
399}
400
401void
402gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
403 tree dim, tree value)
404{
405 tree t = gfc_conv_descriptor_ubound (desc, dim);
406 gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 406, __FUNCTION__))->typed.type), value)
);
407}
408
409/* Build a null array descriptor constructor. */
410
411tree
412gfc_build_null_descriptor (tree type)
413{
414 tree field;
415 tree tmp;
416
417 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 417, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 417, __FUNCTION__), 0 : 0))
;
418 gcc_assert (DATA_FIELD == 0)((void)(!(DATA_FIELD == 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 418, __FUNCTION__), 0 : 0))
;
419 field = TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 419, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
;
420
421 /* Set a NULL data pointer. */
422 tmp = build_constructor_single (type, field, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
423 TREE_CONSTANT (tmp)((non_type_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 423, __FUNCTION__))->base.constant_flag)
= 1;
424 /* All other fields are ignored. */
425
426 return tmp;
427}
428
429
430/* Modify a descriptor such that the lbound of a given dimension is the value
431 specified. This also updates ubound and offset accordingly. */
432
433void
434gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
435 int dim, tree new_lbound)
436{
437 tree offs, ubound, lbound, stride;
438 tree diff, offs_diff;
439
440 new_lbound = fold_convert (gfc_array_index_type, new_lbound)fold_convert_loc (((location_t) 0), gfc_array_index_type, new_lbound
)
;
441
442 offs = gfc_conv_descriptor_offset_get (desc);
443 lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
444 ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
445 stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
446
447 /* Get difference (new - old) by which to shift stuff. */
448 diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
449 new_lbound, lbound);
450
451 /* Shift ubound and offset accordingly. This has to be done before
452 updating the lbound, as they depend on the lbound expression! */
453 ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
454 ubound, diff);
455 gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
456 offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
457 diff, stride);
458 offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
459 offs, offs_diff);
460 gfc_conv_descriptor_offset_set (block, desc, offs);
461
462 /* Finally set lbound to value we want. */
463 gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
464}
465
466
467/* Obtain offsets for trans-types.c(gfc_get_array_descr_info). */
468
469void
470gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off,
471 tree *dtype_off, tree *span_off,
472 tree *dim_off, tree *dim_size,
473 tree *stride_suboff, tree *lower_suboff,
474 tree *upper_suboff)
475{
476 tree field;
477 tree type;
478
479 type = TYPE_MAIN_VARIANT (desc_type)((tree_class_check ((desc_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 479, __FUNCTION__))->type_common.main_variant)
;
480 field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 480, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, DATA_FIELD);
481 *data_off = byte_position (field);
482 field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 482, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, DTYPE_FIELD);
483 *dtype_off = byte_position (field);
484 field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 484, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, SPAN_FIELD);
485 *span_off = byte_position (field);
486 field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 486, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, DIMENSION_FIELD);
487 *dim_off = byte_position (field);
488 type = TREE_TYPE (TREE_TYPE (field))((contains_struct_check ((((contains_struct_check ((field), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 488, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 488, __FUNCTION__))->typed.type)
;
489 *dim_size = TYPE_SIZE_UNIT (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 489, __FUNCTION__))->type_common.size_unit)
;
490 field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 490, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, STRIDE_SUBFIELD);
491 *stride_suboff = byte_position (field);
492 field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 492, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, LBOUND_SUBFIELD);
493 *lower_suboff = byte_position (field);
494 field = gfc_advance_chain (TYPE_FIELDS (type)((tree_check3 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 494, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, UBOUND_SUBFIELD);
495 *upper_suboff = byte_position (field);
496}
497
498
499/* Cleanup those #defines. */
500
501#undef DATA_FIELD
502#undef OFFSET_FIELD
503#undef DTYPE_FIELD
504#undef SPAN_FIELD
505#undef DIMENSION_FIELD
506#undef CAF_TOKEN_FIELD
507#undef STRIDE_SUBFIELD
508#undef LBOUND_SUBFIELD
509#undef UBOUND_SUBFIELD
510
511
512/* Mark a SS chain as used. Flags specifies in which loops the SS is used.
513 flags & 1 = Main loop body.
514 flags & 2 = temp copy loop. */
515
516void
517gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags)
518{
519 for (; ss != gfc_ss_terminator; ss = ss->next)
520 ss->info->useflags = flags;
521}
522
523
524/* Free a gfc_ss chain. */
525
526void
527gfc_free_ss_chain (gfc_ss * ss)
528{
529 gfc_ss *next;
530
531 while (ss != gfc_ss_terminator)
532 {
533 gcc_assert (ss != NULL)((void)(!(ss != __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 533, __FUNCTION__), 0 : 0))
;
534 next = ss->next;
535 gfc_free_ss (ss);
536 ss = next;
537 }
538}
539
540
541static void
542free_ss_info (gfc_ss_info *ss_info)
543{
544 int n;
545
546 ss_info->refcount--;
547 if (ss_info->refcount > 0)
548 return;
549
550 gcc_assert (ss_info->refcount == 0)((void)(!(ss_info->refcount == 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 550, __FUNCTION__), 0 : 0))
;
551
552 switch (ss_info->type)
553 {
554 case GFC_SS_SECTION:
555 for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
556 if (ss_info->data.array.subscript[n])
557 gfc_free_ss_chain (ss_info->data.array.subscript[n]);
558 break;
559
560 default:
561 break;
562 }
563
564 free (ss_info);
565}
566
567
568/* Free a SS. */
569
570void
571gfc_free_ss (gfc_ss * ss)
572{
573 free_ss_info (ss->info);
574 free (ss);
575}
576
577
578/* Creates and initializes an array type gfc_ss struct. */
579
580gfc_ss *
581gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type)
582{
583 gfc_ss *ss;
584 gfc_ss_info *ss_info;
585 int i;
586
587 ss_info = gfc_get_ss_info ()((gfc_ss_info *) xcalloc (1, sizeof (gfc_ss_info)));
588 ss_info->refcount++;
589 ss_info->type = type;
590 ss_info->expr = expr;
591
592 ss = gfc_get_ss ()((gfc_ss *) xcalloc (1, sizeof (gfc_ss)));
593 ss->info = ss_info;
594 ss->next = next;
595 ss->dimen = dimen;
596 for (i = 0; i < ss->dimen; i++)
597 ss->dim[i] = i;
598
599 return ss;
600}
601
602
603/* Creates and initializes a temporary type gfc_ss struct. */
604
605gfc_ss *
606gfc_get_temp_ss (tree type, tree string_length, int dimen)
607{
608 gfc_ss *ss;
609 gfc_ss_info *ss_info;
610 int i;
611
612 ss_info = gfc_get_ss_info ()((gfc_ss_info *) xcalloc (1, sizeof (gfc_ss_info)));
613 ss_info->refcount++;
614 ss_info->type = GFC_SS_TEMP;
615 ss_info->string_length = string_length;
616 ss_info->data.temp.type = type;
617
618 ss = gfc_get_ss ()((gfc_ss *) xcalloc (1, sizeof (gfc_ss)));
619 ss->info = ss_info;
620 ss->next = gfc_ss_terminator;
621 ss->dimen = dimen;
622 for (i = 0; i < ss->dimen; i++)
623 ss->dim[i] = i;
624
625 return ss;
626}
627
628
629/* Creates and initializes a scalar type gfc_ss struct. */
630
631gfc_ss *
632gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr)
633{
634 gfc_ss *ss;
635 gfc_ss_info *ss_info;
636
637 ss_info = gfc_get_ss_info ()((gfc_ss_info *) xcalloc (1, sizeof (gfc_ss_info)));
638 ss_info->refcount++;
639 ss_info->type = GFC_SS_SCALAR;
640 ss_info->expr = expr;
641
642 ss = gfc_get_ss ()((gfc_ss *) xcalloc (1, sizeof (gfc_ss)));
643 ss->info = ss_info;
644 ss->next = next;
645
646 return ss;
647}
648
649
650/* Free all the SS associated with a loop. */
651
652void
653gfc_cleanup_loop (gfc_loopinfo * loop)
654{
655 gfc_loopinfo *loop_next, **ploop;
656 gfc_ss *ss;
657 gfc_ss *next;
658
659 ss = loop->ss;
660 while (ss != gfc_ss_terminator)
661 {
662 gcc_assert (ss != NULL)((void)(!(ss != __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 662, __FUNCTION__), 0 : 0))
;
663 next = ss->loop_chain;
664 gfc_free_ss (ss);
665 ss = next;
666 }
667
668 /* Remove reference to self in the parent loop. */
669 if (loop->parent)
670 for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next)
671 if (*ploop == loop)
672 {
673 *ploop = loop->next;
674 break;
675 }
676
677 /* Free non-freed nested loops. */
678 for (loop = loop->nested; loop; loop = loop_next)
679 {
680 loop_next = loop->next;
681 gfc_cleanup_loop (loop);
682 free (loop);
683 }
684}
685
686
687static void
688set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop)
689{
690 int n;
691
692 for (; ss != gfc_ss_terminator; ss = ss->next)
693 {
694 ss->loop = loop;
695
696 if (ss->info->type == GFC_SS_SCALAR
697 || ss->info->type == GFC_SS_REFERENCE
698 || ss->info->type == GFC_SS_TEMP)
699 continue;
700
701 for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
702 if (ss->info->data.array.subscript[n] != NULL__null)
703 set_ss_loop (ss->info->data.array.subscript[n], loop);
704 }
705}
706
707
708/* Associate a SS chain with a loop. */
709
710void
711gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
712{
713 gfc_ss *ss;
714 gfc_loopinfo *nested_loop;
715
716 if (head == gfc_ss_terminator)
717 return;
718
719 set_ss_loop (head, loop);
720
721 ss = head;
722 for (; ss && ss != gfc_ss_terminator; ss = ss->next)
723 {
724 if (ss->nested_ss)
725 {
726 nested_loop = ss->nested_ss->loop;
727
728 /* More than one ss can belong to the same loop. Hence, we add the
729 loop to the chain only if it is different from the previously
730 added one, to avoid duplicate nested loops. */
731 if (nested_loop != loop->nested)
732 {
733 gcc_assert (nested_loop->parent == NULL)((void)(!(nested_loop->parent == __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 733, __FUNCTION__), 0 : 0))
;
734 nested_loop->parent = loop;
735
736 gcc_assert (nested_loop->next == NULL)((void)(!(nested_loop->next == __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 736, __FUNCTION__), 0 : 0))
;
737 nested_loop->next = loop->nested;
738 loop->nested = nested_loop;
739 }
740 else
741 gcc_assert (nested_loop->parent == loop)((void)(!(nested_loop->parent == loop) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 741, __FUNCTION__), 0 : 0))
;
742 }
743
744 if (ss->next == gfc_ss_terminator)
745 ss->loop_chain = loop->ss;
746 else
747 ss->loop_chain = ss->next;
748 }
749 gcc_assert (ss == gfc_ss_terminator)((void)(!(ss == gfc_ss_terminator) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 749, __FUNCTION__), 0 : 0))
;
750 loop->ss = head;
751}
752
753
754/* Returns true if the expression is an array pointer. */
755
756static bool
757is_pointer_array (tree expr)
758{
759 if (expr == NULL_TREE(tree) __null
760 || !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (expr))((tree_class_check ((((contains_struct_check ((expr), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 760, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 760, __FUNCTION__))->type_common.lang_flag_1)
761 || GFC_CLASS_TYPE_P (TREE_TYPE (expr))((tree_class_check ((((contains_struct_check ((expr), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 761, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 761, __FUNCTION__))->type_common.lang_flag_4)
)
762 return false;
763
764 if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == VAR_DECL
765 && GFC_DECL_PTR_ARRAY_P (expr)((contains_struct_check ((expr), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 765, __FUNCTION__))->decl_common.lang_flag_6)
)
766 return true;
767
768 if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == PARM_DECL
769 && GFC_DECL_PTR_ARRAY_P (expr)((contains_struct_check ((expr), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 769, __FUNCTION__))->decl_common.lang_flag_6)
)
770 return true;
771
772 if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == INDIRECT_REF
773 && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 0))((contains_struct_check (((*((const_cast<tree*> (tree_operand_check
((expr), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 773, __FUNCTION__)))))), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 773, __FUNCTION__))->decl_common.lang_flag_6)
)
774 return true;
775
776 /* The field declaration is marked as an pointer array. */
777 if (TREE_CODE (expr)((enum tree_code) (expr)->base.code) == COMPONENT_REF
778 && GFC_DECL_PTR_ARRAY_P (TREE_OPERAND (expr, 1))((contains_struct_check (((*((const_cast<tree*> (tree_operand_check
((expr), (1), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 778, __FUNCTION__)))))), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 778, __FUNCTION__))->decl_common.lang_flag_6)
779 && !GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (expr, 1)))((tree_class_check ((((contains_struct_check (((*((const_cast
<tree*> (tree_operand_check ((expr), (1), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 779, __FUNCTION__)))))), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 779, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 779, __FUNCTION__))->type_common.lang_flag_4)
)
780 return true;
781
782 return false;
783}
784
785
786/* If the symbol or expression reference a CFI descriptor, return the
787 pointer to the converted gfc descriptor. If an array reference is
788 present as the last argument, check that it is the one applied to
789 the CFI descriptor in the expression. Note that the CFI object is
790 always the symbol in the expression! */
791
792static bool
793get_CFI_desc (gfc_symbol *sym, gfc_expr *expr,
794 tree *desc, gfc_array_ref *ar)
795{
796 tree tmp;
797
798 if (!is_CFI_desc (sym, expr))
799 return false;
800
801 if (expr && ar)
802 {
803 if (!(expr->ref && expr->ref->type == REF_ARRAY)
804 || (&expr->ref->u.ar != ar))
805 return false;
806 }
807
808 if (sym == NULL__null)
809 tmp = expr->symtree->n.sym->backend_decl;
810 else
811 tmp = sym->backend_decl;
812
813 if (tmp && DECL_LANG_SPECIFIC (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 813, __FUNCTION__))->decl_common.lang_specific)
&& GFC_DECL_SAVED_DESCRIPTOR (tmp)(((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 813, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
)
814 tmp = GFC_DECL_SAVED_DESCRIPTOR (tmp)(((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 814, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
;
815
816 *desc = tmp;
817 return true;
818}
819
820
821/* Return the span of an array. */
822
823tree
824gfc_get_array_span (tree desc, gfc_expr *expr)
825{
826 tree tmp;
827
828 if (is_pointer_array (desc) || get_CFI_desc (NULL__null, expr, &desc, NULL__null))
829 {
830 if (POINTER_TYPE_P (TREE_TYPE (desc))(((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 830, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 830, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)
)
831 desc = build_fold_indirect_ref_loc (input_location, desc);
832
833 /* This will have the span field set. */
834 tmp = gfc_conv_descriptor_span_get (desc);
835 }
836 else if (TREE_CODE (desc)((enum tree_code) (desc)->base.code) == COMPONENT_REF
837 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 837, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 837, __FUNCTION__))->type_common.lang_flag_1)
838 && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (desc, 0)))((tree_class_check ((((contains_struct_check (((*((const_cast
<tree*> (tree_operand_check ((desc), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 838, __FUNCTION__)))))), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 838, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 838, __FUNCTION__))->type_common.lang_flag_4)
)
839 {
840 /* The descriptor is a class _data field and so use the vtable
841 size for the receiving span field. */
842 tmp = gfc_get_vptr_from_expr (desc);
843 tmp = gfc_vptr_size_get (tmp);
844 }
845 else if (expr && expr->expr_type == EXPR_VARIABLE
846 && expr->symtree->n.sym->ts.type == BT_CLASS
847 && expr->ref->type == REF_COMPONENT
848 && expr->ref->next->type == REF_ARRAY
849 && expr->ref->next->next == NULL__null
850 && CLASS_DATA (expr->symtree->n.sym)expr->symtree->n.sym->ts.u.derived->components->attr.dimension)
851 {
852 /* Dummys come in sometimes with the descriptor detached from
853 the class field or declaration. */
854 tmp = gfc_class_vptr_get (expr->symtree->n.sym->backend_decl);
855 tmp = gfc_vptr_size_get (tmp);
856 }
857 else
858 {
859 /* If none of the fancy stuff works, the span is the element
860 size of the array. Attempt to deal with unbounded character
861 types if possible. Otherwise, return NULL_TREE. */
862 tmp = gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 862, __FUNCTION__))->typed.type)
);
863 if (tmp && TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == ARRAY_TYPE
864 && (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp))((tree_check5 ((((tree_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 864, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 864, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
== NULL_TREE(tree) __null
865 || integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp))((tree_check5 ((((tree_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 865, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 865, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
)))
866 {
867 if (expr->expr_type == EXPR_VARIABLE
868 && expr->ts.type == BT_CHARACTER)
869 tmp = fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, gfc_get_expr_charlen
(expr))
870 gfc_get_expr_charlen (expr))fold_convert_loc (((location_t) 0), gfc_array_index_type, gfc_get_expr_charlen
(expr))
;
871 else
872 tmp = NULL_TREE(tree) __null;
873 }
874 else
875 tmp = fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, size_in_bytes
(tmp))
876 size_in_bytes (tmp))fold_convert_loc (((location_t) 0), gfc_array_index_type, size_in_bytes
(tmp))
;
877 }
878 return tmp;
879}
880
881
882/* Generate an initializer for a static pointer or allocatable array. */
883
884void
885gfc_trans_static_array_pointer (gfc_symbol * sym)
886{
887 tree type;
888
889 gcc_assert (TREE_STATIC (sym->backend_decl))((void)(!(((sym->backend_decl)->base.static_flag)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 889, __FUNCTION__), 0 : 0))
;
890 /* Just zero the data member. */
891 type = TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 891, __FUNCTION__))->typed.type)
;
892 DECL_INITIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 892, __FUNCTION__))->decl_common.initial)
= gfc_build_null_descriptor (type);
893}
894
895
896/* If the bounds of SE's loop have not yet been set, see if they can be
897 determined from array spec AS, which is the array spec of a called
898 function. MAPPING maps the callee's dummy arguments to the values
899 that the caller is passing. Add any initialization and finalization
900 code to SE. */
901
902void
903gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
904 gfc_se * se, gfc_array_spec * as)
905{
906 int n, dim, total_dim;
907 gfc_se tmpse;
908 gfc_ss *ss;
909 tree lower;
910 tree upper;
911 tree tmp;
912
913 total_dim = 0;
914
915 if (!as || as->type != AS_EXPLICIT)
916 return;
917
918 for (ss = se->ss; ss; ss = ss->parent)
919 {
920 total_dim += ss->loop->dimen;
921 for (n = 0; n < ss->loop->dimen; n++)
922 {
923 /* The bound is known, nothing to do. */
924 if (ss->loop->to[n] != NULL_TREE(tree) __null)
925 continue;
926
927 dim = ss->dim[n];
928 gcc_assert (dim < as->rank)((void)(!(dim < as->rank) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 928, __FUNCTION__), 0 : 0))
;
929 gcc_assert (ss->loop->dimen <= as->rank)((void)(!(ss->loop->dimen <= as->rank) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 929, __FUNCTION__), 0 : 0))
;
930
931 /* Evaluate the lower bound. */
932 gfc_init_se (&tmpse, NULL__null);
933 gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
934 gfc_add_block_to_block (&se->pre, &tmpse.pre);
935 gfc_add_block_to_block (&se->post, &tmpse.post);
936 lower = fold_convert (gfc_array_index_type, tmpse.expr)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmpse
.expr)
;
937
938 /* ...and the upper bound. */
939 gfc_init_se (&tmpse, NULL__null);
940 gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
941 gfc_add_block_to_block (&se->pre, &tmpse.pre);
942 gfc_add_block_to_block (&se->post, &tmpse.post);
943 upper = fold_convert (gfc_array_index_type, tmpse.expr)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmpse
.expr)
;
944
945 /* Set the upper bound of the loop to UPPER - LOWER. */
946 tmp = fold_build2_loc (input_location, MINUS_EXPR,
947 gfc_array_index_type, upper, lower);
948 tmp = gfc_evaluate_now (tmp, &se->pre);
949 ss->loop->to[n] = tmp;
950 }
951 }
952
953 gcc_assert (total_dim == as->rank)((void)(!(total_dim == as->rank) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 953, __FUNCTION__), 0 : 0))
;
954}
955
956
957/* Generate code to allocate an array temporary, or create a variable to
958 hold the data. If size is NULL, zero the descriptor so that the
959 callee will allocate the array. If DEALLOC is true, also generate code to
960 free the array afterwards.
961
962 If INITIAL is not NULL, it is packed using internal_pack and the result used
963 as data instead of allocating a fresh, unitialized area of memory.
964
965 Initialization code is added to PRE and finalization code to POST.
966 DYNAMIC is true if the caller may want to extend the array later
967 using realloc. This prevents us from putting the array on the stack. */
968
969static void
970gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
971 gfc_array_info * info, tree size, tree nelem,
972 tree initial, bool dynamic, bool dealloc)
973{
974 tree tmp;
975 tree desc;
976 bool onstack;
977
978 desc = info->descriptor;
979 info->offset = gfc_index_zero_nodegfc_rank_cst[0];
980 if (size == NULL_TREE(tree) __null || integer_zerop (size))
981 {
982 /* A callee allocated array. */
983 gfc_conv_descriptor_data_set (pre, desc, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
984 onstack = FALSEfalse;
985 }
986 else
987 {
988 /* Allocate the temporary. */
989 onstack = !dynamic && initial == NULL_TREE(tree) __null
990 && (flag_stack_arraysglobal_options.x_flag_stack_arrays
991 || gfc_can_put_var_on_stack (size));
992
993 if (onstack)
994 {
995 /* Make a temporary variable to hold the data. */
996 tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (nelem)((contains_struct_check ((nelem), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 996, __FUNCTION__))->typed.type)
,
997 nelem, gfc_index_one_nodegfc_rank_cst[1]);
998 tmp = gfc_evaluate_now (tmp, pre);
999 tmp = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
1000 tmp);
1001 tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1001, __FUNCTION__))->typed.type)
),
1002 tmp);
1003 tmp = gfc_create_var (tmp, "A");
1004 /* If we're here only because of -fstack-arrays we have to
1005 emit a DECL_EXPR to make the gimplifier emit alloca calls. */
1006 if (!gfc_can_put_var_on_stack (size))
1007 gfc_add_expr_to_block (pre,
1008 fold_build1_loc (input_location,
1009 DECL_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1009, __FUNCTION__))->typed.type)
,
1010 tmp));
1011 tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
1012 gfc_conv_descriptor_data_set (pre, desc, tmp);
1013 }
1014 else
1015 {
1016 /* Allocate memory to hold the data or call internal_pack. */
1017 if (initial == NULL_TREE(tree) __null)
1018 {
1019 tmp = gfc_call_malloc (pre, NULL__null, size);
1020 tmp = gfc_evaluate_now (tmp, pre);
1021 }
1022 else
1023 {
1024 tree packed;
1025 tree source_data;
1026 tree was_packed;
1027 stmtblock_t do_copying;
1028
1029 tmp = TREE_TYPE (initial)((contains_struct_check ((initial), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1029, __FUNCTION__))->typed.type)
; /* Pointer to descriptor. */
1030 gcc_assert (TREE_CODE (tmp) == POINTER_TYPE)((void)(!(((enum tree_code) (tmp)->base.code) == POINTER_TYPE
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1030, __FUNCTION__), 0 : 0))
;
1031 tmp = TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1031, __FUNCTION__))->typed.type)
; /* The descriptor itself. */
1032 tmp = gfc_get_element_type (tmp);
1033 packed = gfc_create_var (build_pointer_type (tmp), "data");
1034
1035 tmp = build_call_expr_loc (input_location,
1036 gfor_fndecl_in_pack, 1, initial);
1037 tmp = fold_convert (TREE_TYPE (packed), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(packed), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1037, __FUNCTION__))->typed.type), tmp)
;
1038 gfc_add_modify (pre, packed, tmp);
1039
1040 tmp = build_fold_indirect_ref_loc (input_location,
1041 initial);
1042 source_data = gfc_conv_descriptor_data_get (tmp);
1043
1044 /* internal_pack may return source->data without any allocation
1045 or copying if it is already packed. If that's the case, we
1046 need to allocate and copy manually. */
1047
1048 gfc_start_block (&do_copying);
1049 tmp = gfc_call_malloc (&do_copying, NULL__null, size);
1050 tmp = fold_convert (TREE_TYPE (packed), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(packed), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1050, __FUNCTION__))->typed.type), tmp)
;
1051 gfc_add_modify (&do_copying, packed, tmp);
1052 tmp = gfc_build_memcpy_call (packed, source_data, size);
1053 gfc_add_expr_to_block (&do_copying, tmp);
1054
1055 was_packed = fold_build2_loc (input_location, EQ_EXPR,
1056 logical_type_node, packed,
1057 source_data);
1058 tmp = gfc_finish_block (&do_copying);
1059 tmp = build3_v (COND_EXPR, was_packed, tmp,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], was_packed, tmp, build_empty_stmt (input_location))
1060 build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], was_packed, tmp, build_empty_stmt (input_location))
;
1061 gfc_add_expr_to_block (pre, tmp);
1062
1063 tmp = fold_convert (pvoid_type_node, packed)fold_convert_loc (((location_t) 0), pvoid_type_node, packed);
1064 }
1065
1066 gfc_conv_descriptor_data_set (pre, desc, tmp);
1067 }
1068 }
1069 info->data = gfc_conv_descriptor_data_get (desc);
1070
1071 /* The offset is zero because we create temporaries with a zero
1072 lower bound. */
1073 gfc_conv_descriptor_offset_set (pre, desc, gfc_index_zero_nodegfc_rank_cst[0]);
1074
1075 if (dealloc && !onstack)
1076 {
1077 /* Free the temporary. */
1078 tmp = gfc_conv_descriptor_data_get (desc);
1079 tmp = gfc_call_free (tmp);
1080 gfc_add_expr_to_block (post, tmp);
1081 }
1082}
1083
1084
1085/* Get the scalarizer array dimension corresponding to actual array dimension
1086 given by ARRAY_DIM.
1087
1088 For example, if SS represents the array ref a(1,:,:,1), it is a
1089 bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1,
1090 and 1 for ARRAY_DIM=2.
1091 If SS represents transpose(a(:,1,1,:)), it is again a bidimensional
1092 scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for
1093 ARRAY_DIM=3.
1094 If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer
1095 array. If called on the inner ss, the result would be respectively 0,1,2 for
1096 ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1
1097 for ARRAY_DIM=1,2. */
1098
1099static int
1100get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim)
1101{
1102 int array_ref_dim;
1103 int n;
1104
1105 array_ref_dim = 0;
1106
1107 for (; ss; ss = ss->parent)
1108 for (n = 0; n < ss->dimen; n++)
1109 if (ss->dim[n] < array_dim)
1110 array_ref_dim++;
1111
1112 return array_ref_dim;
1113}
1114
1115
1116static gfc_ss *
1117innermost_ss (gfc_ss *ss)
1118{
1119 while (ss->nested_ss != NULL__null)
1120 ss = ss->nested_ss;
1121
1122 return ss;
1123}
1124
1125
1126
1127/* Get the array reference dimension corresponding to the given loop dimension.
1128 It is different from the true array dimension given by the dim array in
1129 the case of a partial array reference (i.e. a(:,:,1,:) for example)
1130 It is different from the loop dimension in the case of a transposed array.
1131 */
1132
1133static int
1134get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
1135{
1136 return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
1137 ss->dim[loop_dim]);
1138}
1139
1140
1141/* Use the information in the ss to obtain the required information about
1142 the type and size of an array temporary, when the lhs in an assignment
1143 is a class expression. */
1144
1145static tree
1146get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss, tree *eltype)
1147{
1148 gfc_ss *lhs_ss;
1149 gfc_ss *rhs_ss;
1150 tree tmp;
1151 tree tmp2;
1152 tree vptr;
1153 tree rhs_class_expr = NULL_TREE(tree) __null;
1154 tree lhs_class_expr = NULL_TREE(tree) __null;
1155 bool unlimited_rhs = false;
1156 bool unlimited_lhs = false;
1157 bool rhs_function = false;
1158 gfc_symbol *vtab;
1159
1160 /* The second element in the loop chain contains the source for the
1161 temporary; ie. the rhs of the assignment. */
1162 rhs_ss = ss->loop->ss->loop_chain;
1163
1164 if (rhs_ss != gfc_ss_terminator
1165 && rhs_ss->info
1166 && rhs_ss->info->expr
1167 && rhs_ss->info->expr->ts.type == BT_CLASS
1168 && rhs_ss->info->data.array.descriptor)
1169 {
1170 rhs_class_expr
1171 = gfc_get_class_from_expr (rhs_ss->info->data.array.descriptor);
1172 unlimited_rhs = UNLIMITED_POLY (rhs_ss->info->expr)(rhs_ss->info->expr != __null && rhs_ss->info
->expr->ts.type == BT_CLASS && rhs_ss->info->
expr->ts.u.derived->components && rhs_ss->info
->expr->ts.u.derived->components->ts.u.derived &&
rhs_ss->info->expr->ts.u.derived->components->
ts.u.derived->attr.unlimited_polymorphic)
;
1173 if (rhs_ss->info->expr->expr_type == EXPR_FUNCTION)
1174 rhs_function = true;
1175 }
1176
1177 /* For an assignment the lhs is the next element in the loop chain.
1178 If we have a class rhs, this had better be a class variable
1179 expression! */
1180 lhs_ss = rhs_ss->loop_chain;
1181 if (lhs_ss != gfc_ss_terminator
1182 && lhs_ss->info
1183 && lhs_ss->info->expr
1184 && lhs_ss->info->expr->expr_type ==EXPR_VARIABLE
1185 && lhs_ss->info->expr->ts.type == BT_CLASS)
1186 {
1187 tmp = lhs_ss->info->data.array.descriptor;
1188 unlimited_lhs = UNLIMITED_POLY (rhs_ss->info->expr)(rhs_ss->info->expr != __null && rhs_ss->info
->expr->ts.type == BT_CLASS && rhs_ss->info->
expr->ts.u.derived->components && rhs_ss->info
->expr->ts.u.derived->components->ts.u.derived &&
rhs_ss->info->expr->ts.u.derived->components->
ts.u.derived->attr.unlimited_polymorphic)
;
1189 }
1190 else
1191 tmp = NULL_TREE(tree) __null;
1192
1193 /* Get the lhs class expression. */
1194 if (tmp != NULL_TREE(tree) __null && lhs_ss->loop_chain == gfc_ss_terminator)
1195 lhs_class_expr = gfc_get_class_from_expr (tmp);
1196 else
1197 return rhs_class_expr;
1198
1199 gcc_assert (GFC_CLASS_TYPE_P (TREE_TYPE (lhs_class_expr)))((void)(!(((tree_class_check ((((contains_struct_check ((lhs_class_expr
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1199, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1199, __FUNCTION__))->type_common.lang_flag_4)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1199, __FUNCTION__), 0 : 0))
;
1200
1201 /* Set the lhs vptr and, if necessary, the _len field. */
1202 if (rhs_class_expr)
1203 {
1204 /* Both lhs and rhs are class expressions. */
1205 tmp = gfc_class_vptr_get (lhs_class_expr);
1206 gfc_add_modify (pre, tmp,
1207 fold_convert (TREE_TYPE (tmp),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1207, __FUNCTION__))->typed.type), gfc_class_vptr_get (rhs_class_expr
))
1208 gfc_class_vptr_get (rhs_class_expr))fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1207, __FUNCTION__))->typed.type), gfc_class_vptr_get (rhs_class_expr
))
);
1209 if (unlimited_lhs)
1210 {
1211 tmp = gfc_class_len_get (lhs_class_expr);
1212 if (unlimited_rhs)
1213 tmp2 = gfc_class_len_get (rhs_class_expr);
1214 else
1215 tmp2 = build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1215, __FUNCTION__))->typed.type)
, 0);
1216 gfc_add_modify (pre, tmp, tmp2);
1217 }
1218
1219 if (rhs_function)
1220 {
1221 tmp = gfc_class_data_get (rhs_class_expr);
1222 gfc_conv_descriptor_offset_set (pre, tmp, gfc_index_zero_nodegfc_rank_cst[0]);
1223 }
1224 }
1225 else
1226 {
1227 /* lhs is class and rhs is intrinsic or derived type. */
1228 *eltype = TREE_TYPE (rhs_ss->info->data.array.descriptor)((contains_struct_check ((rhs_ss->info->data.array.descriptor
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1228, __FUNCTION__))->typed.type)
;
1229 *eltype = gfc_get_element_type (*eltype);
1230 vtab = gfc_find_vtab (&rhs_ss->info->expr->ts);
1231 vptr = vtab->backend_decl;
1232 if (vptr == NULL_TREE(tree) __null)
1233 vptr = gfc_get_symbol_decl (vtab);
1234 vptr = gfc_build_addr_expr (NULL_TREE(tree) __null, vptr);
1235 tmp = gfc_class_vptr_get (lhs_class_expr);
1236 gfc_add_modify (pre, tmp,
1237 fold_convert (TREE_TYPE (tmp), vptr)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1237, __FUNCTION__))->typed.type), vptr)
);
1238
1239 if (unlimited_lhs)
1240 {
1241 tmp = gfc_class_len_get (lhs_class_expr);
1242 if (rhs_ss->info
1243 && rhs_ss->info->expr
1244 && rhs_ss->info->expr->ts.type == BT_CHARACTER)
1245 tmp2 = build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1245, __FUNCTION__))->typed.type)
,
1246 rhs_ss->info->expr->ts.kind);
1247 else
1248 tmp2 = build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1248, __FUNCTION__))->typed.type)
, 0);
1249 gfc_add_modify (pre, tmp, tmp2);
1250 }
1251 }
1252
1253 return rhs_class_expr;
1254}
1255
1256
1257
1258/* Generate code to create and initialize the descriptor for a temporary
1259 array. This is used for both temporaries needed by the scalarizer, and
1260 functions returning arrays. Adjusts the loop variables to be
1261 zero-based, and calculates the loop bounds for callee allocated arrays.
1262 Allocate the array unless it's callee allocated (we have a callee
1263 allocated array if 'callee_alloc' is true, or if loop->to[n] is
1264 NULL_TREE for any n). Also fills in the descriptor, data and offset
1265 fields of info if known. Returns the size of the array, or NULL for a
1266 callee allocated array.
1267
1268 'eltype' == NULL signals that the temporary should be a class object.
1269 The 'initial' expression is used to obtain the size of the dynamic
1270 type; otherwise the allocation and initialization proceeds as for any
1271 other expression
1272
1273 PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
1274 gfc_trans_allocate_array_storage. */
1275
1276tree
1277gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
1278 tree eltype, tree initial, bool dynamic,
1279 bool dealloc, bool callee_alloc, locus * where)
1280{
1281 gfc_loopinfo *loop;
1282 gfc_ss *s;
1283 gfc_array_info *info;
1284 tree from[GFC_MAX_DIMENSIONS15], to[GFC_MAX_DIMENSIONS15];
1285 tree type;
1286 tree desc;
1287 tree tmp;
1288 tree size;
1289 tree nelem;
1290 tree cond;
1291 tree or_expr;
1292 tree elemsize;
1293 tree class_expr = NULL_TREE(tree) __null;
1294 int n, dim, tmp_dim;
1295 int total_dim = 0;
1296
1297 /* This signals a class array for which we need the size of the
1298 dynamic type. Generate an eltype and then the class expression. */
1299 if (eltype == NULL_TREE(tree) __null && initial)
1300 {
1301 gcc_assert (POINTER_TYPE_P (TREE_TYPE (initial)))((void)(!((((enum tree_code) (((contains_struct_check ((initial
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1301, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((initial), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1301, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1301, __FUNCTION__), 0 : 0))
;
1302 class_expr = build_fold_indirect_ref_loc (input_location, initial);
1303 /* Obtain the structure (class) expression. */
1304 class_expr = gfc_get_class_from_expr (class_expr);
1305 gcc_assert (class_expr)((void)(!(class_expr) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1305, __FUNCTION__), 0 : 0))
;
1306 }
1307
1308 /* Otherwise, some expressions, such as class functions, arising from
1309 dependency checking in assignments come here with class element type.
1310 The descriptor can be obtained from the ss->info and then converted
1311 to the class object. */
1312 if (class_expr == NULL_TREE(tree) __null && GFC_CLASS_TYPE_P (eltype)((tree_class_check ((eltype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1312, __FUNCTION__))->type_common.lang_flag_4)
)
1313 class_expr = get_class_info_from_ss (pre, ss, &eltype);
1314
1315 /* If the dynamic type is not available, use the declared type. */
1316 if (eltype && GFC_CLASS_TYPE_P (eltype)((tree_class_check ((eltype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1316, __FUNCTION__))->type_common.lang_flag_4)
)
1317 eltype = gfc_get_element_type (TREE_TYPE (TYPE_FIELDS (eltype))((contains_struct_check ((((tree_check3 ((eltype), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1317, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1317, __FUNCTION__))->typed.type)
);
1318
1319 if (class_expr == NULL_TREE(tree) __null)
1320 elemsize = fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_class_check
((eltype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1321, __FUNCTION__))->type_common.size_unit))
1321 TYPE_SIZE_UNIT (eltype))fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_class_check
((eltype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1321, __FUNCTION__))->type_common.size_unit))
;
1322 else
1323 {
1324 /* Unlimited polymorphic entities are initialised with NULL vptr. They
1325 can be tested for by checking if the len field is present. If so
1326 test the vptr before using the vtable size. */
1327 tmp = gfc_class_vptr_get (class_expr);
1328 tmp = fold_build2_loc (input_location, NE_EXPR,
1329 logical_type_node,
1330 tmp, build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1330, __FUNCTION__))->typed.type)
, 0));
1331 elemsize = fold_build3_loc (input_location, COND_EXPR,
1332 gfc_array_index_type,
1333 tmp,
1334 gfc_class_vtab_size_get (class_expr),
1335 gfc_index_zero_nodegfc_rank_cst[0]);
1336 elemsize = gfc_evaluate_now (elemsize, pre);
1337 elemsize = gfc_resize_class_size_with_len (pre, class_expr, elemsize);
1338 /* Casting the data as a character of the dynamic length ensures that
1339 assignment of elements works when needed. */
1340 eltype = gfc_get_character_type_len (1, elemsize);
1341 }
1342
1343 memset (from, 0, sizeof (from));
1344 memset (to, 0, sizeof (to));
1345
1346 info = &ss->info->data.array;
1347
1348 gcc_assert (ss->dimen > 0)((void)(!(ss->dimen > 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1348, __FUNCTION__), 0 : 0))
;
1349 gcc_assert (ss->loop->dimen == ss->dimen)((void)(!(ss->loop->dimen == ss->dimen) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1349, __FUNCTION__), 0 : 0))
;
1350
1351 if (warn_array_temporariesglobal_options.x_warn_array_temporaries && where)
1352 gfc_warning (OPT_Warray_temporaries,
1353 "Creating array temporary at %L", where);
1354
1355 /* Set the lower bound to zero. */
1356 for (s = ss; s; s = s->parent)
1357 {
1358 loop = s->loop;
1359
1360 total_dim += loop->dimen;
1361 for (n = 0; n < loop->dimen; n++)
1362 {
1363 dim = s->dim[n];
1364
1365 /* Callee allocated arrays may not have a known bound yet. */
1366 if (loop->to[n])
1367 loop->to[n] = gfc_evaluate_now (
1368 fold_build2_loc (input_location, MINUS_EXPR,
1369 gfc_array_index_type,
1370 loop->to[n], loop->from[n]),
1371 pre);
1372 loop->from[n] = gfc_index_zero_nodegfc_rank_cst[0];
1373
1374 /* We have just changed the loop bounds, we must clear the
1375 corresponding specloop, so that delta calculation is not skipped
1376 later in gfc_set_delta. */
1377 loop->specloop[n] = NULL__null;
1378
1379 /* We are constructing the temporary's descriptor based on the loop
1380 dimensions. As the dimensions may be accessed in arbitrary order
1381 (think of transpose) the size taken from the n'th loop may not map
1382 to the n'th dimension of the array. We need to reconstruct loop
1383 infos in the right order before using it to set the descriptor
1384 bounds. */
1385 tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim);
1386 from[tmp_dim] = loop->from[n];
1387 to[tmp_dim] = loop->to[n];
1388
1389 info->delta[dim] = gfc_index_zero_nodegfc_rank_cst[0];
1390 info->start[dim] = gfc_index_zero_nodegfc_rank_cst[0];
1391 info->end[dim] = gfc_index_zero_nodegfc_rank_cst[0];
1392 info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
1393 }
1394 }
1395
1396 /* Initialize the descriptor. */
1397 type =
1398 gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1,
1399 GFC_ARRAY_UNKNOWN, true);
1400 desc = gfc_create_var (type, "atmp");
1401 GFC_DECL_PACKED_ARRAY (desc)((contains_struct_check ((desc), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1401, __FUNCTION__))->decl_common.lang_flag_0)
= 1;
1402
1403 info->descriptor = desc;
1404 size = gfc_index_one_nodegfc_rank_cst[1];
1405
1406 /* Emit a DECL_EXPR for the variable sized array type in
1407 GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
1408 sizes works correctly. */
1409 tree arraytype = TREE_TYPE (GFC_TYPE_ARRAY_DATAPTR_TYPE (type))((contains_struct_check (((((tree_class_check ((type), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1409, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1409, __FUNCTION__))->typed.type)
;
1410 if (! TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1410, __FUNCTION__))->type_common.name)
)
1411 TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1411, __FUNCTION__))->type_common.name)
= build_decl (UNKNOWN_LOCATION((location_t) 0), TYPE_DECL,
1412 NULL_TREE(tree) __null, arraytype);
1413 gfc_add_expr_to_block (pre, build1 (DECL_EXPR,
1414 arraytype, TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1414, __FUNCTION__))->type_common.name)
));
1415
1416 /* Fill in the array dtype. */
1417 tmp = gfc_conv_descriptor_dtype (desc);
1418 gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1418, __FUNCTION__))->typed.type)
));
1419
1420 /*
1421 Fill in the bounds and stride. This is a packed array, so:
1422
1423 size = 1;
1424 for (n = 0; n < rank; n++)
1425 {
1426 stride[n] = size
1427 delta = ubound[n] + 1 - lbound[n];
1428 size = size * delta;
1429 }
1430 size = size * sizeof(element);
1431 */
1432
1433 or_expr = NULL_TREE(tree) __null;
1434
1435 /* If there is at least one null loop->to[n], it is a callee allocated
1436 array. */
1437 for (n = 0; n < total_dim; n++)
1438 if (to[n] == NULL_TREE(tree) __null)
1439 {
1440 size = NULL_TREE(tree) __null;
1441 break;
1442 }
1443
1444 if (size == NULL_TREE(tree) __null)
1445 for (s = ss; s; s = s->parent)
1446 for (n = 0; n < s->loop->dimen; n++)
1447 {
1448 dim = get_scalarizer_dim_for_array_dim (ss, s->dim[n]);
1449
1450 /* For a callee allocated array express the loop bounds in terms
1451 of the descriptor fields. */
1452 tmp = fold_build2_loc (input_location,
1453 MINUS_EXPR, gfc_array_index_type,
1454 gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
1455 gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
1456 s->loop->to[n] = tmp;
1457 }
1458 else
1459 {
1460 for (n = 0; n < total_dim; n++)
1461 {
1462 /* Store the stride and bound components in the descriptor. */
1463 gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
1464
1465 gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
1466 gfc_index_zero_nodegfc_rank_cst[0]);
1467
1468 gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]);
1469
1470 tmp = fold_build2_loc (input_location, PLUS_EXPR,
1471 gfc_array_index_type,
1472 to[n], gfc_index_one_nodegfc_rank_cst[1]);
1473
1474 /* Check whether the size for this dimension is negative. */
1475 cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
1476 tmp, gfc_index_zero_nodegfc_rank_cst[0]);
1477 cond = gfc_evaluate_now (cond, pre);
1478
1479 if (n == 0)
1480 or_expr = cond;
1481 else
1482 or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
1483 logical_type_node, or_expr, cond);
1484
1485 size = fold_build2_loc (input_location, MULT_EXPR,
1486 gfc_array_index_type, size, tmp);
1487 size = gfc_evaluate_now (size, pre);
1488 }
1489 }
1490
1491 /* Get the size of the array. */
1492 if (size && !callee_alloc)
1493 {
1494 /* If or_expr is true, then the extent in at least one
1495 dimension is zero and the size is set to zero. */
1496 size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
1497 or_expr, gfc_index_zero_nodegfc_rank_cst[0], size);
1498
1499 nelem = size;
1500 size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
1501 size, elemsize);
1502 }
1503 else
1504 {
1505 nelem = size;
1506 size = NULL_TREE(tree) __null;
1507 }
1508
1509 /* Set the span. */
1510 tmp = fold_convert (gfc_array_index_type, elemsize)fold_convert_loc (((location_t) 0), gfc_array_index_type, elemsize
)
;
1511 gfc_conv_descriptor_span_set (pre, desc, tmp);
1512
1513 gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
1514 dynamic, dealloc);
1515
1516 while (ss->parent)
1517 ss = ss->parent;
1518
1519 if (ss->dimen > ss->loop->temp_dim)
1520 ss->loop->temp_dim = ss->dimen;
1521
1522 return size;
1523}
1524
1525
1526/* Return the number of iterations in a loop that starts at START,
1527 ends at END, and has step STEP. */
1528
1529static tree
1530gfc_get_iteration_count (tree start, tree end, tree step)
1531{
1532 tree tmp;
1533 tree type;
1534
1535 type = TREE_TYPE (step)((contains_struct_check ((step), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1535, __FUNCTION__))->typed.type)
;
1536 tmp = fold_build2_loc (input_location, MINUS_EXPR, type, end, start);
1537 tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR, type, tmp, step);
1538 tmp = fold_build2_loc (input_location, PLUS_EXPR, type, tmp,
1539 build_int_cst (type, 1));
1540 tmp = fold_build2_loc (input_location, MAX_EXPR, type, tmp,
1541 build_int_cst (type, 0));
1542 return fold_convert (gfc_array_index_type, tmp)fold_convert_loc (((location_t) 0), gfc_array_index_type, tmp
)
;
1543}
1544
1545
1546/* Extend the data in array DESC by EXTRA elements. */
1547
1548static void
1549gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
1550{
1551 tree arg0, arg1;
1552 tree tmp;
1553 tree size;
1554 tree ubound;
1555
1556 if (integer_zerop (extra))
1557 return;
1558
1559 ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
1560
1561 /* Add EXTRA to the upper bound. */
1562 tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
1563 ubound, extra);
1564 gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
1565
1566 /* Get the value of the current data pointer. */
1567 arg0 = gfc_conv_descriptor_data_get (desc);
1568
1569 /* Calculate the new array size. */
1570 size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)))((tree_class_check ((gfc_get_element_type (((contains_struct_check
((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1570, __FUNCTION__))->typed.type))), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1570, __FUNCTION__))->type_common.size_unit)
;
1571 tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
1572 ubound, gfc_index_one_nodegfc_rank_cst[1]);
1573 arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_nodeglobal_trees[TI_SIZE_TYPE],
1574 fold_convert (size_type_node, tmp)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE
], tmp)
,
1575 fold_convert (size_type_node, size)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE
], size)
);
1576
1577 /* Call the realloc() function. */
1578 tmp = gfc_call_realloc (pblock, arg0, arg1);
1579 gfc_conv_descriptor_data_set (pblock, desc, tmp);
1580}
1581
1582
1583/* Return true if the bounds of iterator I can only be determined
1584 at run time. */
1585
1586static inline bool
1587gfc_iterator_has_dynamic_bounds (gfc_iterator * i)
1588{
1589 return (i->start->expr_type != EXPR_CONSTANT
1590 || i->end->expr_type != EXPR_CONSTANT
1591 || i->step->expr_type != EXPR_CONSTANT);
1592}
1593
1594
1595/* Split the size of constructor element EXPR into the sum of two terms,
1596 one of which can be determined at compile time and one of which must
1597 be calculated at run time. Set *SIZE to the former and return true
1598 if the latter might be nonzero. */
1599
1600static bool
1601gfc_get_array_constructor_element_size (mpz_t * size, gfc_expr * expr)
1602{
1603 if (expr->expr_type == EXPR_ARRAY)
1604 return gfc_get_array_constructor_size (size, expr->value.constructor);
1605 else if (expr->rank > 0)
1606 {
1607 /* Calculate everything at run time. */
1608 mpz_set_ui__gmpz_set_ui (*size, 0);
1609 return true;
1610 }
1611 else
1612 {
1613 /* A single element. */
1614 mpz_set_ui__gmpz_set_ui (*size, 1);
1615 return false;
1616 }
1617}
1618
1619
1620/* Like gfc_get_array_constructor_element_size, but applied to the whole
1621 of array constructor C. */
1622
1623static bool
1624gfc_get_array_constructor_size (mpz_t * size, gfc_constructor_base base)
1625{
1626 gfc_constructor *c;
1627 gfc_iterator *i;
1628 mpz_t val;
1629 mpz_t len;
1630 bool dynamic;
1631
1632 mpz_set_ui__gmpz_set_ui (*size, 0);
1633 mpz_init__gmpz_init (len);
1634 mpz_init__gmpz_init (val);
1635
1636 dynamic = false;
1637 for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
1638 {
1639 i = c->iterator;
1640 if (i && gfc_iterator_has_dynamic_bounds (i))
1641 dynamic = true;
1642 else
1643 {
1644 dynamic |= gfc_get_array_constructor_element_size (&len, c->expr);
1645 if (i)
1646 {
1647 /* Multiply the static part of the element size by the
1648 number of iterations. */
1649 mpz_sub__gmpz_sub (val, i->end->value.integer, i->start->value.integer);
1650 mpz_fdiv_q__gmpz_fdiv_q (val, val, i->step->value.integer);
1651 mpz_add_ui__gmpz_add_ui (val, val, 1);
1652 if (mpz_sgn (val)((val)->_mp_size < 0 ? -1 : (val)->_mp_size > 0) > 0)
1653 mpz_mul__gmpz_mul (len, len, val);
1654 else
1655 mpz_set_ui__gmpz_set_ui (len, 0);
1656 }
1657 mpz_add__gmpz_add (*size, *size, len);
1658 }
1659 }
1660 mpz_clear__gmpz_clear (len);
1661 mpz_clear__gmpz_clear (val);
1662 return dynamic;
1663}
1664
1665
1666/* Make sure offset is a variable. */
1667
1668static void
1669gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset,
1670 tree * offsetvar)
1671{
1672 /* We should have already created the offset variable. We cannot
1673 create it here because we may be in an inner scope. */
1674 gcc_assert (*offsetvar != NULL_TREE)((void)(!(*offsetvar != (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1674, __FUNCTION__), 0 : 0))
;
1675 gfc_add_modify (pblock, *offsetvar, *poffset);
1676 *poffset = *offsetvar;
1677 TREE_USED (*offsetvar)((*offsetvar)->base.used_flag) = 1;
1678}
1679
1680
1681/* Variables needed for bounds-checking. */
1682static bool first_len;
1683static tree first_len_val;
1684static bool typespec_chararray_ctor;
1685
1686static void
1687gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
1688 tree offset, gfc_se * se, gfc_expr * expr)
1689{
1690 tree tmp;
1691
1692 gfc_conv_expr (se, expr);
1693
1694 /* Store the value. */
1695 tmp = build_fold_indirect_ref_loc (input_location,
1696 gfc_conv_descriptor_data_get (desc));
1697 tmp = gfc_build_array_ref (tmp, offset, NULL__null);
1698
1699 if (expr->ts.type == BT_CHARACTER)
1700 {
1701 int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
1702 tree esize;
1703
1704 esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1704, __FUNCTION__))->typed.type)
));
1705 esize = fold_convert (gfc_charlen_type_node, esize)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, esize
)
;
1706 esize = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
1707 TREE_TYPE (esize)((contains_struct_check ((esize), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1707, __FUNCTION__))->typed.type)
, esize,
1708 build_int_cst (TREE_TYPE (esize)((contains_struct_check ((esize), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1708, __FUNCTION__))->typed.type)
,
1709 gfc_character_kinds[i].bit_size / 8));
1710
1711 gfc_conv_string_parameter (se);
1712 if (POINTER_TYPE_P (TREE_TYPE (tmp))(((enum tree_code) (((contains_struct_check ((tmp), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1712, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((tmp), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1712, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)
)
1713 {
1714 /* The temporary is an array of pointers. */
1715 se->expr = fold_convert (TREE_TYPE (tmp), se->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1715, __FUNCTION__))->typed.type), se->expr)
;
1716 gfc_add_modify (&se->pre, tmp, se->expr);
1717 }
1718 else
1719 {
1720 /* The temporary is an array of string values. */
1721 tmp = gfc_build_addr_expr (gfc_get_pchar_type (expr->ts.kind), tmp);
1722 /* We know the temporary and the value will be the same length,
1723 so can use memcpy. */
1724 gfc_trans_string_copy (&se->pre, esize, tmp, expr->ts.kind,
1725 se->string_length, se->expr, expr->ts.kind);
1726 }
1727 if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0)) && !typespec_chararray_ctor)
1728 {
1729 if (first_len)
1730 {
1731 gfc_add_modify (&se->pre, first_len_val,
1732 fold_convert (TREE_TYPE (first_len_val),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(first_len_val), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1732, __FUNCTION__))->typed.type), se->string_length)
1733 se->string_length)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(first_len_val), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1732, __FUNCTION__))->typed.type), se->string_length)
);
1734 first_len = false;
1735 }
1736 else
1737 {
1738 /* Verify that all constructor elements are of the same
1739 length. */
1740 tree rhs = fold_convert (TREE_TYPE (first_len_val),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(first_len_val), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1740, __FUNCTION__))->typed.type), se->string_length)
1741 se->string_length)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(first_len_val), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1740, __FUNCTION__))->typed.type), se->string_length)
;
1742 tree cond = fold_build2_loc (input_location, NE_EXPR,
1743 logical_type_node, first_len_val,
1744 rhs);
1745 gfc_trans_runtime_check
1746 (true, false, cond, &se->pre, &expr->where,
1747 "Different CHARACTER lengths (%ld/%ld) in array constructor",
1748 fold_convert (long_integer_type_node, first_len_val)fold_convert_loc (((location_t) 0), integer_types[itk_long], first_len_val
)
,
1749 fold_convert (long_integer_type_node, se->string_length)fold_convert_loc (((location_t) 0), integer_types[itk_long], se
->string_length)
);
1750 }
1751 }
1752 }
1753 else if (GFC_CLASS_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1753, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1753, __FUNCTION__))->type_common.lang_flag_4)
1754 && !GFC_CLASS_TYPE_P (gfc_get_element_type (TREE_TYPE (desc)))((tree_class_check ((gfc_get_element_type (((contains_struct_check
((desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1754, __FUNCTION__))->typed.type))), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1754, __FUNCTION__))->type_common.lang_flag_4)
)
1755 {
1756 /* Assignment of a CLASS array constructor to a derived type array. */
1757 if (expr->expr_type == EXPR_FUNCTION)
1758 se->expr = gfc_evaluate_now (se->expr, pblock);
1759 se->expr = gfc_class_data_get (se->expr);
1760 se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
1761 se->expr = fold_convert (TREE_TYPE (tmp), se->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1761, __FUNCTION__))->typed.type), se->expr)
;
1762 gfc_add_modify (&se->pre, tmp, se->expr);
1763 }
1764 else
1765 {
1766 /* TODO: Should the frontend already have done this conversion? */
1767 se->expr = fold_convert (TREE_TYPE (tmp), se->expr)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1767, __FUNCTION__))->typed.type), se->expr)
;
1768 gfc_add_modify (&se->pre, tmp, se->expr);
1769 }
1770
1771 gfc_add_block_to_block (pblock, &se->pre);
1772 gfc_add_block_to_block (pblock, &se->post);
1773}
1774
1775
1776/* Add the contents of an array to the constructor. DYNAMIC is as for
1777 gfc_trans_array_constructor_value. */
1778
1779static void
1780gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
1781 tree type ATTRIBUTE_UNUSED__attribute__ ((__unused__)),
1782 tree desc, gfc_expr * expr,
1783 tree * poffset, tree * offsetvar,
1784 bool dynamic)
1785{
1786 gfc_se se;
1787 gfc_ss *ss;
1788 gfc_loopinfo loop;
1789 stmtblock_t body;
1790 tree tmp;
1791 tree size;
1792 int n;
1793
1794 /* We need this to be a variable so we can increment it. */
1795 gfc_put_offset_into_var (pblock, poffset, offsetvar);
1796
1797 gfc_init_se (&se, NULL__null);
1798
1799 /* Walk the array expression. */
1800 ss = gfc_walk_expr (expr);
1801 gcc_assert (ss != gfc_ss_terminator)((void)(!(ss != gfc_ss_terminator) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1801, __FUNCTION__), 0 : 0))
;
1802
1803 /* Initialize the scalarizer. */
1804 gfc_init_loopinfo (&loop);
1805 gfc_add_ss_to_loop (&loop, ss);
1806
1807 /* Initialize the loop. */
1808 gfc_conv_ss_startstride (&loop);
1809 gfc_conv_loop_setup (&loop, &expr->where);
1810
1811 /* Make sure the constructed array has room for the new data. */
1812 if (dynamic)
1813 {
1814 /* Set SIZE to the total number of elements in the subarray. */
1815 size = gfc_index_one_nodegfc_rank_cst[1];
1816 for (n = 0; n < loop.dimen; n++)
1817 {
1818 tmp = gfc_get_iteration_count (loop.from[n], loop.to[n],
1819 gfc_index_one_nodegfc_rank_cst[1]);
1820 size = fold_build2_loc (input_location, MULT_EXPR,
1821 gfc_array_index_type, size, tmp);
1822 }
1823
1824 /* Grow the constructed array by SIZE elements. */
1825 gfc_grow_array (&loop.pre, desc, size);
1826 }
1827
1828 /* Make the loop body. */
1829 gfc_mark_ss_chain_used (ss, 1);
1830 gfc_start_scalarized_body (&loop, &body);
1831 gfc_copy_loopinfo_to_se (&se, &loop);
1832 se.ss = ss;
1833
1834 gfc_trans_array_ctor_element (&body, desc, *poffset, &se, expr);
1835 gcc_assert (se.ss == gfc_ss_terminator)((void)(!(se.ss == gfc_ss_terminator) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1835, __FUNCTION__), 0 : 0))
;
1836
1837 /* Increment the offset. */
1838 tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
1839 *poffset, gfc_index_one_nodegfc_rank_cst[1]);
1840 gfc_add_modify (&body, *poffset, tmp);
1841
1842 /* Finish the loop. */
1843 gfc_trans_scalarizing_loops (&loop, &body);
1844 gfc_add_block_to_block (&loop.pre, &loop.post);
1845 tmp = gfc_finish_block (&loop.pre);
1846 gfc_add_expr_to_block (pblock, tmp);
1847
1848 gfc_cleanup_loop (&loop);
1849}
1850
1851
1852/* Assign the values to the elements of an array constructor. DYNAMIC
1853 is true if descriptor DESC only contains enough data for the static
1854 size calculated by gfc_get_array_constructor_size. When true, memory
1855 for the dynamic parts must be allocated using realloc. */
1856
1857static void
1858gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
1859 tree desc, gfc_constructor_base base,
1860 tree * poffset, tree * offsetvar,
1861 bool dynamic)
1862{
1863 tree tmp;
1864 tree start = NULL_TREE(tree) __null;
1865 tree end = NULL_TREE(tree) __null;
1866 tree step = NULL_TREE(tree) __null;
1867 stmtblock_t body;
1868 gfc_se se;
1869 mpz_t size;
1870 gfc_constructor *c;
1871
1872 tree shadow_loopvar = NULL_TREE(tree) __null;
1873 gfc_saved_var saved_loopvar;
1874
1875 mpz_init__gmpz_init (size);
1876 for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
1877 {
1878 /* If this is an iterator or an array, the offset must be a variable. */
1879 if ((c->iterator || c->expr->rank > 0) && INTEGER_CST_P (*poffset)(((enum tree_code) (*poffset)->base.code) == INTEGER_CST))
1880 gfc_put_offset_into_var (pblock, poffset, offsetvar);
1881
1882 /* Shadowing the iterator avoids changing its value and saves us from
1883 keeping track of it. Further, it makes sure that there's always a
1884 backend-decl for the symbol, even if there wasn't one before,
1885 e.g. in the case of an iterator that appears in a specification
1886 expression in an interface mapping. */
1887 if (c->iterator)
1888 {
1889 gfc_symbol *sym;
1890 tree type;
1891
1892 /* Evaluate loop bounds before substituting the loop variable
1893 in case they depend on it. Such a case is invalid, but it is
1894 not more expensive to do the right thing here.
1895 See PR 44354. */
1896 gfc_init_se (&se, NULL__null);
1897 gfc_conv_expr_val (&se, c->iterator->start);
1898 gfc_add_block_to_block (pblock, &se.pre);
1899 start = gfc_evaluate_now (se.expr, pblock);
1900
1901 gfc_init_se (&se, NULL__null);
1902 gfc_conv_expr_val (&se, c->iterator->end);
1903 gfc_add_block_to_block (pblock, &se.pre);
1904 end = gfc_evaluate_now (se.expr, pblock);
1905
1906 gfc_init_se (&se, NULL__null);
1907 gfc_conv_expr_val (&se, c->iterator->step);
1908 gfc_add_block_to_block (pblock, &se.pre);
1909 step = gfc_evaluate_now (se.expr, pblock);
1910
1911 sym = c->iterator->var->symtree->n.sym;
1912 type = gfc_typenode_for_spec (&sym->ts);
1913
1914 shadow_loopvar = gfc_create_var (type, "shadow_loopvar");
1915 gfc_shadow_sym (sym, shadow_loopvar, &saved_loopvar);
1916 }
1917
1918 gfc_start_block (&body);
1919
1920 if (c->expr->expr_type == EXPR_ARRAY)
1921 {
1922 /* Array constructors can be nested. */
1923 gfc_trans_array_constructor_value (&body, type, desc,
1924 c->expr->value.constructor,
1925 poffset, offsetvar, dynamic);
1926 }
1927 else if (c->expr->rank > 0)
1928 {
1929 gfc_trans_array_constructor_subarray (&body, type, desc, c->expr,
1930 poffset, offsetvar, dynamic);
1931 }
1932 else
1933 {
1934 /* This code really upsets the gimplifier so don't bother for now. */
1935 gfc_constructor *p;
1936 HOST_WIDE_INTlong n;
1937 HOST_WIDE_INTlong size;
1938
1939 p = c;
1940 n = 0;
1941 while (p && !(p->iterator || p->expr->expr_type != EXPR_CONSTANT))
1942 {
1943 p = gfc_constructor_next (p);
1944 n++;
1945 }
1946 if (n < 4)
1947 {
1948 /* Scalar values. */
1949 gfc_init_se (&se, NULL__null);
1950 gfc_trans_array_ctor_element (&body, desc, *poffset,
1951 &se, c->expr);
1952
1953 *poffset = fold_build2_loc (input_location, PLUS_EXPR,
1954 gfc_array_index_type,
1955 *poffset, gfc_index_one_nodegfc_rank_cst[1]);
1956 }
1957 else
1958 {
1959 /* Collect multiple scalar constants into a constructor. */
1960 vec<constructor_elt, va_gc> *v = NULL__null;
1961 tree init;
1962 tree bound;
1963 tree tmptype;
1964 HOST_WIDE_INTlong idx = 0;
1965
1966 p = c;
1967 /* Count the number of consecutive scalar constants. */
1968 while (p && !(p->iterator
1969 || p->expr->expr_type != EXPR_CONSTANT))
1970 {
1971 gfc_init_se (&se, NULL__null);
1972 gfc_conv_constant (&se, p->expr);
1973
1974 if (c->expr->ts.type != BT_CHARACTER)
1975 se.expr = fold_convert (type, se.expr)fold_convert_loc (((location_t) 0), type, se.expr);
1976 /* For constant character array constructors we build
1977 an array of pointers. */
1978 else if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE)
)
1979 se.expr = gfc_build_addr_expr
1980 (gfc_get_pchar_type (p->expr->ts.kind),
1981 se.expr);
1982
1983 CONSTRUCTOR_APPEND_ELT (v,do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type
, idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0)
1984 build_int_cst (gfc_array_index_type,do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type
, idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0)
1985 idx++),do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type
, idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0)
1986 se.expr)do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type
, idx++), se.expr}; vec_safe_push ((v), _ce___); } while (0)
;
1987 c = p;
1988 p = gfc_constructor_next (p);
1989 }
1990
1991 bound = size_int (n - 1)size_int_kind (n - 1, stk_sizetype);
1992 /* Create an array type to hold them. */
1993 tmptype = build_range_type (gfc_array_index_type,
1994 gfc_index_zero_nodegfc_rank_cst[0], bound);
1995 tmptype = build_array_type (type, tmptype);
1996
1997 init = build_constructor (tmptype, v);
1998 TREE_CONSTANT (init)((non_type_check ((init), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 1998, __FUNCTION__))->base.constant_flag)
= 1;
1999 TREE_STATIC (init)((init)->base.static_flag) = 1;
2000 /* Create a static variable to hold the data. */
2001 tmp = gfc_create_var (tmptype, "data");
2002 TREE_STATIC (tmp)((tmp)->base.static_flag) = 1;
2003 TREE_CONSTANT (tmp)((non_type_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2003, __FUNCTION__))->base.constant_flag)
= 1;
2004 TREE_READONLY (tmp)((non_type_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2004, __FUNCTION__))->base.readonly_flag)
= 1;
2005 DECL_INITIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2005, __FUNCTION__))->decl_common.initial)
= init;
2006 init = tmp;
2007
2008 /* Use BUILTIN_MEMCPY to assign the values. */
2009 tmp = gfc_conv_descriptor_data_get (desc);
2010 tmp = build_fold_indirect_ref_loc (input_location,
2011 tmp);
2012 tmp = gfc_build_array_ref (tmp, *poffset, NULL__null);
2013 tmp = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
2014 init = gfc_build_addr_expr (NULL_TREE(tree) __null, init);
2015
2016 size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type))((unsigned long) (*tree_int_cst_elt_check ((((tree_class_check
((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2016, __FUNCTION__))->type_common.size_unit)), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2016, __FUNCTION__)))
;
2017 bound = build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], n * size);
2018 tmp = build_call_expr_loc (input_location,
2019 builtin_decl_explicit (BUILT_IN_MEMCPY),
2020 3, tmp, init, bound);
2021 gfc_add_expr_to_block (&body, tmp);
2022
2023 *poffset = fold_build2_loc (input_location, PLUS_EXPR,
2024 gfc_array_index_type, *poffset,
2025 build_int_cst (gfc_array_index_type, n));
2026 }
2027 if (!INTEGER_CST_P (*poffset)(((enum tree_code) (*poffset)->base.code) == INTEGER_CST))
2028 {
2029 gfc_add_modify (&body, *offsetvar, *poffset);
2030 *poffset = *offsetvar;
2031 }
2032 }
2033
2034 /* The frontend should already have done any expansions
2035 at compile-time. */
2036 if (!c->iterator)
2037 {
2038 /* Pass the code as is. */
2039 tmp = gfc_finish_block (&body);
2040 gfc_add_expr_to_block (pblock, tmp);
2041 }
2042 else
2043 {
2044 /* Build the implied do-loop. */
2045 stmtblock_t implied_do_block;
2046 tree cond;
2047 tree exit_label;
2048 tree loopbody;
2049 tree tmp2;
2050
2051 loopbody = gfc_finish_block (&body);
2052
2053 /* Create a new block that holds the implied-do loop. A temporary
2054 loop-variable is used. */
2055 gfc_start_block(&implied_do_block);
2056
2057 /* Initialize the loop. */
2058 gfc_add_modify (&implied_do_block, shadow_loopvar, start);
2059
2060 /* If this array expands dynamically, and the number of iterations
2061 is not constant, we won't have allocated space for the static
2062 part of C->EXPR's size. Do that now. */
2063 if (dynamic && gfc_iterator_has_dynamic_bounds (c->iterator))
2064 {
2065 /* Get the number of iterations. */
2066 tmp = gfc_get_iteration_count (shadow_loopvar, end, step);
2067
2068 /* Get the static part of C->EXPR's size. */
2069 gfc_get_array_constructor_element_size (&size, c->expr);
2070 tmp2 = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind);
2071
2072 /* Grow the array by TMP * TMP2 elements. */
2073 tmp = fold_build2_loc (input_location, MULT_EXPR,
2074 gfc_array_index_type, tmp, tmp2);
2075 gfc_grow_array (&implied_do_block, desc, tmp);
2076 }
2077
2078 /* Generate the loop body. */
2079 exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2080 gfc_start_block (&body);
2081
2082 /* Generate the exit condition. Depending on the sign of
2083 the step variable we have to generate the correct
2084 comparison. */
2085 tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
2086 step, build_int_cst (TREE_TYPE (step)((contains_struct_check ((step), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2086, __FUNCTION__))->typed.type)
, 0));
2087 cond = fold_build3_loc (input_location, COND_EXPR,
2088 logical_type_node, tmp,
2089 fold_build2_loc (input_location, GT_EXPR,
2090 logical_type_node, shadow_loopvar, end),
2091 fold_build2_loc (input_location, LT_EXPR,
2092 logical_type_node, shadow_loopvar, end));
2093 tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE
], exit_label)
;
2094 TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
2095 tmp = build3_v (COND_EXPR, cond, tmp,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], cond, tmp, build_empty_stmt (input_location))
2096 build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], cond, tmp, build_empty_stmt (input_location))
;
2097 gfc_add_expr_to_block (&body, tmp);
2098
2099 /* The main loop body. */
2100 gfc_add_expr_to_block (&body, loopbody);
2101
2102 /* Increase loop variable by step. */
2103 tmp = fold_build2_loc (input_location, PLUS_EXPR,
2104 TREE_TYPE (shadow_loopvar)((contains_struct_check ((shadow_loopvar), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2104, __FUNCTION__))->typed.type)
, shadow_loopvar,
2105 step);
2106 gfc_add_modify (&body, shadow_loopvar, tmp);
2107
2108 /* Finish the loop. */
2109 tmp = gfc_finish_block (&body);
2110 tmp = build1_v (LOOP_EXPR, tmp)fold_build1_loc (input_location, LOOP_EXPR, global_trees[TI_VOID_TYPE
], tmp)
;
2111 gfc_add_expr_to_block (&implied_do_block, tmp);
2112
2113 /* Add the exit label. */
2114 tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE
], exit_label)
;
2115 gfc_add_expr_to_block (&implied_do_block, tmp);
2116
2117 /* Finish the implied-do loop. */
2118 tmp = gfc_finish_block(&implied_do_block);
2119 gfc_add_expr_to_block(pblock, tmp);
2120
2121 gfc_restore_sym (c->iterator->var->symtree->n.sym, &saved_loopvar);
2122 }
2123 }
2124 mpz_clear__gmpz_clear (size);
2125}
2126
2127
2128/* The array constructor code can create a string length with an operand
2129 in the form of a temporary variable. This variable will retain its
2130 context (current_function_decl). If we store this length tree in a
2131 gfc_charlen structure which is shared by a variable in another
2132 context, the resulting gfc_charlen structure with a variable in a
2133 different context, we could trip the assertion in expand_expr_real_1
2134 when it sees that a variable has been created in one context and
2135 referenced in another.
2136
2137 If this might be the case, we create a new gfc_charlen structure and
2138 link it into the current namespace. */
2139
2140static void
2141store_backend_decl (gfc_charlen **clp, tree len, bool force_new_cl)
2142{
2143 if (force_new_cl)
2144 {
2145 gfc_charlen *new_cl = gfc_new_charlen (gfc_current_ns, *clp);
2146 *clp = new_cl;
2147 }
2148 (*clp)->backend_decl = len;
2149}
2150
2151/* A catch-all to obtain the string length for anything that is not
2152 a substring of non-constant length, a constant, array or variable. */
2153
2154static void
2155get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
2156{
2157 gfc_se se;
2158
2159 /* Don't bother if we already know the length is a constant. */
2160 if (*len && INTEGER_CST_P (*len)(((enum tree_code) (*len)->base.code) == INTEGER_CST))
2161 return;
2162
2163 if (!e->ref && e->ts.u.cl && e->ts.u.cl->length
2164 && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
2165 {
2166 /* This is easy. */
2167 gfc_conv_const_charlen (e->ts.u.cl);
2168 *len = e->ts.u.cl->backend_decl;
2169 }
2170 else
2171 {
2172 /* Otherwise, be brutal even if inefficient. */
2173 gfc_init_se (&se, NULL__null);
2174
2175 /* No function call, in case of side effects. */
2176 se.no_function_call = 1;
2177 if (e->rank == 0)
2178 gfc_conv_expr (&se, e);
2179 else
2180 gfc_conv_expr_descriptor (&se, e);
2181
2182 /* Fix the value. */
2183 *len = gfc_evaluate_now (se.string_length, &se.pre);
2184
2185 gfc_add_block_to_block (block, &se.pre);
2186 gfc_add_block_to_block (block, &se.post);
2187
2188 store_backend_decl (&e->ts.u.cl, *len, true);
2189 }
2190}
2191
2192
2193/* Figure out the string length of a variable reference expression.
2194 Used by get_array_ctor_strlen. */
2195
2196static void
2197get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len)
2198{
2199 gfc_ref *ref;
2200 gfc_typespec *ts;
2201 mpz_t char_len;
2202 gfc_se se;
2203
2204 /* Don't bother if we already know the length is a constant. */
2205 if (*len && INTEGER_CST_P (*len)(((enum tree_code) (*len)->base.code) == INTEGER_CST))
2206 return;
2207
2208 ts = &expr->symtree->n.sym->ts;
2209 for (ref = expr->ref; ref; ref = ref->next)
2210 {
2211 switch (ref->type)
2212 {
2213 case REF_ARRAY:
2214 /* Array references don't change the string length. */
2215 if (ts->deferred)
2216 get_array_ctor_all_strlen (block, expr, len);
2217 break;
2218
2219 case REF_COMPONENT:
2220 /* Use the length of the component. */
2221 ts = &ref->u.c.component->ts;
2222 break;
2223
2224 case REF_SUBSTRING:
2225 if (ref->u.ss.end == NULL__null
2226 || ref->u.ss.start->expr_type != EXPR_CONSTANT
2227 || ref->u.ss.end->expr_type != EXPR_CONSTANT)
2228 {
2229 /* Note that this might evaluate expr. */
2230 get_array_ctor_all_strlen (block, expr, len);
2231 return;
2232 }
2233 mpz_init_set_ui__gmpz_init_set_ui (char_len, 1);
2234 mpz_add__gmpz_add (char_len, char_len, ref->u.ss.end->value.integer);
2235 mpz_sub__gmpz_sub (char_len, char_len, ref->u.ss.start->value.integer);
2236 *len = gfc_conv_mpz_to_tree_type (char_len, gfc_charlen_type_node);
2237 mpz_clear__gmpz_clear (char_len);
2238 return;
2239
2240 case REF_INQUIRY:
2241 break;
2242
2243 default:
2244 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2244, __FUNCTION__))
;
2245 }
2246 }
2247
2248 /* A last ditch attempt that is sometimes needed for deferred characters. */
2249 if (!ts->u.cl->backend_decl)
2250 {
2251 gfc_init_se (&se, NULL__null);
2252 if (expr->rank)
2253 gfc_conv_expr_descriptor (&se, expr);
2254 else
2255 gfc_conv_expr (&se, expr);
2256 gcc_assert (se.string_length != NULL_TREE)((void)(!(se.string_length != (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2256, __FUNCTION__), 0 : 0))
;
2257 gfc_add_block_to_block (block, &se.pre);
2258 ts->u.cl->backend_decl = se.string_length;
2259 }
2260
2261 *len = ts->u.cl->backend_decl;
2262}
2263
2264
2265/* Figure out the string length of a character array constructor.
2266 If len is NULL, don't calculate the length; this happens for recursive calls
2267 when a sub-array-constructor is an element but not at the first position,
2268 so when we're not interested in the length.
2269 Returns TRUE if all elements are character constants. */
2270
2271bool
2272get_array_ctor_strlen (stmtblock_t *block, gfc_constructor_base base, tree * len)
2273{
2274 gfc_constructor *c;
2275 bool is_const;
2276
2277 is_const = TRUEtrue;
2278
2279 if (gfc_constructor_first (base) == NULL__null)
2280 {
2281 if (len)
2282 *len = build_int_cstu (gfc_charlen_type_node, 0);
2283 return is_const;
2284 }
2285
2286 /* Loop over all constructor elements to find out is_const, but in len we
2287 want to store the length of the first, not the last, element. We can
2288 of course exit the loop as soon as is_const is found to be false. */
2289 for (c = gfc_constructor_first (base);
2290 c && is_const; c = gfc_constructor_next (c))
2291 {
2292 switch (c->expr->expr_type)
2293 {
2294 case EXPR_CONSTANT:
2295 if (len && !(*len && INTEGER_CST_P (*len)(((enum tree_code) (*len)->base.code) == INTEGER_CST)))
2296 *len = build_int_cstu (gfc_charlen_type_node,
2297 c->expr->value.character.length);
2298 break;
2299
2300 case EXPR_ARRAY:
2301 if (!get_array_ctor_strlen (block, c->expr->value.constructor, len))
2302 is_const = false;
2303 break;
2304
2305 case EXPR_VARIABLE:
2306 is_const = false;
2307 if (len)
2308 get_array_ctor_var_strlen (block, c->expr, len);
2309 break;
2310
2311 default:
2312 is_const = false;
2313 if (len)
2314 get_array_ctor_all_strlen (block, c->expr, len);
2315 break;
2316 }
2317
2318 /* After the first iteration, we don't want the length modified. */
2319 len = NULL__null;
2320 }
2321
2322 return is_const;
2323}
2324
2325/* Check whether the array constructor C consists entirely of constant
2326 elements, and if so returns the number of those elements, otherwise
2327 return zero. Note, an empty or NULL array constructor returns zero. */
2328
2329unsigned HOST_WIDE_INTlong
2330gfc_constant_array_constructor_p (gfc_constructor_base base)
2331{
2332 unsigned HOST_WIDE_INTlong nelem = 0;
2333
2334 gfc_constructor *c = gfc_constructor_first (base);
2335 while (c)
2336 {
2337 if (c->iterator
2338 || c->expr->rank > 0
2339 || c->expr->expr_type != EXPR_CONSTANT)
2340 return 0;
2341 c = gfc_constructor_next (c);
2342 nelem++;
2343 }
2344 return nelem;
2345}
2346
2347
2348/* Given EXPR, the constant array constructor specified by an EXPR_ARRAY,
2349 and the tree type of it's elements, TYPE, return a static constant
2350 variable that is compile-time initialized. */
2351
2352tree
2353gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
2354{
2355 tree tmptype, init, tmp;
2356 HOST_WIDE_INTlong nelem;
2357 gfc_constructor *c;
2358 gfc_array_spec as;
2359 gfc_se se;
2360 int i;
2361 vec<constructor_elt, va_gc> *v = NULL__null;
2362
2363 /* First traverse the constructor list, converting the constants
2364 to tree to build an initializer. */
2365 nelem = 0;
2366 c = gfc_constructor_first (expr->value.constructor);
2367 while (c)
1
Loop condition is true. Entering loop body
30
Loop condition is true. Entering loop body
2368 {
2369 gfc_init_se (&se, NULL__null);
2370 gfc_conv_constant (&se, c->expr);
2371 if (c->expr->ts.type != BT_CHARACTER)
2
Assuming field 'type' is equal to BT_CHARACTER
3
Taking false branch
31
Assuming field 'type' is equal to BT_CHARACTER
32
Taking false branch
2372 se.expr = fold_convert (type, se.expr)fold_convert_loc (((location_t) 0), type, se.expr);
2373 else if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE)
)
4
Assuming field 'code' is not equal to POINTER_TYPE
5
Assuming field 'code' is not equal to REFERENCE_TYPE
6
Taking false branch
33
Taking false branch
2374 se.expr = gfc_build_addr_expr (gfc_get_pchar_type (c->expr->ts.kind),
2375 se.expr);
2376 CONSTRUCTOR_APPEND_ELT (v, build_int_cst (gfc_array_index_type, nelem),do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type
, nelem), se.expr}; vec_safe_push ((v), _ce___); } while (0)
7
Calling 'vec_safe_push<constructor_elt, va_gc>'
28
Returning from 'vec_safe_push<constructor_elt, va_gc>'
29
Loop condition is false. Exiting loop
34
Passing value via 1st parameter 'v'
35
Calling 'vec_safe_push<constructor_elt, va_gc>'
2377 se.expr)do { constructor_elt _ce___ = {build_int_cst (gfc_array_index_type
, nelem), se.expr}; vec_safe_push ((v), _ce___); } while (0)
;
2378 c = gfc_constructor_next (c);
2379 nelem++;
2380 }
2381
2382 /* Next determine the tree type for the array. We use the gfortran
2383 front-end's gfc_get_nodesc_array_type in order to create a suitable
2384 GFC_ARRAY_TYPE_P that may be used by the scalarizer. */
2385
2386 memset (&as, 0, sizeof (gfc_array_spec));
2387
2388 as.rank = expr->rank;
2389 as.type = AS_EXPLICIT;
2390 if (!expr->shape)
2391 {
2392 as.lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL__null, 0);
2393 as.upper[0] = gfc_get_int_expr (gfc_default_integer_kind,
2394 NULL__null, nelem - 1);
2395 }
2396 else
2397 for (i = 0; i < expr->rank; i++)
2398 {
2399 int tmp = (int) mpz_get_si__gmpz_get_si (expr->shape[i]);
2400 as.lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL__null, 0);
2401 as.upper[i] = gfc_get_int_expr (gfc_default_integer_kind,
2402 NULL__null, tmp - 1);
2403 }
2404
2405 tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
2406
2407 /* as is not needed anymore. */
2408 for (i = 0; i < as.rank + as.corank; i++)
2409 {
2410 gfc_free_expr (as.lower[i]);
2411 gfc_free_expr (as.upper[i]);
2412 }
2413
2414 init = build_constructor (tmptype, v);
2415
2416 TREE_CONSTANT (init)((non_type_check ((init), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2416, __FUNCTION__))->base.constant_flag)
= 1;
2417 TREE_STATIC (init)((init)->base.static_flag) = 1;
2418
2419 tmp = build_decl (input_location, VAR_DECL, create_tmp_var_name ("A"),
2420 tmptype);
2421 DECL_ARTIFICIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2421, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2422 DECL_IGNORED_P (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2422, __FUNCTION__))->decl_common.ignored_flag)
= 1;
2423 TREE_STATIC (tmp)((tmp)->base.static_flag) = 1;
2424 TREE_CONSTANT (tmp)((non_type_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2424, __FUNCTION__))->base.constant_flag)
= 1;
2425 TREE_READONLY (tmp)((non_type_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2425, __FUNCTION__))->base.readonly_flag)
= 1;
2426 DECL_INITIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2426, __FUNCTION__))->decl_common.initial)
= init;
2427 pushdecl (tmp);
2428
2429 return tmp;
2430}
2431
2432
2433/* Translate a constant EXPR_ARRAY array constructor for the scalarizer.
2434 This mostly initializes the scalarizer state info structure with the
2435 appropriate values to directly use the array created by the function
2436 gfc_build_constant_array_constructor. */
2437
2438static void
2439trans_constant_array_constructor (gfc_ss * ss, tree type)
2440{
2441 gfc_array_info *info;
2442 tree tmp;
2443 int i;
2444
2445 tmp = gfc_build_constant_array_constructor (ss->info->expr, type);
2446
2447 info = &ss->info->data.array;
2448
2449 info->descriptor = tmp;
2450 info->data = gfc_build_addr_expr (NULL_TREE(tree) __null, tmp);
2451 info->offset = gfc_index_zero_nodegfc_rank_cst[0];
2452
2453 for (i = 0; i < ss->dimen; i++)
2454 {
2455 info->delta[i] = gfc_index_zero_nodegfc_rank_cst[0];
2456 info->start[i] = gfc_index_zero_nodegfc_rank_cst[0];
2457 info->end[i] = gfc_index_zero_nodegfc_rank_cst[0];
2458 info->stride[i] = gfc_index_one_nodegfc_rank_cst[1];
2459 }
2460}
2461
2462
2463static int
2464get_rank (gfc_loopinfo *loop)
2465{
2466 int rank;
2467
2468 rank = 0;
2469 for (; loop; loop = loop->parent)
2470 rank += loop->dimen;
2471
2472 return rank;
2473}
2474
2475
2476/* Helper routine of gfc_trans_array_constructor to determine if the
2477 bounds of the loop specified by LOOP are constant and simple enough
2478 to use with trans_constant_array_constructor. Returns the
2479 iteration count of the loop if suitable, and NULL_TREE otherwise. */
2480
2481static tree
2482constant_array_constructor_loop_size (gfc_loopinfo * l)
2483{
2484 gfc_loopinfo *loop;
2485 tree size = gfc_index_one_nodegfc_rank_cst[1];
2486 tree tmp;
2487 int i, total_dim;
2488
2489 total_dim = get_rank (l);
2490
2491 for (loop = l; loop; loop = loop->parent)
2492 {
2493 for (i = 0; i < loop->dimen; i++)
2494 {
2495 /* If the bounds aren't constant, return NULL_TREE. */
2496 if (!INTEGER_CST_P (loop->from[i])(((enum tree_code) (loop->from[i])->base.code) == INTEGER_CST
)
|| !INTEGER_CST_P (loop->to[i])(((enum tree_code) (loop->to[i])->base.code) == INTEGER_CST
)
)
2497 return NULL_TREE(tree) __null;
2498 if (!integer_zerop (loop->from[i]))
2499 {
2500 /* Only allow nonzero "from" in one-dimensional arrays. */
2501 if (total_dim != 1)
2502 return NULL_TREE(tree) __null;
2503 tmp = fold_build2_loc (input_location, MINUS_EXPR,
2504 gfc_array_index_type,
2505 loop->to[i], loop->from[i]);
2506 }
2507 else
2508 tmp = loop->to[i];
2509 tmp = fold_build2_loc (input_location, PLUS_EXPR,
2510 gfc_array_index_type, tmp, gfc_index_one_nodegfc_rank_cst[1]);
2511 size = fold_build2_loc (input_location, MULT_EXPR,
2512 gfc_array_index_type, size, tmp);
2513 }
2514 }
2515
2516 return size;
2517}
2518
2519
2520static tree *
2521get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
2522{
2523 gfc_ss *ss;
2524 int n;
2525
2526 gcc_assert (array->nested_ss == NULL)((void)(!(array->nested_ss == __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2526, __FUNCTION__), 0 : 0))
;
2527
2528 for (ss = array; ss; ss = ss->parent)
2529 for (n = 0; n < ss->loop->dimen; n++)
2530 if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
2531 return &(ss->loop->to[n]);
2532
2533 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2533, __FUNCTION__))
;
2534}
2535
2536
2537static gfc_loopinfo *
2538outermost_loop (gfc_loopinfo * loop)
2539{
2540 while (loop->parent != NULL__null)
2541 loop = loop->parent;
2542
2543 return loop;
2544}
2545
2546
2547/* Array constructors are handled by constructing a temporary, then using that
2548 within the scalarization loop. This is not optimal, but seems by far the
2549 simplest method. */
2550
2551static void
2552trans_array_constructor (gfc_ss * ss, locus * where)
2553{
2554 gfc_constructor_base c;
2555 tree offset;
2556 tree offsetvar;
2557 tree desc;
2558 tree type;
2559 tree tmp;
2560 tree *loop_ubound0;
2561 bool dynamic;
2562 bool old_first_len, old_typespec_chararray_ctor;
2563 tree old_first_len_val;
2564 gfc_loopinfo *loop, *outer_loop;
2565 gfc_ss_info *ss_info;
2566 gfc_expr *expr;
2567 gfc_ss *s;
2568 tree neg_len;
2569 char *msg;
2570
2571 /* Save the old values for nested checking. */
2572 old_first_len = first_len;
2573 old_first_len_val = first_len_val;
2574 old_typespec_chararray_ctor = typespec_chararray_ctor;
2575
2576 loop = ss->loop;
2577 outer_loop = outermost_loop (loop);
2578 ss_info = ss->info;
2579 expr = ss_info->expr;
2580
2581 /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
2582 typespec was given for the array constructor. */
2583 typespec_chararray_ctor = (expr->ts.type == BT_CHARACTER
2584 && expr->ts.u.cl
2585 && expr->ts.u.cl->length_from_typespec);
2586
2587 if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
2588 && expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
2589 {
2590 first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
2591 first_len = true;
2592 }
2593
2594 gcc_assert (ss->dimen == ss->loop->dimen)((void)(!(ss->dimen == ss->loop->dimen) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2594, __FUNCTION__), 0 : 0))
;
2595
2596 c = expr->value.constructor;
2597 if (expr->ts.type == BT_CHARACTER)
2598 {
2599 bool const_string;
2600 bool force_new_cl = false;
2601
2602 /* get_array_ctor_strlen walks the elements of the constructor, if a
2603 typespec was given, we already know the string length and want the one
2604 specified there. */
2605 if (typespec_chararray_ctor && expr->ts.u.cl->length
2606 && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
2607 {
2608 gfc_se length_se;
2609
2610 const_string = false;
2611 gfc_init_se (&length_se, NULL__null);
2612 gfc_conv_expr_type (&length_se, expr->ts.u.cl->length,
2613 gfc_charlen_type_node);
2614 ss_info->string_length = length_se.expr;
2615
2616 /* Check if the character length is negative. If it is, then
2617 set LEN = 0. */
2618 neg_len = fold_build2_loc (input_location, LT_EXPR,
2619 logical_type_node, ss_info->string_length,
2620 build_zero_cst (TREE_TYPE((contains_struct_check ((ss_info->string_length), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2621, __FUNCTION__))->typed.type)
2621 (ss_info->string_length)((contains_struct_check ((ss_info->string_length), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2621, __FUNCTION__))->typed.type)
));
2622 /* Print a warning if bounds checking is enabled. */
2623 if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
2624 {
2625 msg = xasprintf ("Negative character length treated as LEN = 0");
2626 gfc_trans_runtime_check (false, true, neg_len, &length_se.pre,
2627 where, msg);
2628 free (msg);
2629 }
2630
2631 ss_info->string_length
2632 = fold_build3_loc (input_location, COND_EXPR,
2633 gfc_charlen_type_node, neg_len,
2634 build_zero_cst
2635 (TREE_TYPE (ss_info->string_length)((contains_struct_check ((ss_info->string_length), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2635, __FUNCTION__))->typed.type)
),
2636 ss_info->string_length);
2637 ss_info->string_length = gfc_evaluate_now (ss_info->string_length,
2638 &length_se.pre);
2639 gfc_add_block_to_block (&outer_loop->pre, &length_se.pre);
2640 gfc_add_block_to_block (&outer_loop->post, &length_se.post);
2641 }
2642 else
2643 {
2644 const_string = get_array_ctor_strlen (&outer_loop->pre, c,
2645 &ss_info->string_length);
2646 force_new_cl = true;
2647 }
2648
2649 /* Complex character array constructors should have been taken care of
2650 and not end up here. */
2651 gcc_assert (ss_info->string_length)((void)(!(ss_info->string_length) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2651, __FUNCTION__), 0 : 0))
;
2652
2653 store_backend_decl (&expr->ts.u.cl, ss_info->string_length, force_new_cl);
2654
2655 type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length);
2656 if (const_string)
2657 type = build_pointer_type (type);
2658 }
2659 else
2660 type = gfc_typenode_for_spec (expr->ts.type == BT_CLASS
2661 ? &CLASS_DATA (expr)expr->ts.u.derived->components->ts : &expr->ts);
2662
2663 /* See if the constructor determines the loop bounds. */
2664 dynamic = false;
2665
2666 loop_ubound0 = get_loop_upper_bound_for_array (ss, 0);
2667
2668 if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE(tree) __null)
2669 {
2670 /* We have a multidimensional parameter. */
2671 for (s = ss; s; s = s->parent)
2672 {
2673 int n;
2674 for (n = 0; n < s->loop->dimen; n++)
2675 {
2676 s->loop->from[n] = gfc_index_zero_nodegfc_rank_cst[0];
2677 s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]],
2678 gfc_index_integer_kind);
2679 s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
2680 gfc_array_index_type,
2681 s->loop->to[n],
2682 gfc_index_one_nodegfc_rank_cst[1]);
2683 }
2684 }
2685 }
2686
2687 if (*loop_ubound0 == NULL_TREE(tree) __null)
2688 {
2689 mpz_t size;
2690
2691 /* We should have a 1-dimensional, zero-based loop. */
2692 gcc_assert (loop->parent == NULL && loop->nested == NULL)((void)(!(loop->parent == __null && loop->nested
== __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2692, __FUNCTION__), 0 : 0))
;
2693 gcc_assert (loop->dimen == 1)((void)(!(loop->dimen == 1) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2693, __FUNCTION__), 0 : 0))
;
2694 gcc_assert (integer_zerop (loop->from[0]))((void)(!(integer_zerop (loop->from[0])) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2694, __FUNCTION__), 0 : 0))
;
2695
2696 /* Split the constructor size into a static part and a dynamic part.
2697 Allocate the static size up-front and record whether the dynamic
2698 size might be nonzero. */
2699 mpz_init__gmpz_init (size);
2700 dynamic = gfc_get_array_constructor_size (&size, c);
2701 mpz_sub_ui__gmpz_sub_ui (size, size, 1);
2702 loop->to[0] = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind);
2703 mpz_clear__gmpz_clear (size);
2704 }
2705
2706 /* Special case constant array constructors. */
2707 if (!dynamic)
2708 {
2709 unsigned HOST_WIDE_INTlong nelem = gfc_constant_array_constructor_p (c);
2710 if (nelem > 0)
2711 {
2712 tree size = constant_array_constructor_loop_size (loop);
2713 if (size && compare_tree_int (size, nelem) == 0)
2714 {
2715 trans_constant_array_constructor (ss, type);
2716 goto finish;
2717 }
2718 }
2719 }
2720
2721 gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type,
2722 NULL_TREE(tree) __null, dynamic, true, false, where);
2723
2724 desc = ss_info->data.array.descriptor;
2725 offset = gfc_index_zero_nodegfc_rank_cst[0];
2726 offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
2727 TREE_NO_WARNING (offsetvar)((offsetvar)->base.nowarning_flag) = 1;
2728 TREE_USED (offsetvar)((offsetvar)->base.used_flag) = 0;
2729 gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
2730 &offset, &offsetvar, dynamic);
2731
2732 /* If the array grows dynamically, the upper bound of the loop variable
2733 is determined by the array's final upper bound. */
2734 if (dynamic)
2735 {
2736 tmp = fold_build2_loc (input_location, MINUS_EXPR,
2737 gfc_array_index_type,
2738 offsetvar, gfc_index_one_nodegfc_rank_cst[1]);
2739 tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
2740 gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
2741 if (*loop_ubound0 && VAR_P (*loop_ubound0)(((enum tree_code) (*loop_ubound0)->base.code) == VAR_DECL
)
)
2742 gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp);
2743 else
2744 *loop_ubound0 = tmp;
2745 }
2746
2747 if (TREE_USED (offsetvar)((offsetvar)->base.used_flag))
2748 pushdecl (offsetvar);
2749 else
2750 gcc_assert (INTEGER_CST_P (offset))((void)(!((((enum tree_code) (offset)->base.code) == INTEGER_CST
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2750, __FUNCTION__), 0 : 0))
;
2751
2752#if 0
2753 /* Disable bound checking for now because it's probably broken. */
2754 if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
2755 {
2756 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2756, __FUNCTION__))
;
2757 }
2758#endif
2759
2760finish:
2761 /* Restore old values of globals. */
2762 first_len = old_first_len;
2763 first_len_val = old_first_len_val;
2764 typespec_chararray_ctor = old_typespec_chararray_ctor;
2765}
2766
2767
2768/* INFO describes a GFC_SS_SECTION in loop LOOP, and this function is
2769 called after evaluating all of INFO's vector dimensions. Go through
2770 each such vector dimension and see if we can now fill in any missing
2771 loop bounds. */
2772
2773static void
2774set_vector_loop_bounds (gfc_ss * ss)
2775{
2776 gfc_loopinfo *loop, *outer_loop;
2777 gfc_array_info *info;
2778 gfc_se se;
2779 tree tmp;
2780 tree desc;
2781 tree zero;
2782 int n;
2783 int dim;
2784
2785 outer_loop = outermost_loop (ss->loop);
2786
2787 info = &ss->info->data.array;
2788
2789 for (; ss; ss = ss->parent)
2790 {
2791 loop = ss->loop;
2792
2793 for (n = 0; n < loop->dimen; n++)
2794 {
2795 dim = ss->dim[n];
2796 if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR
2797 || loop->to[n] != NULL__null)
2798 continue;
2799
2800 /* Loop variable N indexes vector dimension DIM, and we don't
2801 yet know the upper bound of loop variable N. Set it to the
2802 difference between the vector's upper and lower bounds. */
2803 gcc_assert (loop->from[n] == gfc_index_zero_node)((void)(!(loop->from[n] == gfc_rank_cst[0]) ? fancy_abort (
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2803, __FUNCTION__), 0 : 0))
;
2804 gcc_assert (info->subscript[dim]((void)(!(info->subscript[dim] && info->subscript
[dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2805, __FUNCTION__), 0 : 0))
2805 && info->subscript[dim]->info->type == GFC_SS_VECTOR)((void)(!(info->subscript[dim] && info->subscript
[dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2805, __FUNCTION__), 0 : 0))
;
2806
2807 gfc_init_se (&se, NULL__null);
2808 desc = info->subscript[dim]->info->data.array.descriptor;
2809 zero = gfc_rank_cst[0];
2810 tmp = fold_build2_loc (input_location, MINUS_EXPR,
2811 gfc_array_index_type,
2812 gfc_conv_descriptor_ubound_get (desc, zero),
2813 gfc_conv_descriptor_lbound_get (desc, zero));
2814 tmp = gfc_evaluate_now (tmp, &outer_loop->pre);
2815 loop->to[n] = tmp;
2816 }
2817 }
2818}
2819
2820
2821/* Tells whether a scalar argument to an elemental procedure is saved out
2822 of a scalarization loop as a value or as a reference. */
2823
2824bool
2825gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
2826{
2827 if (ss_info->type != GFC_SS_REFERENCE)
2828 return false;
2829
2830 if (ss_info->data.scalar.needs_temporary)
2831 return false;
2832
2833 /* If the actual argument can be absent (in other words, it can
2834 be a NULL reference), don't try to evaluate it; pass instead
2835 the reference directly. */
2836 if (ss_info->can_be_null_ref)
2837 return true;
2838
2839 /* If the expression is of polymorphic type, it's actual size is not known,
2840 so we avoid copying it anywhere. */
2841 if (ss_info->data.scalar.dummy_arg
2842 && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS
2843 && ss_info->expr->ts.type == BT_CLASS)
2844 return true;
2845
2846 /* If the expression is a data reference of aggregate type,
2847 and the data reference is not used on the left hand side,
2848 avoid a copy by saving a reference to the content. */
2849 if (!ss_info->data.scalar.needs_temporary
2850 && (ss_info->expr->ts.type == BT_DERIVED
2851 || ss_info->expr->ts.type == BT_CLASS)
2852 && gfc_expr_is_variable (ss_info->expr))
2853 return true;
2854
2855 /* Otherwise the expression is evaluated to a temporary variable before the
2856 scalarization loop. */
2857 return false;
2858}
2859
2860
2861/* Add the pre and post chains for all the scalar expressions in a SS chain
2862 to loop. This is called after the loop parameters have been calculated,
2863 but before the actual scalarizing loops. */
2864
2865static void
2866gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
2867 locus * where)
2868{
2869 gfc_loopinfo *nested_loop, *outer_loop;
2870 gfc_se se;
2871 gfc_ss_info *ss_info;
2872 gfc_array_info *info;
2873 gfc_expr *expr;
2874 int n;
2875
2876 /* Don't evaluate the arguments for realloc_lhs_loop_for_fcn_call; otherwise,
2877 arguments could get evaluated multiple times. */
2878 if (ss->is_alloc_lhs)
2879 return;
2880
2881 outer_loop = outermost_loop (loop);
2882
2883 /* TODO: This can generate bad code if there are ordering dependencies,
2884 e.g., a callee allocated function and an unknown size constructor. */
2885 gcc_assert (ss != NULL)((void)(!(ss != __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2885, __FUNCTION__), 0 : 0))
;
2886
2887 for (; ss != gfc_ss_terminator; ss = ss->loop_chain)
2888 {
2889 gcc_assert (ss)((void)(!(ss) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 2889, __FUNCTION__), 0 : 0))
;
2890
2891 /* Cross loop arrays are handled from within the most nested loop. */
2892 if (ss->nested_ss != NULL__null)
2893 continue;
2894
2895 ss_info = ss->info;
2896 expr = ss_info->expr;
2897 info = &ss_info->data.array;
2898
2899 switch (ss_info->type)
2900 {
2901 case GFC_SS_SCALAR:
2902 /* Scalar expression. Evaluate this now. This includes elemental
2903 dimension indices, but not array section bounds. */
2904 gfc_init_se (&se, NULL__null);
2905 gfc_conv_expr (&se, expr);
2906 gfc_add_block_to_block (&outer_loop->pre, &se.pre);
2907
2908 if (expr->ts.type != BT_CHARACTER
2909 && !gfc_is_alloc_class_scalar_function (expr))
2910 {
2911 /* Move the evaluation of scalar expressions outside the
2912 scalarization loop, except for WHERE assignments. */
2913 if (subscript)
2914 se.expr = convert(gfc_array_index_type, se.expr);
2915 if (!ss_info->where)
2916 se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre);
2917 gfc_add_block_to_block (&outer_loop->pre, &se.post);
2918 }
2919 else
2920 gfc_add_block_to_block (&outer_loop->post, &se.post);
2921
2922 ss_info->data.scalar.value = se.expr;
2923 ss_info->string_length = se.string_length;
2924 break;
2925
2926 case GFC_SS_REFERENCE:
2927 /* Scalar argument to elemental procedure. */
2928 gfc_init_se (&se, NULL__null);
2929 if (gfc_scalar_elemental_arg_saved_as_reference (ss_info))
2930 gfc_conv_expr_reference (&se, expr);
2931 else
2932 {
2933 /* Evaluate the argument outside the loop and pass
2934 a reference to the value. */
2935 gfc_conv_expr (&se, expr);
2936 }
2937
2938 /* Ensure that a pointer to the string is stored. */
2939 if (expr->ts.type == BT_CHARACTER)
2940 gfc_conv_string_parameter (&se);
2941
2942 gfc_add_block_to_block (&outer_loop->pre, &se.pre);
2943 gfc_add_block_to_block (&outer_loop->post, &se.post);
2944 if (gfc_is_class_scalar_expr (expr))
2945 /* This is necessary because the dynamic type will always be
2946 large than the declared type. In consequence, assigning
2947 the value to a temporary could segfault.
2948 OOP-TODO: see if this is generally correct or is the value
2949 has to be written to an allocated temporary, whose address
2950 is passed via ss_info. */
2951 ss_info->data.scalar.value = se.expr;
2952 else
2953 ss_info->data.scalar.value = gfc_evaluate_now (se.expr,
2954 &outer_loop->pre);
2955
2956 ss_info->string_length = se.string_length;
2957 break;
2958
2959 case GFC_SS_SECTION:
2960 /* Add the expressions for scalar and vector subscripts. */
2961 for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
2962 if (info->subscript[n])
2963 gfc_add_loop_ss_code (loop, info->subscript[n], true, where);
2964
2965 set_vector_loop_bounds (ss);
2966 break;
2967
2968 case GFC_SS_VECTOR:
2969 /* Get the vector's descriptor and store it in SS. */
2970 gfc_init_se (&se, NULL__null);
2971 gfc_conv_expr_descriptor (&se, expr);
2972 gfc_add_block_to_block (&outer_loop->pre, &se.pre);
2973 gfc_add_block_to_block (&outer_loop->post, &se.post);
2974 info->descriptor = se.expr;
2975 break;
2976
2977 case GFC_SS_INTRINSIC:
2978 gfc_add_intrinsic_ss_code (loop, ss);
2979 break;
2980
2981 case GFC_SS_FUNCTION:
2982 /* Array function return value. We call the function and save its
2983 result in a temporary for use inside the loop. */
2984 gfc_init_se (&se, NULL__null);
2985 se.loop = loop;
2986 se.ss = ss;
2987 if (gfc_is_class_array_function (expr))
2988 expr->must_finalize = 1;
2989 gfc_conv_expr (&se, expr);
2990 gfc_add_block_to_block (&outer_loop->pre, &se.pre);
2991 gfc_add_block_to_block (&outer_loop->post, &se.post);
2992 ss_info->string_length = se.string_length;
2993 break;
2994
2995 case GFC_SS_CONSTRUCTOR:
2996 if (expr->ts.type == BT_CHARACTER
2997 && ss_info->string_length == NULL__null
2998 && expr->ts.u.cl
2999 && expr->ts.u.cl->length
3000 && expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
3001 {
3002 gfc_init_se (&se, NULL__null);
3003 gfc_conv_expr_type (&se, expr->ts.u.cl->length,
3004 gfc_charlen_type_node);
3005 ss_info->string_length = se.expr;
3006 gfc_add_block_to_block (&outer_loop->pre, &se.pre);
3007 gfc_add_block_to_block (&outer_loop->post, &se.post);
3008 }
3009 trans_array_constructor (ss, where);
3010 break;
3011
3012 case GFC_SS_TEMP:
3013 case GFC_SS_COMPONENT:
3014 /* Do nothing. These are handled elsewhere. */
3015 break;
3016
3017 default:
3018 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3018, __FUNCTION__))
;
3019 }
3020 }
3021
3022 if (!subscript)
3023 for (nested_loop = loop->nested; nested_loop;
3024 nested_loop = nested_loop->next)
3025 gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where);
3026}
3027
3028
3029/* Translate expressions for the descriptor and data pointer of a SS. */
3030/*GCC ARRAYS*/
3031
3032static void
3033gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
3034{
3035 gfc_se se;
3036 gfc_ss_info *ss_info;
3037 gfc_array_info *info;
3038 tree tmp;
3039
3040 ss_info = ss->info;
3041 info = &ss_info->data.array;
3042
3043 /* Get the descriptor for the array to be scalarized. */
3044 gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE)((void)(!(ss_info->expr->expr_type == EXPR_VARIABLE) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3044, __FUNCTION__), 0 : 0))
;
3045 gfc_init_se (&se, NULL__null);
3046 se.descriptor_only = 1;
3047 gfc_conv_expr_lhs (&se, ss_info->expr);
3048 gfc_add_block_to_block (block, &se.pre);
3049 info->descriptor = se.expr;
3050 ss_info->string_length = se.string_length;
3051
3052 if (base)
3053 {
3054 if (ss_info->expr->ts.type == BT_CHARACTER && !ss_info->expr->ts.deferred
3055 && ss_info->expr->ts.u.cl->length == NULL__null)
3056 {
3057 /* Emit a DECL_EXPR for the variable sized array type in
3058 GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
3059 sizes works correctly. */
3060 tree arraytype = TREE_TYPE (((contains_struct_check (((((tree_class_check ((((contains_struct_check
((info->descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3061, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3061, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3061, __FUNCTION__))->typed.type)
3061 GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (info->descriptor)))((contains_struct_check (((((tree_class_check ((((contains_struct_check
((info->descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3061, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3061, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3061, __FUNCTION__))->typed.type)
;
3062 if (! TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3062, __FUNCTION__))->type_common.name)
)
3063 TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3063, __FUNCTION__))->type_common.name)
= build_decl (UNKNOWN_LOCATION((location_t) 0), TYPE_DECL,
3064 NULL_TREE(tree) __null, arraytype);
3065 gfc_add_expr_to_block (block, build1 (DECL_EXPR, arraytype,
3066 TYPE_NAME (arraytype)((tree_class_check ((arraytype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3066, __FUNCTION__))->type_common.name)
));
3067 }
3068 /* Also the data pointer. */
3069 tmp = gfc_conv_array_data (se.expr);
3070 /* If this is a variable or address or a class array, use it directly.
3071 Otherwise we must evaluate it now to avoid breaking dependency
3072 analysis by pulling the expressions for elemental array indices
3073 inside the loop. */
3074 if (!(DECL_P (tmp)(tree_code_type[(int) (((enum tree_code) (tmp)->base.code)
)] == tcc_declaration)
3075 || (TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == ADDR_EXPR
3076 && DECL_P (TREE_OPERAND (tmp, 0))(tree_code_type[(int) (((enum tree_code) ((*((const_cast<tree
*> (tree_operand_check ((tmp), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3076, __FUNCTION__))))))->base.code))] == tcc_declaration
)
)
3077 || (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))((tree_class_check ((((contains_struct_check ((se.expr), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3077, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3077, __FUNCTION__))->type_common.lang_flag_1)
3078 && TREE_CODE (se.expr)((enum tree_code) (se.expr)->base.code) == COMPONENT_REF
3079 && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (se.expr, 0)))((tree_class_check ((((contains_struct_check (((*((const_cast
<tree*> (tree_operand_check ((se.expr), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3079, __FUNCTION__)))))), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3079, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3079, __FUNCTION__))->type_common.lang_flag_4)
)))
3080 tmp = gfc_evaluate_now (tmp, block);
3081 info->data = tmp;
3082
3083 tmp = gfc_conv_array_offset (se.expr);
3084 info->offset = gfc_evaluate_now (tmp, block);
3085
3086 /* Make absolutely sure that the saved_offset is indeed saved
3087 so that the variable is still accessible after the loops
3088 are translated. */
3089 info->saved_offset = info->offset;
3090 }
3091}
3092
3093
3094/* Initialize a gfc_loopinfo structure. */
3095
3096void
3097gfc_init_loopinfo (gfc_loopinfo * loop)
3098{
3099 int n;
3100
3101 memset (loop, 0, sizeof (gfc_loopinfo));
3102 gfc_init_block (&loop->pre);
3103 gfc_init_block (&loop->post);
3104
3105 /* Initially scalarize in order and default to no loop reversal. */
3106 for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
3107 {
3108 loop->order[n] = n;
3109 loop->reverse[n] = GFC_INHIBIT_REVERSE;
3110 }
3111
3112 loop->ss = gfc_ss_terminator;
3113}
3114
3115
3116/* Copies the loop variable info to a gfc_se structure. Does not copy the SS
3117 chain. */
3118
3119void
3120gfc_copy_loopinfo_to_se (gfc_se * se, gfc_loopinfo * loop)
3121{
3122 se->loop = loop;
3123}
3124
3125
3126/* Return an expression for the data pointer of an array. */
3127
3128tree
3129gfc_conv_array_data (tree descriptor)
3130{
3131 tree type;
3132
3133 type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3133, __FUNCTION__))->typed.type)
;
3134 if (GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3134, __FUNCTION__))->type_common.lang_flag_2)
)
3135 {
3136 if (TREE_CODE (type)((enum tree_code) (type)->base.code) == POINTER_TYPE)
3137 return descriptor;
3138 else
3139 {
3140 /* Descriptorless arrays. */
3141 return gfc_build_addr_expr (NULL_TREE(tree) __null, descriptor);
3142 }
3143 }
3144 else
3145 return gfc_conv_descriptor_data_get (descriptor);
3146}
3147
3148
3149/* Return an expression for the base offset of an array. */
3150
3151tree
3152gfc_conv_array_offset (tree descriptor)
3153{
3154 tree type;
3155
3156 type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3156, __FUNCTION__))->typed.type)
;
3157 if (GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3157, __FUNCTION__))->type_common.lang_flag_2)
)
3158 return GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3158, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
;
3159 else
3160 return gfc_conv_descriptor_offset_get (descriptor);
3161}
3162
3163
3164/* Get an expression for the array stride. */
3165
3166tree
3167gfc_conv_array_stride (tree descriptor, int dim)
3168{
3169 tree tmp;
3170 tree type;
3171
3172 type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3172, __FUNCTION__))->typed.type)
;
3173
3174 /* For descriptorless arrays use the array size. */
3175 tmp = GFC_TYPE_ARRAY_STRIDE (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3175, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[dim])
;
3176 if (tmp != NULL_TREE(tree) __null)
3177 return tmp;
3178
3179 tmp = gfc_conv_descriptor_stride_get (descriptor, gfc_rank_cst[dim]);
3180 return tmp;
3181}
3182
3183
3184/* Like gfc_conv_array_stride, but for the lower bound. */
3185
3186tree
3187gfc_conv_array_lbound (tree descriptor, int dim)
3188{
3189 tree tmp;
3190 tree type;
3191
3192 type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3192, __FUNCTION__))->typed.type)
;
3193
3194 tmp = GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3194, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim])
;
3195 if (tmp != NULL_TREE(tree) __null)
3196 return tmp;
3197
3198 tmp = gfc_conv_descriptor_lbound_get (descriptor, gfc_rank_cst[dim]);
3199 return tmp;
3200}
3201
3202
3203/* Like gfc_conv_array_stride, but for the upper bound. */
3204
3205tree
3206gfc_conv_array_ubound (tree descriptor, int dim)
3207{
3208 tree tmp;
3209 tree type;
3210
3211 type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3211, __FUNCTION__))->typed.type)
;
3212
3213 tmp = GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3213, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim])
;
3214 if (tmp != NULL_TREE(tree) __null)
3215 return tmp;
3216
3217 /* This should only ever happen when passing an assumed shape array
3218 as an actual parameter. The value will never be used. */
3219 if (GFC_ARRAY_TYPE_P (TREE_TYPE (descriptor))((tree_class_check ((((contains_struct_check ((descriptor), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3219, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3219, __FUNCTION__))->type_common.lang_flag_2)
)
3220 return gfc_index_zero_nodegfc_rank_cst[0];
3221
3222 tmp = gfc_conv_descriptor_ubound_get (descriptor, gfc_rank_cst[dim]);
3223 return tmp;
3224}
3225
3226
3227/* Generate code to perform an array index bound check. */
3228
3229static tree
3230trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n,
3231 locus * where, bool check_upper)
3232{
3233 tree fault;
3234 tree tmp_lo, tmp_up;
3235 tree descriptor;
3236 char *msg;
3237 const char * name = NULL__null;
3238
3239 if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0)))
3240 return index;
3241
3242 descriptor = ss->info->data.array.descriptor;
3243
3244 index = gfc_evaluate_now (index, &se->pre);
3245
3246 /* We find a name for the error message. */
3247 name = ss->info->expr->symtree->n.sym->name;
3248 gcc_assert (name != NULL)((void)(!(name != __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3248, __FUNCTION__), 0 : 0))
;
3249
3250 if (VAR_P (descriptor)(((enum tree_code) (descriptor)->base.code) == VAR_DECL))
3251 name = IDENTIFIER_POINTER (DECL_NAME (descriptor))((const char *) (tree_check ((((contains_struct_check ((descriptor
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3251, __FUNCTION__))->decl_minimal.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3251, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
;
3252
3253 /* If upper bound is present, include both bounds in the error message. */
3254 if (check_upper)
3255 {
3256 tmp_lo = gfc_conv_array_lbound (descriptor, n);
3257 tmp_up = gfc_conv_array_ubound (descriptor, n);
3258
3259 if (name)
3260 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
3261 "outside of expected range (%%ld:%%ld)", n+1, name);
3262 else
3263 msg = xasprintf ("Index '%%ld' of dimension %d "
3264 "outside of expected range (%%ld:%%ld)", n+1);
3265
3266 fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
3267 index, tmp_lo);
3268 gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
3269 fold_convert (long_integer_type_node, index)fold_convert_loc (((location_t) 0), integer_types[itk_long], index
)
,
3270 fold_convert (long_integer_type_node, tmp_lo)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_lo
)
,
3271 fold_convert (long_integer_type_node, tmp_up)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_up
)
);
3272 fault = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
3273 index, tmp_up);
3274 gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
3275 fold_convert (long_integer_type_node, index)fold_convert_loc (((location_t) 0), integer_types[itk_long], index
)
,
3276 fold_convert (long_integer_type_node, tmp_lo)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_lo
)
,
3277 fold_convert (long_integer_type_node, tmp_up)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_up
)
);
3278 free (msg);
3279 }
3280 else
3281 {
3282 tmp_lo = gfc_conv_array_lbound (descriptor, n);
3283
3284 if (name)
3285 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
3286 "below lower bound of %%ld", n+1, name);
3287 else
3288 msg = xasprintf ("Index '%%ld' of dimension %d "
3289 "below lower bound of %%ld", n+1);
3290
3291 fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
3292 index, tmp_lo);
3293 gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
3294 fold_convert (long_integer_type_node, index)fold_convert_loc (((location_t) 0), integer_types[itk_long], index
)
,
3295 fold_convert (long_integer_type_node, tmp_lo)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp_lo
)
);
3296 free (msg);
3297 }
3298
3299 return index;
3300}
3301
3302
3303/* Return the offset for an index. Performs bound checking for elemental
3304 dimensions. Single element references are processed separately.
3305 DIM is the array dimension, I is the loop dimension. */
3306
3307static tree
3308conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
3309 gfc_array_ref * ar, tree stride)
3310{
3311 gfc_array_info *info;
3312 tree index;
3313 tree desc;
3314 tree data;
3315
3316 info = &ss->info->data.array;
3317
3318 /* Get the index into the array for this dimension. */
3319 if (ar)
3320 {
3321 gcc_assert (ar->type != AR_ELEMENT)((void)(!(ar->type != AR_ELEMENT) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3321, __FUNCTION__), 0 : 0))
;
3322 switch (ar->dimen_type[dim])
3323 {
3324 case DIMEN_THIS_IMAGE:
3325 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3325, __FUNCTION__))
;
3326 break;
3327 case DIMEN_ELEMENT:
3328 /* Elemental dimension. */
3329 gcc_assert (info->subscript[dim]((void)(!(info->subscript[dim] && info->subscript
[dim]->info->type == GFC_SS_SCALAR) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3330, __FUNCTION__), 0 : 0))
3330 && info->subscript[dim]->info->type == GFC_SS_SCALAR)((void)(!(info->subscript[dim] && info->subscript
[dim]->info->type == GFC_SS_SCALAR) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3330, __FUNCTION__), 0 : 0))
;
3331 /* We've already translated this value outside the loop. */
3332 index = info->subscript[dim]->info->data.scalar.value;
3333
3334 index = trans_array_bound_check (se, ss, index, dim, &ar->where,
3335 ar->as->type != AS_ASSUMED_SIZE
3336 || dim < ar->dimen - 1);
3337 break;
3338
3339 case DIMEN_VECTOR:
3340 gcc_assert (info && se->loop)((void)(!(info && se->loop) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3340, __FUNCTION__), 0 : 0))
;
3341 gcc_assert (info->subscript[dim]((void)(!(info->subscript[dim] && info->subscript
[dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3342, __FUNCTION__), 0 : 0))
3342 && info->subscript[dim]->info->type == GFC_SS_VECTOR)((void)(!(info->subscript[dim] && info->subscript
[dim]->info->type == GFC_SS_VECTOR) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3342, __FUNCTION__), 0 : 0))
;
3343 desc = info->subscript[dim]->info->data.array.descriptor;
3344
3345 /* Get a zero-based index into the vector. */
3346 index = fold_build2_loc (input_location, MINUS_EXPR,
3347 gfc_array_index_type,
3348 se->loop->loopvar[i], se->loop->from[i]);
3349
3350 /* Multiply the index by the stride. */
3351 index = fold_build2_loc (input_location, MULT_EXPR,
3352 gfc_array_index_type,
3353 index, gfc_conv_array_stride (desc, 0));
3354
3355 /* Read the vector to get an index into info->descriptor. */
3356 data = build_fold_indirect_ref_loc (input_location,
3357 gfc_conv_array_data (desc));
3358 index = gfc_build_array_ref (data, index, NULL__null);
3359 index = gfc_evaluate_now (index, &se->pre);
3360 index = fold_convert (gfc_array_index_type, index)fold_convert_loc (((location_t) 0), gfc_array_index_type, index
)
;
3361
3362 /* Do any bounds checking on the final info->descriptor index. */
3363 index = trans_array_bound_check (se, ss, index, dim, &ar->where,
3364 ar->as->type != AS_ASSUMED_SIZE
3365 || dim < ar->dimen - 1);
3366 break;
3367
3368 case DIMEN_RANGE:
3369 /* Scalarized dimension. */
3370 gcc_assert (info && se->loop)((void)(!(info && se->loop) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3370, __FUNCTION__), 0 : 0))
;
3371
3372 /* Multiply the loop variable by the stride and delta. */
3373 index = se->loop->loopvar[i];
3374 if (!integer_onep (info->stride[dim]))
3375 index = fold_build2_loc (input_location, MULT_EXPR,
3376 gfc_array_index_type, index,
3377 info->stride[dim]);
3378 if (!integer_zerop (info->delta[dim]))
3379 index = fold_build2_loc (input_location, PLUS_EXPR,
3380 gfc_array_index_type, index,
3381 info->delta[dim]);
3382 break;
3383
3384 default:
3385 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3385, __FUNCTION__))
;
3386 }
3387 }
3388 else
3389 {
3390 /* Temporary array or derived type component. */
3391 gcc_assert (se->loop)((void)(!(se->loop) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3391, __FUNCTION__), 0 : 0))
;
3392 index = se->loop->loopvar[se->loop->order[i]];
3393
3394 /* Pointer functions can have stride[0] different from unity.
3395 Use the stride returned by the function call and stored in
3396 the descriptor for the temporary. */
3397 if (se->ss && se->ss->info->type == GFC_SS_FUNCTION
3398 && se->ss->info->expr
3399 && se->ss->info->expr->symtree
3400 && se->ss->info->expr->symtree->n.sym->result
3401 && se->ss->info->expr->symtree->n.sym->result->attr.pointer)
3402 stride = gfc_conv_descriptor_stride_get (info->descriptor,
3403 gfc_rank_cst[dim]);
3404
3405 if (info->delta[dim] && !integer_zerop (info->delta[dim]))
3406 index = fold_build2_loc (input_location, PLUS_EXPR,
3407 gfc_array_index_type, index, info->delta[dim]);
3408 }
3409
3410 /* Multiply by the stride. */
3411 if (stride != NULL__null && !integer_onep (stride))
3412 index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
3413 index, stride);
3414
3415 return index;
3416}
3417
3418
3419/* Build a scalarized array reference using the vptr 'size'. */
3420
3421static bool
3422build_class_array_ref (gfc_se *se, tree base, tree index)
3423{
3424 tree type;
3425 tree size;
3426 tree offset;
3427 tree decl = NULL_TREE(tree) __null;
3428 tree tmp;
3429 gfc_expr *expr = se->ss->info->expr;
3430 gfc_ref *ref;
3431 gfc_ref *class_ref = NULL__null;
3432 gfc_typespec *ts;
3433
3434 if (se->expr && DECL_P (se->expr)(tree_code_type[(int) (((enum tree_code) (se->expr)->base
.code))] == tcc_declaration)
&& DECL_LANG_SPECIFIC (se->expr)((contains_struct_check ((se->expr), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3434, __FUNCTION__))->decl_common.lang_specific)
3435 && GFC_DECL_SAVED_DESCRIPTOR (se->expr)(((contains_struct_check ((se->expr), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3435, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
3436 && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr)))((tree_class_check ((((contains_struct_check (((((contains_struct_check
((se->expr), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3436, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3436, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3436, __FUNCTION__))->type_common.lang_flag_4)
)
3437 decl = se->expr;
3438 else
3439 {
3440 if (expr == NULL__null
3441 || (expr->ts.type != BT_CLASS
3442 && !gfc_is_class_array_function (expr)
3443 && !gfc_is_class_array_ref (expr, NULL__null)))
3444 return false;
3445
3446 if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS)
3447 ts = &expr->symtree->n.sym->ts;
3448 else
3449 ts = NULL__null;
3450
3451 for (ref = expr->ref; ref; ref = ref->next)
3452 {
3453 if (ref->type == REF_COMPONENT
3454 && ref->u.c.component->ts.type == BT_CLASS
3455 && ref->next && ref->next->type == REF_COMPONENT
3456 && strcmp (ref->next->u.c.component->name, "_data") == 0
3457 && ref->next->next
3458 && ref->next->next->type == REF_ARRAY
3459 && ref->next->next->u.ar.type != AR_ELEMENT)
3460 {
3461 ts = &ref->u.c.component->ts;
3462 class_ref = ref;
3463 break;
3464 }
3465 }
3466
3467 if (ts == NULL__null)
3468 return false;
3469 }
3470
3471 if (class_ref == NULL__null && expr && expr->symtree->n.sym->attr.function
3472 && expr->symtree->n.sym == expr->symtree->n.sym->result
3473 && expr->symtree->n.sym->backend_decl == current_function_decl)
3474 {
3475 decl = gfc_get_fake_result_decl (expr->symtree->n.sym, 0);
3476 }
3477 else if (expr && gfc_is_class_array_function (expr))
3478 {
3479 size = NULL_TREE(tree) __null;
3480 decl = NULL_TREE(tree) __null;
3481 for (tmp = base; tmp; tmp = TREE_OPERAND (tmp, 0)(*((const_cast<tree*> (tree_operand_check ((tmp), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3481, __FUNCTION__)))))
)
3482 {
3483 tree type;
3484 type = TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3484, __FUNCTION__))->typed.type)
;
3485 while (type)
3486 {
3487 if (GFC_CLASS_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3487, __FUNCTION__))->type_common.lang_flag_4)
)
3488 decl = tmp;
3489 if (type != TYPE_CANONICAL (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3489, __FUNCTION__))->type_common.canonical)
)
3490 type = TYPE_CANONICAL (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3490, __FUNCTION__))->type_common.canonical)
;
3491 else
3492 type = NULL_TREE(tree) __null;
3493 }
3494 if (VAR_P (tmp)(((enum tree_code) (tmp)->base.code) == VAR_DECL))
3495 break;
3496 }
3497
3498 if (decl == NULL_TREE(tree) __null)
3499 return false;
3500
3501 se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
3502 }
3503 else if (class_ref == NULL__null)
3504 {
3505 if (decl == NULL_TREE(tree) __null)
3506 decl = expr->symtree->n.sym->backend_decl;
3507 /* For class arrays the tree containing the class is stored in
3508 GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
3509 For all others it's sym's backend_decl directly. */
3510 if (DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3510, __FUNCTION__))->decl_common.lang_specific)
&& GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3510, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
)
3511 decl = GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3511, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
;
3512 }
3513 else
3514 {
3515 /* Remove everything after the last class reference, convert the
3516 expression and then recover its tailend once more. */
3517 gfc_se tmpse;
3518 ref = class_ref->next;
3519 class_ref->next = NULL__null;
3520 gfc_init_se (&tmpse, NULL__null);
3521 gfc_conv_expr (&tmpse, expr);
3522 gfc_add_block_to_block (&se->pre, &tmpse.pre);
3523 decl = tmpse.expr;
3524 class_ref->next = ref;
3525 }
3526
3527 if (POINTER_TYPE_P (TREE_TYPE (decl))(((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3527, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3527, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)
)
3528 decl = build_fold_indirect_ref_loc (input_location, decl);
3529
3530 if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl))((tree_class_check ((((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3530, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3530, __FUNCTION__))->type_common.lang_flag_4)
)
3531 return false;
3532
3533 size = gfc_class_vtab_size_get (decl);
3534
3535 /* For unlimited polymorphic entities then _len component needs to be
3536 multiplied with the size. */
3537 size = gfc_resize_class_size_with_len (&se->pre, decl, size);
3538
3539 size = fold_convert (TREE_TYPE (index), size)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(index), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3539, __FUNCTION__))->typed.type), size)
;
3540
3541 /* Build the address of the element. */
3542 type = TREE_TYPE (TREE_TYPE (base))((contains_struct_check ((((contains_struct_check ((base), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3542, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3542, __FUNCTION__))->typed.type)
;
3543 offset = fold_build2_loc (input_location, MULT_EXPR,
3544 gfc_array_index_type,
3545 index, size);
3546 tmp = gfc_build_addr_expr (pvoid_type_node, base);
3547 tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
3548 tmp = fold_convert (build_pointer_type (type), tmp)fold_convert_loc (((location_t) 0), build_pointer_type (type)
, tmp)
;
3549
3550 /* Return the element in the se expression. */
3551 se->expr = build_fold_indirect_ref_loc (input_location, tmp);
3552 return true;
3553}
3554
3555
3556/* Build a scalarized reference to an array. */
3557
3558static void
3559gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
3560{
3561 gfc_array_info *info;
3562 tree decl = NULL_TREE(tree) __null;
3563 tree index;
3564 tree base;
3565 gfc_ss *ss;
3566 gfc_expr *expr;
3567 int n;
3568
3569 ss = se->ss;
3570 expr = ss->info->expr;
3571 info = &ss->info->data.array;
3572 if (ar)
3573 n = se->loop->order[0];
3574 else
3575 n = 0;
3576
3577 index = conv_array_index_offset (se, ss, ss->dim[n], n, ar, info->stride0);
3578 /* Add the offset for this dimension to the stored offset for all other
3579 dimensions. */
3580 if (info->offset && !integer_zerop (info->offset))
3581 index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
3582 index, info->offset);
3583
3584 base = build_fold_indirect_ref_loc (input_location, info->data);
3585
3586 /* Use the vptr 'size' field to access the element of a class array. */
3587 if (build_class_array_ref (se, base, index))
3588 return;
3589
3590 if (get_CFI_desc (NULL__null, expr, &decl, ar))
3591 decl = build_fold_indirect_ref_loc (input_location, decl);
3592
3593 /* A pointer array component can be detected from its field decl. Fix
3594 the descriptor, mark the resulting variable decl and pass it to
3595 gfc_build_array_ref. */
3596 if (is_pointer_array (info->descriptor)
3597 || (expr && expr->ts.deferred && info->descriptor
3598 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))((tree_class_check ((((contains_struct_check ((info->descriptor
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3598, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3598, __FUNCTION__))->type_common.lang_flag_1)
))
3599 {
3600 if (TREE_CODE (info->descriptor)((enum tree_code) (info->descriptor)->base.code) == COMPONENT_REF)
3601 decl = info->descriptor;
3602 else if (TREE_CODE (info->descriptor)((enum tree_code) (info->descriptor)->base.code) == INDIRECT_REF)
3603 decl = TREE_OPERAND (info->descriptor, 0)(*((const_cast<tree*> (tree_operand_check ((info->descriptor
), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3603, __FUNCTION__)))))
;
3604
3605 if (decl == NULL_TREE(tree) __null)
3606 decl = info->descriptor;
3607 }
3608
3609 se->expr = gfc_build_array_ref (base, index, decl);
3610}
3611
3612
3613/* Translate access of temporary array. */
3614
3615void
3616gfc_conv_tmp_array_ref (gfc_se * se)
3617{
3618 se->string_length = se->ss->info->string_length;
3619 gfc_conv_scalarized_array_ref (se, NULL__null);
3620 gfc_advance_se_ss_chain (se);
3621}
3622
3623/* Add T to the offset pair *OFFSET, *CST_OFFSET. */
3624
3625static void
3626add_to_offset (tree *cst_offset, tree *offset, tree t)
3627{
3628 if (TREE_CODE (t)((enum tree_code) (t)->base.code) == INTEGER_CST)
3629 *cst_offset = int_const_binop (PLUS_EXPR, *cst_offset, t);
3630 else
3631 {
3632 if (!integer_zerop (*offset))
3633 *offset = fold_build2_loc (input_location, PLUS_EXPR,
3634 gfc_array_index_type, *offset, t);
3635 else
3636 *offset = t;
3637 }
3638}
3639
3640
3641static tree
3642build_array_ref (tree desc, tree offset, tree decl, tree vptr)
3643{
3644 tree tmp;
3645 tree type;
3646 tree cdesc;
3647
3648 /* For class arrays the class declaration is stored in the saved
3649 descriptor. */
3650 if (INDIRECT_REF_P (desc)(((enum tree_code) (desc)->base.code) == INDIRECT_REF)
3651 && DECL_LANG_SPECIFIC (TREE_OPERAND (desc, 0))((contains_struct_check (((*((const_cast<tree*> (tree_operand_check
((desc), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3651, __FUNCTION__)))))), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3651, __FUNCTION__))->decl_common.lang_specific)
3652 && GFC_DECL_SAVED_DESCRIPTOR (TREE_OPERAND (desc, 0))(((contains_struct_check (((*((const_cast<tree*> (tree_operand_check
((desc), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3652, __FUNCTION__)))))), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3652, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
)
3653 cdesc = gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR ((((contains_struct_check (((*((const_cast<tree*> (tree_operand_check
((desc), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3654, __FUNCTION__)))))), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3654, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
3654 TREE_OPERAND (desc, 0))(((contains_struct_check (((*((const_cast<tree*> (tree_operand_check
((desc), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3654, __FUNCTION__)))))), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3654, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
);
3655 else
3656 cdesc = desc;
3657
3658 /* Class container types do not always have the GFC_CLASS_TYPE_P
3659 but the canonical type does. */
3660 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (cdesc))((tree_class_check ((((contains_struct_check ((cdesc), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3660, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3660, __FUNCTION__))->type_common.lang_flag_1)
3661 && TREE_CODE (cdesc)((enum tree_code) (cdesc)->base.code) == COMPONENT_REF)
3662 {
3663 type = TREE_TYPE (TREE_OPERAND (cdesc, 0))((contains_struct_check (((*((const_cast<tree*> (tree_operand_check
((cdesc), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3663, __FUNCTION__)))))), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3663, __FUNCTION__))->typed.type)
;
3664 if (TYPE_CANONICAL (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3664, __FUNCTION__))->type_common.canonical)
3665 && GFC_CLASS_TYPE_P (TYPE_CANONICAL (type))((tree_class_check ((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3665, __FUNCTION__))->type_common.canonical)), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3665, __FUNCTION__))->type_common.lang_flag_4)
)
3666 vptr = gfc_class_vptr_get (TREE_OPERAND (cdesc, 0)(*((const_cast<tree*> (tree_operand_check ((cdesc), (0)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3666, __FUNCTION__)))))
);
3667 }
3668
3669 tmp = gfc_conv_array_data (desc);
3670 tmp = build_fold_indirect_ref_loc (input_location, tmp);
3671 tmp = gfc_build_array_ref (tmp, offset, decl, vptr);
3672 return tmp;
3673}
3674
3675
3676/* Build an array reference. se->expr already holds the array descriptor.
3677 This should be either a variable, indirect variable reference or component
3678 reference. For arrays which do not have a descriptor, se->expr will be
3679 the data pointer.
3680 a(i, j, k) = base[offset + i * stride[0] + j * stride[1] + k * stride[2]]*/
3681
3682void
3683gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
3684 locus * where)
3685{
3686 int n;
3687 tree offset, cst_offset;
3688 tree tmp;
3689 tree stride;
3690 tree decl = NULL_TREE(tree) __null;
3691 gfc_se indexse;
3692 gfc_se tmpse;
3693 gfc_symbol * sym = expr->symtree->n.sym;
3694 char *var_name = NULL__null;
3695
3696 if (ar->dimen == 0)
3697 {
3698 gcc_assert (ar->codimen || sym->attr.select_rank_temporary((void)(!(ar->codimen || sym->attr.select_rank_temporary
|| (ar->as && ar->as->corank)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3699, __FUNCTION__), 0 : 0))
3699 || (ar->as && ar->as->corank))((void)(!(ar->codimen || sym->attr.select_rank_temporary
|| (ar->as && ar->as->corank)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3699, __FUNCTION__), 0 : 0))
;
3700
3701 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3701, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3701, __FUNCTION__))->type_common.lang_flag_1)
)
3702 se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr))build_fold_indirect_ref_loc (((location_t) 0), gfc_conv_array_data
(se->expr))
;
3703 else
3704 {
3705 if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3705, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3705, __FUNCTION__))->type_common.lang_flag_2)
3706 && TREE_CODE (TREE_TYPE (se->expr))((enum tree_code) (((contains_struct_check ((se->expr), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3706, __FUNCTION__))->typed.type))->base.code)
== POINTER_TYPE)
3707 se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
3708
3709 /* Use the actual tree type and not the wrapped coarray. */
3710 if (!se->want_pointer)
3711 se->expr = fold_convert (TYPE_MAIN_VARIANT (TREE_TYPE (se->expr)),fold_convert_loc (((location_t) 0), ((tree_class_check ((((contains_struct_check
((se->expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3711, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3711, __FUNCTION__))->type_common.main_variant), se->
expr)
3712 se->expr)fold_convert_loc (((location_t) 0), ((tree_class_check ((((contains_struct_check
((se->expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3711, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3711, __FUNCTION__))->type_common.main_variant), se->
expr)
;
3713 }
3714
3715 return;
3716 }
3717
3718 /* Handle scalarized references separately. */
3719 if (ar->type != AR_ELEMENT)
3720 {
3721 gfc_conv_scalarized_array_ref (se, ar);
3722 gfc_advance_se_ss_chain (se);
3723 return;
3724 }
3725
3726 if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
3727 {
3728 size_t len;
3729 gfc_ref *ref;
3730
3731 len = strlen (sym->name) + 1;
3732 for (ref = expr->ref; ref; ref = ref->next)
3733 {
3734 if (ref->type == REF_ARRAY && &ref->u.ar == ar)
3735 break;
3736 if (ref->type == REF_COMPONENT)
3737 len += 2 + strlen (ref->u.c.component->name);
3738 }
3739
3740 var_name = XALLOCAVEC (char, len)((char *) __builtin_alloca(sizeof (char) * (len)));
3741 strcpy (var_name, sym->name);
3742
3743 for (ref = expr->ref; ref; ref = ref->next)
3744 {
3745 if (ref->type == REF_ARRAY && &ref->u.ar == ar)
3746 break;
3747 if (ref->type == REF_COMPONENT)
3748 {
3749 strcat (var_name, "%%");
3750 strcat (var_name, ref->u.c.component->name);
3751 }
3752 }
3753 }
3754
3755 decl = se->expr;
3756 if (IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer)
&& sym->attr.dummy && ar->as->type != AS_DEFERRED)
3757 decl = sym->backend_decl;
3758
3759 cst_offset = offset = gfc_index_zero_nodegfc_rank_cst[0];
3760 add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (decl));
3761
3762 /* Calculate the offsets from all the dimensions. Make sure to associate
3763 the final offset so that we form a chain of loop invariant summands. */
3764 for (n = ar->dimen - 1; n >= 0; n--)
3765 {
3766 /* Calculate the index for this dimension. */
3767 gfc_init_se (&indexse, se);
3768 gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
3769 gfc_add_block_to_block (&se->pre, &indexse.pre);
3770
3771 if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0)) && ! expr->no_bounds_check)
3772 {
3773 /* Check array bounds. */
3774 tree cond;
3775 char *msg;
3776
3777 /* Evaluate the indexse.expr only once. */
3778 indexse.expr = save_expr (indexse.expr);
3779
3780 /* Lower bound. */
3781 tmp = gfc_conv_array_lbound (decl, n);
3782 if (sym->attr.temporary)
3783 {
3784 gfc_init_se (&tmpse, se);
3785 gfc_conv_expr_type (&tmpse, ar->as->lower[n],
3786 gfc_array_index_type);
3787 gfc_add_block_to_block (&se->pre, &tmpse.pre);
3788 tmp = tmpse.expr;
3789 }
3790
3791 cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
3792 indexse.expr, tmp);
3793 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
3794 "below lower bound of %%ld", n+1, var_name);
3795 gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
3796 fold_convert (long_integer_type_node,fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse
.expr)
3797 indexse.expr)fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse
.expr)
,
3798 fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp
)
);
3799 free (msg);
3800
3801 /* Upper bound, but not for the last dimension of assumed-size
3802 arrays. */
3803 if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE)
3804 {
3805 tmp = gfc_conv_array_ubound (decl, n);
3806 if (sym->attr.temporary)
3807 {
3808 gfc_init_se (&tmpse, se);
3809 gfc_conv_expr_type (&tmpse, ar->as->upper[n],
3810 gfc_array_index_type);
3811 gfc_add_block_to_block (&se->pre, &tmpse.pre);
3812 tmp = tmpse.expr;
3813 }
3814
3815 cond = fold_build2_loc (input_location, GT_EXPR,
3816 logical_type_node, indexse.expr, tmp);
3817 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
3818 "above upper bound of %%ld", n+1, var_name);
3819 gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
3820 fold_convert (long_integer_type_node,fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse
.expr)
3821 indexse.expr)fold_convert_loc (((location_t) 0), integer_types[itk_long], indexse
.expr)
,
3822 fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp
)
);
3823 free (msg);
3824 }
3825 }
3826
3827 /* Multiply the index by the stride. */
3828 stride = gfc_conv_array_stride (decl, n);
3829 tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
3830 indexse.expr, stride);
3831
3832 /* And add it to the total. */
3833 add_to_offset (&cst_offset, &offset, tmp);
3834 }
3835
3836 if (!integer_zerop (cst_offset))
3837 offset = fold_build2_loc (input_location, PLUS_EXPR,
3838 gfc_array_index_type, offset, cst_offset);
3839
3840 /* A pointer array component can be detected from its field decl. Fix
3841 the descriptor, mark the resulting variable decl and pass it to
3842 build_array_ref. */
3843 decl = NULL_TREE(tree) __null;
3844 if (get_CFI_desc (sym, expr, &decl, ar))
3845 decl = build_fold_indirect_ref_loc (input_location, decl);
3846 if (!expr->ts.deferred && !sym->attr.codimension
3847 && is_pointer_array (se->expr))
3848 {
3849 if (TREE_CODE (se->expr)((enum tree_code) (se->expr)->base.code) == COMPONENT_REF)
3850 decl = se->expr;
3851 else if (TREE_CODE (se->expr)((enum tree_code) (se->expr)->base.code) == INDIRECT_REF)
3852 decl = TREE_OPERAND (se->expr, 0)(*((const_cast<tree*> (tree_operand_check ((se->expr
), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3852, __FUNCTION__)))))
;
3853 else
3854 decl = se->expr;
3855 }
3856 else if (expr->ts.deferred
3857 || (sym->ts.type == BT_CHARACTER
3858 && sym->attr.select_type_temporary))
3859 {
3860 if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr))((tree_class_check ((((contains_struct_check ((se->expr), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3860, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3860, __FUNCTION__))->type_common.lang_flag_1)
)
3861 {
3862 decl = se->expr;
3863 if (TREE_CODE (decl)((enum tree_code) (decl)->base.code) == INDIRECT_REF)
3864 decl = TREE_OPERAND (decl, 0)(*((const_cast<tree*> (tree_operand_check ((decl), (0),
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3864, __FUNCTION__)))))
;
3865 }
3866 else
3867 decl = sym->backend_decl;
3868 }
3869 else if (sym->ts.type == BT_CLASS)
3870 {
3871 if (UNLIMITED_POLY (sym)(sym != __null && sym->ts.type == BT_CLASS &&
sym->ts.u.derived->components && sym->ts.u.
derived->components->ts.u.derived && sym->ts
.u.derived->components->ts.u.derived->attr.unlimited_polymorphic
)
)
3872 {
3873 gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (expr);
3874 gfc_init_se (&tmpse, NULL__null);
3875 gfc_conv_expr (&tmpse, class_expr);
3876 if (!se->class_vptr)
3877 se->class_vptr = gfc_class_vptr_get (tmpse.expr);
3878 gfc_free_expr (class_expr);
3879 decl = tmpse.expr;
3880 }
3881 else
3882 decl = NULL_TREE(tree) __null;
3883 }
3884
3885 se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
3886}
3887
3888
3889/* Add the offset corresponding to array's ARRAY_DIM dimension and loop's
3890 LOOP_DIM dimension (if any) to array's offset. */
3891
3892static void
3893add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss,
3894 gfc_array_ref *ar, int array_dim, int loop_dim)
3895{
3896 gfc_se se;
3897 gfc_array_info *info;
3898 tree stride, index;
3899
3900 info = &ss->info->data.array;
3901
3902 gfc_init_se (&se, NULL__null);
3903 se.loop = loop;
3904 se.expr = info->descriptor;
3905 stride = gfc_conv_array_stride (info->descriptor, array_dim);
3906 index = conv_array_index_offset (&se, ss, array_dim, loop_dim, ar, stride);
3907 gfc_add_block_to_block (pblock, &se.pre);
3908
3909 info->offset = fold_build2_loc (input_location, PLUS_EXPR,
3910 gfc_array_index_type,
3911 info->offset, index);
3912 info->offset = gfc_evaluate_now (info->offset, pblock);
3913}
3914
3915
3916/* Generate the code to be executed immediately before entering a
3917 scalarization loop. */
3918
3919static void
3920gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
3921 stmtblock_t * pblock)
3922{
3923 tree stride;
3924 gfc_ss_info *ss_info;
3925 gfc_array_info *info;
3926 gfc_ss_type ss_type;
3927 gfc_ss *ss, *pss;
3928 gfc_loopinfo *ploop;
3929 gfc_array_ref *ar;
3930 int i;
3931
3932 /* This code will be executed before entering the scalarization loop
3933 for this dimension. */
3934 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
3935 {
3936 ss_info = ss->info;
3937
3938 if ((ss_info->useflags & flag) == 0)
3939 continue;
3940
3941 ss_type = ss_info->type;
3942 if (ss_type != GFC_SS_SECTION
3943 && ss_type != GFC_SS_FUNCTION
3944 && ss_type != GFC_SS_CONSTRUCTOR
3945 && ss_type != GFC_SS_COMPONENT)
3946 continue;
3947
3948 info = &ss_info->data.array;
3949
3950 gcc_assert (dim < ss->dimen)((void)(!(dim < ss->dimen) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3950, __FUNCTION__), 0 : 0))
;
3951 gcc_assert (ss->dimen == loop->dimen)((void)(!(ss->dimen == loop->dimen) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3951, __FUNCTION__), 0 : 0))
;
3952
3953 if (info->ref)
3954 ar = &info->ref->u.ar;
3955 else
3956 ar = NULL__null;
3957
3958 if (dim == loop->dimen - 1 && loop->parent != NULL__null)
3959 {
3960 /* If we are in the outermost dimension of this loop, the previous
3961 dimension shall be in the parent loop. */
3962 gcc_assert (ss->parent != NULL)((void)(!(ss->parent != __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3962, __FUNCTION__), 0 : 0))
;
3963
3964 pss = ss->parent;
3965 ploop = loop->parent;
3966
3967 /* ss and ss->parent are about the same array. */
3968 gcc_assert (ss_info == pss->info)((void)(!(ss_info == pss->info) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3968, __FUNCTION__), 0 : 0))
;
3969 }
3970 else
3971 {
3972 ploop = loop;
3973 pss = ss;
3974 }
3975
3976 if (dim == loop->dimen - 1)
3977 i = 0;
3978 else
3979 i = dim + 1;
3980
3981 /* For the time being, there is no loop reordering. */
3982 gcc_assert (i == ploop->order[i])((void)(!(i == ploop->order[i]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 3982, __FUNCTION__), 0 : 0))
;
3983 i = ploop->order[i];
3984
3985 if (dim == loop->dimen - 1 && loop->parent == NULL__null)
3986 {
3987 stride = gfc_conv_array_stride (info->descriptor,
3988 innermost_ss (ss)->dim[i]);
3989
3990 /* Calculate the stride of the innermost loop. Hopefully this will
3991 allow the backend optimizers to do their stuff more effectively.
3992 */
3993 info->stride0 = gfc_evaluate_now (stride, pblock);
3994
3995 /* For the outermost loop calculate the offset due to any
3996 elemental dimensions. It will have been initialized with the
3997 base offset of the array. */
3998 if (info->ref)
3999 {
4000 for (i = 0; i < ar->dimen; i++)
4001 {
4002 if (ar->dimen_type[i] != DIMEN_ELEMENT)
4003 continue;
4004
4005 add_array_offset (pblock, loop, ss, ar, i, /* unused */ -1);
4006 }
4007 }
4008 }
4009 else
4010 /* Add the offset for the previous loop dimension. */
4011 add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
4012
4013 /* Remember this offset for the second loop. */
4014 if (dim == loop->temp_dim - 1 && loop->parent == NULL__null)
4015 info->saved_offset = info->offset;
4016 }
4017}
4018
4019
4020/* Start a scalarized expression. Creates a scope and declares loop
4021 variables. */
4022
4023void
4024gfc_start_scalarized_body (gfc_loopinfo * loop, stmtblock_t * pbody)
4025{
4026 int dim;
4027 int n;
4028 int flags;
4029
4030 gcc_assert (!loop->array_parameter)((void)(!(!loop->array_parameter) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4030, __FUNCTION__), 0 : 0))
;
4031
4032 for (dim = loop->dimen - 1; dim >= 0; dim--)
4033 {
4034 n = loop->order[dim];
4035
4036 gfc_start_block (&loop->code[n]);
4037
4038 /* Create the loop variable. */
4039 loop->loopvar[n] = gfc_create_var (gfc_array_index_type, "S");
4040
4041 if (dim < loop->temp_dim)
4042 flags = 3;
4043 else
4044 flags = 1;
4045 /* Calculate values that will be constant within this loop. */
4046 gfc_trans_preloop_setup (loop, dim, flags, &loop->code[n]);
4047 }
4048 gfc_start_block (pbody);
4049}
4050
4051
4052/* Generates the actual loop code for a scalarization loop. */
4053
4054void
4055gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
4056 stmtblock_t * pbody)
4057{
4058 stmtblock_t block;
4059 tree cond;
4060 tree tmp;
4061 tree loopbody;
4062 tree exit_label;
4063 tree stmt;
4064 tree init;
4065 tree incr;
4066
4067 if ((ompws_flags & (OMPWS_WORKSHARE_FLAG1 | OMPWS_SCALARIZER_WS4
4068 | OMPWS_SCALARIZER_BODY8))
4069 == (OMPWS_WORKSHARE_FLAG1 | OMPWS_SCALARIZER_WS4)
4070 && n == loop->dimen - 1)
4071 {
4072 /* We create an OMP_FOR construct for the outermost scalarized loop. */
4073 init = make_tree_vec (1);
4074 cond = make_tree_vec (1);
4075 incr = make_tree_vec (1);
4076
4077 /* Cycle statement is implemented with a goto. Exit statement must not
4078 be present for this loop. */
4079 exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
4080 TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
4081
4082 /* Label for cycle statements (if needed). */
4083 tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE
], exit_label)
;
4084 gfc_add_expr_to_block (pbody, tmp);
4085
4086 stmt = make_node (OMP_FOR);
4087
4088 TREE_TYPE (stmt)((contains_struct_check ((stmt), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4088, __FUNCTION__))->typed.type)
= void_type_nodeglobal_trees[TI_VOID_TYPE];
4089 OMP_FOR_BODY (stmt)(*((const_cast<tree*> (tree_operand_check (((tree_range_check
((stmt), (OMP_FOR), (OACC_LOOP), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4089, __FUNCTION__))), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4089, __FUNCTION__)))))
= loopbody = gfc_finish_block (pbody);
4090
4091 OMP_FOR_CLAUSES (stmt)(*((const_cast<tree*> (tree_operand_check (((tree_range_check
((stmt), (OMP_FOR), (OACC_LOOP), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4091, __FUNCTION__))), (1), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4091, __FUNCTION__)))))
= build_omp_clause (input_location,
4092 OMP_CLAUSE_SCHEDULE);
4093 OMP_CLAUSE_SCHEDULE_KIND (OMP_FOR_CLAUSES (stmt))((omp_clause_subcode_check (((*((const_cast<tree*> (tree_operand_check
(((tree_range_check ((stmt), (OMP_FOR), (OACC_LOOP), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4093, __FUNCTION__))), (1), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4093, __FUNCTION__)))))), (OMP_CLAUSE_SCHEDULE), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4093, __FUNCTION__))->omp_clause.subcode.schedule_kind)
4094 = OMP_CLAUSE_SCHEDULE_STATIC;
4095 if (ompws_flags & OMPWS_NOWAIT16)
4096 OMP_CLAUSE_CHAIN (OMP_FOR_CLAUSES (stmt))((contains_struct_check (((tree_check (((*((const_cast<tree
*> (tree_operand_check (((tree_range_check ((stmt), (OMP_FOR
), (OACC_LOOP), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4096, __FUNCTION__))), (1), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4096, __FUNCTION__)))))), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4096, __FUNCTION__, (OMP_CLAUSE)))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4096, __FUNCTION__))->common.chain)
4097 = build_omp_clause (input_location, OMP_CLAUSE_NOWAIT);
4098
4099 /* Initialize the loopvar. */
4100 TREE_VEC_ELT (init, 0)(*((const_cast<tree *> (tree_vec_elt_check ((init), (0)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4100, __FUNCTION__)))))
= build2_v (MODIFY_EXPR, loop->loopvar[n],fold_build2_loc (input_location, MODIFY_EXPR, global_trees[TI_VOID_TYPE
], loop->loopvar[n], loop->from[n])
4101 loop->from[n])fold_build2_loc (input_location, MODIFY_EXPR, global_trees[TI_VOID_TYPE
], loop->loopvar[n], loop->from[n])
;
4102 OMP_FOR_INIT (stmt)(*((const_cast<tree*> (tree_operand_check (((tree_range_check
((stmt), (OMP_FOR), (OACC_LOOP), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4102, __FUNCTION__))), (2), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4102, __FUNCTION__)))))
= init;
4103 /* The exit condition. */
4104 TREE_VEC_ELT (cond, 0)(*((const_cast<tree *> (tree_vec_elt_check ((cond), (0)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4104, __FUNCTION__)))))
= build2_loc (input_location, LE_EXPR,
4105 logical_type_node,
4106 loop->loopvar[n], loop->to[n]);
4107 SET_EXPR_LOCATION (TREE_VEC_ELT (cond, 0), input_location)(expr_check ((((*((const_cast<tree *> (tree_vec_elt_check
((cond), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4107, __FUNCTION__))))))), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4107, __FUNCTION__))->exp.locus = (input_location)
;
4108 OMP_FOR_COND (stmt)(*((const_cast<tree*> (tree_operand_check (((tree_range_check
((stmt), (OMP_FOR), (OACC_LOOP), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4108, __FUNCTION__))), (3), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4108, __FUNCTION__)))))
= cond;
4109 /* Increment the loopvar. */
4110 tmp = build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4111 loop->loopvar[n], gfc_index_one_nodegfc_rank_cst[1]);
4112 TREE_VEC_ELT (incr, 0)(*((const_cast<tree *> (tree_vec_elt_check ((incr), (0)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4112, __FUNCTION__)))))
= fold_build2_loc (input_location, MODIFY_EXPR,
4113 void_type_nodeglobal_trees[TI_VOID_TYPE], loop->loopvar[n], tmp);
4114 OMP_FOR_INCR (stmt)(*((const_cast<tree*> (tree_operand_check (((tree_range_check
((stmt), (OMP_FOR), (OACC_LOOP), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4114, __FUNCTION__))), (4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4114, __FUNCTION__)))))
= incr;
4115
4116 ompws_flags &= ~OMPWS_CURR_SINGLEUNIT2;
4117 gfc_add_expr_to_block (&loop->code[n], stmt);
4118 }
4119 else
4120 {
4121 bool reverse_loop = (loop->reverse[n] == GFC_REVERSE_SET)
4122 && (loop->temp_ss == NULL__null);
4123
4124 loopbody = gfc_finish_block (pbody);
4125
4126 if (reverse_loop)
4127 std::swap (loop->from[n], loop->to[n]);
4128
4129 /* Initialize the loopvar. */
4130 if (loop->loopvar[n] != loop->from[n])
4131 gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
4132
4133 exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
4134
4135 /* Generate the loop body. */
4136 gfc_init_block (&block);
4137
4138 /* The exit condition. */
4139 cond = fold_build2_loc (input_location, reverse_loop ? LT_EXPR : GT_EXPR,
4140 logical_type_node, loop->loopvar[n], loop->to[n]);
4141 tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE
], exit_label)
;
4142 TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
4143 tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], cond, tmp, build_empty_stmt (input_location))
;
4144 gfc_add_expr_to_block (&block, tmp);
4145
4146 /* The main body. */
4147 gfc_add_expr_to_block (&block, loopbody);
4148
4149 /* Increment the loopvar. */
4150 tmp = fold_build2_loc (input_location,
4151 reverse_loop ? MINUS_EXPR : PLUS_EXPR,
4152 gfc_array_index_type, loop->loopvar[n],
4153 gfc_index_one_nodegfc_rank_cst[1]);
4154
4155 gfc_add_modify (&block, loop->loopvar[n], tmp);
4156
4157 /* Build the loop. */
4158 tmp = gfc_finish_block (&block);
4159 tmp = build1_v (LOOP_EXPR, tmp)fold_build1_loc (input_location, LOOP_EXPR, global_trees[TI_VOID_TYPE
], tmp)
;
4160 gfc_add_expr_to_block (&loop->code[n], tmp);
4161
4162 /* Add the exit label. */
4163 tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE
], exit_label)
;
4164 gfc_add_expr_to_block (&loop->code[n], tmp);
4165 }
4166
4167}
4168
4169
4170/* Finishes and generates the loops for a scalarized expression. */
4171
4172void
4173gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body)
4174{
4175 int dim;
4176 int n;
4177 gfc_ss *ss;
4178 stmtblock_t *pblock;
4179 tree tmp;
4180
4181 pblock = body;
4182 /* Generate the loops. */
4183 for (dim = 0; dim < loop->dimen; dim++)
4184 {
4185 n = loop->order[dim];
4186 gfc_trans_scalarized_loop_end (loop, n, pblock);
4187 loop->loopvar[n] = NULL_TREE(tree) __null;
4188 pblock = &loop->code[n];
4189 }
4190
4191 tmp = gfc_finish_block (pblock);
4192 gfc_add_expr_to_block (&loop->pre, tmp);
4193
4194 /* Clear all the used flags. */
4195 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4196 if (ss->parent == NULL__null)
4197 ss->info->useflags = 0;
4198}
4199
4200
4201/* Finish the main body of a scalarized expression, and start the secondary
4202 copying body. */
4203
4204void
4205gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
4206{
4207 int dim;
4208 int n;
4209 stmtblock_t *pblock;
4210 gfc_ss *ss;
4211
4212 pblock = body;
4213 /* We finish as many loops as are used by the temporary. */
4214 for (dim = 0; dim < loop->temp_dim - 1; dim++)
4215 {
4216 n = loop->order[dim];
4217 gfc_trans_scalarized_loop_end (loop, n, pblock);
4218 loop->loopvar[n] = NULL_TREE(tree) __null;
4219 pblock = &loop->code[n];
4220 }
4221
4222 /* We don't want to finish the outermost loop entirely. */
4223 n = loop->order[loop->temp_dim - 1];
4224 gfc_trans_scalarized_loop_end (loop, n, pblock);
4225
4226 /* Restore the initial offsets. */
4227 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4228 {
4229 gfc_ss_type ss_type;
4230 gfc_ss_info *ss_info;
4231
4232 ss_info = ss->info;
4233
4234 if ((ss_info->useflags & 2) == 0)
4235 continue;
4236
4237 ss_type = ss_info->type;
4238 if (ss_type != GFC_SS_SECTION
4239 && ss_type != GFC_SS_FUNCTION
4240 && ss_type != GFC_SS_CONSTRUCTOR
4241 && ss_type != GFC_SS_COMPONENT)
4242 continue;
4243
4244 ss_info->data.array.offset = ss_info->data.array.saved_offset;
4245 }
4246
4247 /* Restart all the inner loops we just finished. */
4248 for (dim = loop->temp_dim - 2; dim >= 0; dim--)
4249 {
4250 n = loop->order[dim];
4251
4252 gfc_start_block (&loop->code[n]);
4253
4254 loop->loopvar[n] = gfc_create_var (gfc_array_index_type, "Q");
4255
4256 gfc_trans_preloop_setup (loop, dim, 2, &loop->code[n]);
4257 }
4258
4259 /* Start a block for the secondary copying code. */
4260 gfc_start_block (body);
4261}
4262
4263
4264/* Precalculate (either lower or upper) bound of an array section.
4265 BLOCK: Block in which the (pre)calculation code will go.
4266 BOUNDS[DIM]: Where the bound value will be stored once evaluated.
4267 VALUES[DIM]: Specified bound (NULL <=> unspecified).
4268 DESC: Array descriptor from which the bound will be picked if unspecified
4269 (either lower or upper bound according to LBOUND). */
4270
4271static void
4272evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values,
4273 tree desc, int dim, bool lbound, bool deferred)
4274{
4275 gfc_se se;
4276 gfc_expr * input_val = values[dim];
4277 tree *output = &bounds[dim];
4278
4279
4280 if (input_val)
4281 {
4282 /* Specified section bound. */
4283 gfc_init_se (&se, NULL__null);
4284 gfc_conv_expr_type (&se, input_val, gfc_array_index_type);
4285 gfc_add_block_to_block (block, &se.pre);
4286 *output = se.expr;
4287 }
4288 else if (deferred && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))((tree_class_check ((((contains_struct_check ((desc), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4288, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4288, __FUNCTION__))->type_common.lang_flag_1)
)
4289 {
4290 /* The gfc_conv_array_lbound () routine returns a constant zero for
4291 deferred length arrays, which in the scalarizer wreaks havoc, when
4292 copying to a (newly allocated) one-based array.
4293 Keep returning the actual result in sync for both bounds. */
4294 *output = lbound ? gfc_conv_descriptor_lbound_get (desc,
4295 gfc_rank_cst[dim]):
4296 gfc_conv_descriptor_ubound_get (desc,
4297 gfc_rank_cst[dim]);
4298 }
4299 else
4300 {
4301 /* No specific bound specified so use the bound of the array. */
4302 *output = lbound ? gfc_conv_array_lbound (desc, dim) :
4303 gfc_conv_array_ubound (desc, dim);
4304 }
4305 *output = gfc_evaluate_now (*output, block);
4306}
4307
4308
4309/* Calculate the lower bound of an array section. */
4310
4311static void
4312gfc_conv_section_startstride (stmtblock_t * block, gfc_ss * ss, int dim)
4313{
4314 gfc_expr *stride = NULL__null;
4315 tree desc;
4316 gfc_se se;
4317 gfc_array_info *info;
4318 gfc_array_ref *ar;
4319
4320 gcc_assert (ss->info->type == GFC_SS_SECTION)((void)(!(ss->info->type == GFC_SS_SECTION) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4320, __FUNCTION__), 0 : 0))
;
4321
4322 info = &ss->info->data.array;
4323 ar = &info->ref->u.ar;
4324
4325 if (ar->dimen_type[dim] == DIMEN_VECTOR)
4326 {
4327 /* We use a zero-based index to access the vector. */
4328 info->start[dim] = gfc_index_zero_nodegfc_rank_cst[0];
4329 info->end[dim] = NULL__null;
4330 info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
4331 return;
4332 }
4333
4334 gcc_assert (ar->dimen_type[dim] == DIMEN_RANGE((void)(!(ar->dimen_type[dim] == DIMEN_RANGE || ar->dimen_type
[dim] == DIMEN_THIS_IMAGE) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4335, __FUNCTION__), 0 : 0))
4335 || ar->dimen_type[dim] == DIMEN_THIS_IMAGE)((void)(!(ar->dimen_type[dim] == DIMEN_RANGE || ar->dimen_type
[dim] == DIMEN_THIS_IMAGE) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4335, __FUNCTION__), 0 : 0))
;
4336 desc = info->descriptor;
4337 stride = ar->stride[dim];
4338
4339
4340 /* Calculate the start of the range. For vector subscripts this will
4341 be the range of the vector. */
4342 evaluate_bound (block, info->start, ar->start, desc, dim, true,
4343 ar->as->type == AS_DEFERRED);
4344
4345 /* Similarly calculate the end. Although this is not used in the
4346 scalarizer, it is needed when checking bounds and where the end
4347 is an expression with side-effects. */
4348 evaluate_bound (block, info->end, ar->end, desc, dim, false,
4349 ar->as->type == AS_DEFERRED);
4350
4351
4352 /* Calculate the stride. */
4353 if (stride == NULL__null)
4354 info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
4355 else
4356 {
4357 gfc_init_se (&se, NULL__null);
4358 gfc_conv_expr_type (&se, stride, gfc_array_index_type);
4359 gfc_add_block_to_block (block, &se.pre);
4360 info->stride[dim] = gfc_evaluate_now (se.expr, block);
4361 }
4362}
4363
4364
4365/* Calculates the range start and stride for a SS chain. Also gets the
4366 descriptor and data pointer. The range of vector subscripts is the size
4367 of the vector. Array bounds are also checked. */
4368
4369void
4370gfc_conv_ss_startstride (gfc_loopinfo * loop)
4371{
4372 int n;
4373 tree tmp;
4374 gfc_ss *ss;
4375 tree desc;
4376
4377 gfc_loopinfo * const outer_loop = outermost_loop (loop);
4378
4379 loop->dimen = 0;
4380 /* Determine the rank of the loop. */
4381 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4382 {
4383 switch (ss->info->type)
4384 {
4385 case GFC_SS_SECTION:
4386 case GFC_SS_CONSTRUCTOR:
4387 case GFC_SS_FUNCTION:
4388 case GFC_SS_COMPONENT:
4389 loop->dimen = ss->dimen;
4390 goto done;
4391
4392 /* As usual, lbound and ubound are exceptions!. */
4393 case GFC_SS_INTRINSIC:
4394 switch (ss->info->expr->value.function.isym->id)
4395 {
4396 case GFC_ISYM_LBOUND:
4397 case GFC_ISYM_UBOUND:
4398 case GFC_ISYM_LCOBOUND:
4399 case GFC_ISYM_UCOBOUND:
4400 case GFC_ISYM_THIS_IMAGE:
4401 loop->dimen = ss->dimen;
4402 goto done;
4403
4404 default:
4405 break;
4406 }
4407
4408 default:
4409 break;
4410 }
4411 }
4412
4413 /* We should have determined the rank of the expression by now. If
4414 not, that's bad news. */
4415 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4415, __FUNCTION__))
;
4416
4417done:
4418 /* Loop over all the SS in the chain. */
4419 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4420 {
4421 gfc_ss_info *ss_info;
4422 gfc_array_info *info;
4423 gfc_expr *expr;
4424
4425 ss_info = ss->info;
4426 expr = ss_info->expr;
4427 info = &ss_info->data.array;
4428
4429 if (expr && expr->shape && !info->shape)
4430 info->shape = expr->shape;
4431
4432 switch (ss_info->type)
4433 {
4434 case GFC_SS_SECTION:
4435 /* Get the descriptor for the array. If it is a cross loops array,
4436 we got the descriptor already in the outermost loop. */
4437 if (ss->parent == NULL__null)
4438 gfc_conv_ss_descriptor (&outer_loop->pre, ss,
4439 !loop->array_parameter);
4440
4441 for (n = 0; n < ss->dimen; n++)
4442 gfc_conv_section_startstride (&outer_loop->pre, ss, ss->dim[n]);
4443 break;
4444
4445 case GFC_SS_INTRINSIC:
4446 switch (expr->value.function.isym->id)
4447 {
4448 /* Fall through to supply start and stride. */
4449 case GFC_ISYM_LBOUND:
4450 case GFC_ISYM_UBOUND:
4451 {
4452 gfc_expr *arg;
4453
4454 /* This is the variant without DIM=... */
4455 gcc_assert (expr->value.function.actual->next->expr == NULL)((void)(!(expr->value.function.actual->next->expr ==
__null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4455, __FUNCTION__), 0 : 0))
;
4456
4457 arg = expr->value.function.actual->expr;
4458 if (arg->rank == -1)
4459 {
4460 gfc_se se;
4461 tree rank, tmp;
4462
4463 /* The rank (hence the return value's shape) is unknown,
4464 we have to retrieve it. */
4465 gfc_init_se (&se, NULL__null);
4466 se.descriptor_only = 1;
4467 gfc_conv_expr (&se, arg);
4468 /* This is a bare variable, so there is no preliminary
4469 or cleanup code. */
4470 gcc_assert (se.pre.head == NULL_TREE((void)(!(se.pre.head == (tree) __null && se.post.head
== (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4471, __FUNCTION__), 0 : 0))
4471 && se.post.head == NULL_TREE)((void)(!(se.pre.head == (tree) __null && se.post.head
== (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 4471, __FUNCTION__), 0 : 0))
;
4472 rank = gfc_conv_descriptor_rank (se.expr);
4473 tmp = fold_build2_loc (input_location, MINUS_EXPR,
4474 gfc_array_index_type,
4475 fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, rank
)
4476 rank)fold_convert_loc (((location_t) 0), gfc_array_index_type, rank
)
,
4477 gfc_index_one_nodegfc_rank_cst[1]);
4478 info->end[0] = gfc_evaluate_now (tmp, &outer_loop->pre);
4479 info->start[0] = gfc_index_zero_nodegfc_rank_cst[0];
4480 info->stride[0] = gfc_index_one_nodegfc_rank_cst[1];
4481 continue;
4482 }
4483 /* Otherwise fall through GFC_SS_FUNCTION. */
4484 gcc_fallthrough ();
4485 }
4486 case GFC_ISYM_LCOBOUND:
4487 case GFC_ISYM_UCOBOUND:
4488 case GFC_ISYM_THIS_IMAGE:
4489 break;
4490
4491 default:
4492 continue;
4493 }
4494
4495 /* FALLTHRU */
4496 case GFC_SS_CONSTRUCTOR:
4497 case GFC_SS_FUNCTION:
4498 for (n = 0; n < ss->dimen; n++)
4499 {
4500 int dim = ss->dim[n];
4501
4502 info->start[dim] = gfc_index_zero_nodegfc_rank_cst[0];
4503 info->end[dim] = gfc_index_zero_nodegfc_rank_cst[0];
4504 info->stride[dim] = gfc_index_one_nodegfc_rank_cst[1];
4505 }
4506 break;
4507
4508 default:
4509 break;
4510 }
4511 }
4512
4513 /* The rest is just runtime bounds checking. */
4514 if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
4515 {
4516 stmtblock_t block;
4517 tree lbound, ubound;
4518 tree end;
4519 tree size[GFC_MAX_DIMENSIONS15];
4520 tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3;
4521 gfc_array_info *info;
4522 char *msg;
4523 int dim;
4524
4525 gfc_start_block (&block);
4526
4527 for (n = 0; n < loop->dimen; n++)
4528 size[n] = NULL_TREE(tree) __null;
4529
4530 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
4531 {
4532 stmtblock_t inner;
4533 gfc_ss_info *ss_info;
4534 gfc_expr *expr;
4535 locus *expr_loc;
4536 const char *expr_name;
4537
4538 ss_info = ss->info;
4539 if (ss_info->type != GFC_SS_SECTION)
4540 continue;
4541
4542 /* Catch allocatable lhs in f2003. */
4543 if (flag_realloc_lhsglobal_options.x_flag_realloc_lhs && ss->no_bounds_check)
4544 continue;
4545
4546 expr = ss_info->expr;
4547 expr_loc = &expr->where;
4548 expr_name = expr->symtree->name;
4549
4550 gfc_start_block (&inner);
4551
4552 /* TODO: range checking for mapped dimensions. */
4553 info = &ss_info->data.array;
4554
4555 /* This code only checks ranges. Elemental and vector
4556 dimensions are checked later. */
4557 for (n = 0; n < loop->dimen; n++)
4558 {
4559 bool check_upper;
4560
4561 dim = ss->dim[n];
4562 if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
4563 continue;
4564
4565 if (dim == info->ref->u.ar.dimen - 1
4566 && info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
4567 check_upper = false;
4568 else
4569 check_upper = true;
4570
4571 /* Zero stride is not allowed. */
4572 tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
4573 info->stride[dim], gfc_index_zero_nodegfc_rank_cst[0]);
4574 msg = xasprintf ("Zero stride is not allowed, for dimension %d "
4575 "of array '%s'", dim + 1, expr_name);
4576 gfc_trans_runtime_check (true, false, tmp, &inner,
4577 expr_loc, msg);
4578 free (msg);
4579
4580 desc = info->descriptor;
4581
4582 /* This is the run-time equivalent of resolve.c's
4583 check_dimension(). The logical is more readable there
4584 than it is here, with all the trees. */
4585 lbound = gfc_conv_array_lbound (desc, dim);
4586 end = info->end[dim];
4587 if (check_upper)
4588 ubound = gfc_conv_array_ubound (desc, dim);
4589 else
4590 ubound = NULL__null;
4591
4592 /* non_zerosized is true when the selected range is not
4593 empty. */
4594 stride_pos = fold_build2_loc (input_location, GT_EXPR,
4595 logical_type_node, info->stride[dim],
4596 gfc_index_zero_nodegfc_rank_cst[0]);
4597 tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
4598 info->start[dim], end);
4599 stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4600 logical_type_node, stride_pos, tmp);
4601
4602 stride_neg = fold_build2_loc (input_location, LT_EXPR,
4603 logical_type_node,
4604 info->stride[dim], gfc_index_zero_nodegfc_rank_cst[0]);
4605 tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
4606 info->start[dim], end);
4607 stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4608 logical_type_node,
4609 stride_neg, tmp);
4610 non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR,
4611 logical_type_node,
4612 stride_pos, stride_neg);
4613
4614 /* Check the start of the range against the lower and upper
4615 bounds of the array, if the range is not empty.
4616 If upper bound is present, include both bounds in the
4617 error message. */
4618 if (check_upper)
4619 {
4620 tmp = fold_build2_loc (input_location, LT_EXPR,
4621 logical_type_node,
4622 info->start[dim], lbound);
4623 tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4624 logical_type_node,
4625 non_zerosized, tmp);
4626 tmp2 = fold_build2_loc (input_location, GT_EXPR,
4627 logical_type_node,
4628 info->start[dim], ubound);
4629 tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4630 logical_type_node,
4631 non_zerosized, tmp2);
4632 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4633 "outside of expected range (%%ld:%%ld)",
4634 dim + 1, expr_name);
4635 gfc_trans_runtime_check (true, false, tmp, &inner,
4636 expr_loc, msg,
4637 fold_convert (long_integer_type_node, info->start[dim])fold_convert_loc (((location_t) 0), integer_types[itk_long], info
->start[dim])
,
4638 fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound
)
,
4639 fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound
)
);
4640 gfc_trans_runtime_check (true, false, tmp2, &inner,
4641 expr_loc, msg,
4642 fold_convert (long_integer_type_node, info->start[dim])fold_convert_loc (((location_t) 0), integer_types[itk_long], info
->start[dim])
,
4643 fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound
)
,
4644 fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound
)
);
4645 free (msg);
4646 }
4647 else
4648 {
4649 tmp = fold_build2_loc (input_location, LT_EXPR,
4650 logical_type_node,
4651 info->start[dim], lbound);
4652 tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4653 logical_type_node, non_zerosized, tmp);
4654 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4655 "below lower bound of %%ld",
4656 dim + 1, expr_name);
4657 gfc_trans_runtime_check (true, false, tmp, &inner,
4658 expr_loc, msg,
4659 fold_convert (long_integer_type_node, info->start[dim])fold_convert_loc (((location_t) 0), integer_types[itk_long], info
->start[dim])
,
4660 fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound
)
);
4661 free (msg);
4662 }
4663
4664 /* Compute the last element of the range, which is not
4665 necessarily "end" (think 0:5:3, which doesn't contain 5)
4666 and check it against both lower and upper bounds. */
4667
4668 tmp = fold_build2_loc (input_location, MINUS_EXPR,
4669 gfc_array_index_type, end,
4670 info->start[dim]);
4671 tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
4672 gfc_array_index_type, tmp,
4673 info->stride[dim]);
4674 tmp = fold_build2_loc (input_location, MINUS_EXPR,
4675 gfc_array_index_type, end, tmp);
4676 tmp2 = fold_build2_loc (input_location, LT_EXPR,
4677 logical_type_node, tmp, lbound);
4678 tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4679 logical_type_node, non_zerosized, tmp2);
4680 if (check_upper)
4681 {
4682 tmp3 = fold_build2_loc (input_location, GT_EXPR,
4683 logical_type_node, tmp, ubound);
4684 tmp3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
4685 logical_type_node, non_zerosized, tmp3);
4686 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4687 "outside of expected range (%%ld:%%ld)",
4688 dim + 1, expr_name);
4689 gfc_trans_runtime_check (true, false, tmp2, &inner,
4690 expr_loc, msg,
4691 fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp
)
,
4692 fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound
)
,
4693 fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound
)
);
4694 gfc_trans_runtime_check (true, false, tmp3, &inner,
4695 expr_loc, msg,
4696 fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp
)
,
4697 fold_convert (long_integer_type_node, ubound)fold_convert_loc (((location_t) 0), integer_types[itk_long], ubound
)
,
4698 fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound
)
);
4699 free (msg);
4700 }
4701 else
4702 {
4703 msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' "
4704 "below lower bound of %%ld",
4705 dim + 1, expr_name);
4706 gfc_trans_runtime_check (true, false, tmp2, &inner,
4707 expr_loc, msg,
4708 fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp
)
,
4709 fold_convert (long_integer_type_node, lbound)fold_convert_loc (((location_t) 0), integer_types[itk_long], lbound
)
);
4710 free (msg);
4711 }
4712
4713 /* Check the section sizes match. */
4714 tmp = fold_build2_loc (input_location, MINUS_EXPR,
4715 gfc_array_index_type, end,
4716 info->start[dim]);
4717 tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR,
4718 gfc_array_index_type, tmp,
4719 info->stride[dim]);
4720 tmp = fold_build2_loc (input_location, PLUS_EXPR,
4721 gfc_array_index_type,
4722 gfc_index_one_nodegfc_rank_cst[1], tmp);
4723 tmp = fold_build2_loc (input_location, MAX_EXPR,
4724 gfc_array_index_type, tmp,
4725 build_int_cst (gfc_array_index_type, 0));
4726 /* We remember the size of the first section, and check all the
4727 others against this. */
4728 if (size[n])
4729 {
4730 tmp3 = fold_build2_loc (input_location, NE_EXPR,
4731 logical_type_node, tmp, size[n]);
4732 msg = xasprintf ("Array bound mismatch for dimension %d "
4733 "of array '%s' (%%ld/%%ld)",
4734 dim + 1, expr_name);
4735
4736 gfc_trans_runtime_check (true, false, tmp3, &inner,
4737 expr_loc, msg,
4738 fold_convert (long_integer_type_node, tmp)fold_convert_loc (((location_t) 0), integer_types[itk_long], tmp
)
,
4739 fold_convert (long_integer_type_node, size[n])fold_convert_loc (((location_t) 0), integer_types[itk_long], size
[n])
);
4740
4741 free (msg);
4742 }
4743 else
4744 size[n] = gfc_evaluate_now (tmp, &inner);
4745 }
4746
4747 tmp = gfc_finish_block (&inner);
4748
4749 /* For optional arguments, only check bounds if the argument is
4750 present. */
4751 if (expr->symtree->n.sym->attr.optional
4752 || expr->symtree->n.sym->attr.not_always_present)
4753 tmp = build3_v (COND_EXPR,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt
(input_location))
4754 gfc_conv_expr_present (expr->symtree->n.sym),fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt
(input_location))
4755 tmp, build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt
(input_location))
;
4756
4757 gfc_add_expr_to_block (&block, tmp);
4758
4759 }
4760
4761 tmp = gfc_finish_block (&block);
4762 gfc_add_expr_to_block (&outer_loop->pre, tmp);
4763 }
4764
4765 for (loop = loop->nested; loop; loop = loop->next)
4766 gfc_conv_ss_startstride (loop);
4767}
4768
4769/* Return true if both symbols could refer to the same data object. Does
4770 not take account of aliasing due to equivalence statements. */
4771
4772static int
4773symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym, bool lsym_pointer,
4774 bool lsym_target, bool rsym_pointer, bool rsym_target)
4775{
4776 /* Aliasing isn't possible if the symbols have different base types. */
4777 if (gfc_compare_types (&lsym->ts, &rsym->ts) == 0)
4778 return 0;
4779
4780 /* Pointers can point to other pointers and target objects. */
4781
4782 if ((lsym_pointer && (rsym_pointer || rsym_target))
4783 || (rsym_pointer && (lsym_pointer || lsym_target)))
4784 return 1;
4785
4786 /* Special case: Argument association, cf. F90 12.4.1.6, F2003 12.4.1.7
4787 and F2008 12.5.2.13 items 3b and 4b. The pointer case (a) is already
4788 checked above. */
4789 if (lsym_target && rsym_target
4790 && ((lsym->attr.dummy && !lsym->attr.contiguous
4791 && (!lsym->attr.dimension || lsym->as->type == AS_ASSUMED_SHAPE))
4792 || (rsym->attr.dummy && !rsym->attr.contiguous
4793 && (!rsym->attr.dimension
4794 || rsym->as->type == AS_ASSUMED_SHAPE))))
4795 return 1;
4796
4797 return 0;
4798}
4799
4800
4801/* Return true if the two SS could be aliased, i.e. both point to the same data
4802 object. */
4803/* TODO: resolve aliases based on frontend expressions. */
4804
4805static int
4806gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
4807{
4808 gfc_ref *lref;
4809 gfc_ref *rref;
4810 gfc_expr *lexpr, *rexpr;
4811 gfc_symbol *lsym;
4812 gfc_symbol *rsym;
4813 bool lsym_pointer, lsym_target, rsym_pointer, rsym_target;
4814
4815 lexpr = lss->info->expr;
4816 rexpr = rss->info->expr;
4817
4818 lsym = lexpr->symtree->n.sym;
4819 rsym = rexpr->symtree->n.sym;
4820
4821 lsym_pointer = lsym->attr.pointer;
4822 lsym_target = lsym->attr.target;
4823 rsym_pointer = rsym->attr.pointer;
4824 rsym_target = rsym->attr.target;
4825
4826 if (symbols_could_alias (lsym, rsym, lsym_pointer, lsym_target,
4827 rsym_pointer, rsym_target))
4828 return 1;
4829
4830 if (rsym->ts.type != BT_DERIVED && rsym->ts.type != BT_CLASS
4831 && lsym->ts.type != BT_DERIVED && lsym->ts.type != BT_CLASS)
4832 return 0;
4833
4834 /* For derived types we must check all the component types. We can ignore
4835 array references as these will have the same base type as the previous
4836 component ref. */
4837 for (lref = lexpr->ref; lref != lss->info->data.array.ref; lref = lref->next)
4838 {
4839 if (lref->type != REF_COMPONENT)
4840 continue;
4841
4842 lsym_pointer = lsym_pointer || lref->u.c.sym->attr.pointer;
4843 lsym_target = lsym_target || lref->u.c.sym->attr.target;
4844
4845 if (symbols_could_alias (lref->u.c.sym, rsym, lsym_pointer, lsym_target,
4846 rsym_pointer, rsym_target))
4847 return 1;
4848
4849 if ((lsym_pointer && (rsym_pointer || rsym_target))
4850 || (rsym_pointer && (lsym_pointer || lsym_target)))
4851 {
4852 if (gfc_compare_types (&lref->u.c.component->ts,
4853 &rsym->ts))
4854 return 1;
4855 }
4856
4857 for (rref = rexpr->ref; rref != rss->info->data.array.ref;
4858 rref = rref->next)
4859 {
4860 if (rref->type != REF_COMPONENT)
4861 continue;
4862
4863 rsym_pointer = rsym_pointer || rref->u.c.sym->attr.pointer;
4864 rsym_target = lsym_target || rref->u.c.sym->attr.target;
4865
4866 if (symbols_could_alias (lref->u.c.sym, rref->u.c.sym,
4867 lsym_pointer, lsym_target,
4868 rsym_pointer, rsym_target))
4869 return 1;
4870
4871 if ((lsym_pointer && (rsym_pointer || rsym_target))
4872 || (rsym_pointer && (lsym_pointer || lsym_target)))
4873 {
4874 if (gfc_compare_types (&lref->u.c.component->ts,
4875 &rref->u.c.sym->ts))
4876 return 1;
4877 if (gfc_compare_types (&lref->u.c.sym->ts,
4878 &rref->u.c.component->ts))
4879 return 1;
4880 if (gfc_compare_types (&lref->u.c.component->ts,
4881 &rref->u.c.component->ts))
4882 return 1;
4883 }
4884 }
4885 }
4886
4887 lsym_pointer = lsym->attr.pointer;
4888 lsym_target = lsym->attr.target;
4889
4890 for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next)
4891 {
4892 if (rref->type != REF_COMPONENT)
4893 break;
4894
4895 rsym_pointer = rsym_pointer || rref->u.c.sym->attr.pointer;
4896 rsym_target = lsym_target || rref->u.c.sym->attr.target;
4897
4898 if (symbols_could_alias (rref->u.c.sym, lsym,
4899 lsym_pointer, lsym_target,
4900 rsym_pointer, rsym_target))
4901 return 1;
4902
4903 if ((lsym_pointer && (rsym_pointer || rsym_target))
4904 || (rsym_pointer && (lsym_pointer || lsym_target)))
4905 {
4906 if (gfc_compare_types (&lsym->ts, &rref->u.c.component->ts))
4907 return 1;
4908 }
4909 }
4910
4911 return 0;
4912}
4913
4914
4915/* Resolve array data dependencies. Creates a temporary if required. */
4916/* TODO: Calc dependencies with gfc_expr rather than gfc_ss, and move to
4917 dependency.c. */
4918
4919void
4920gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
4921 gfc_ss * rss)
4922{
4923 gfc_ss *ss;
4924 gfc_ref *lref;
4925 gfc_ref *rref;
4926 gfc_ss_info *ss_info;
4927 gfc_expr *dest_expr;
4928 gfc_expr *ss_expr;
4929 int nDepend = 0;
4930 int i, j;
4931
4932 loop->temp_ss = NULL__null;
4933 dest_expr = dest->info->expr;
4934
4935 for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
4936 {
4937 ss_info = ss->info;
4938 ss_expr = ss_info->expr;
4939
4940 if (ss_info->array_outer_dependency)
4941 {
4942 nDepend = 1;
4943 break;
4944 }
4945
4946 if (ss_info->type != GFC_SS_SECTION)
4947 {
4948 if (flag_realloc_lhsglobal_options.x_flag_realloc_lhs
4949 && dest_expr != ss_expr
4950 && gfc_is_reallocatable_lhs (dest_expr)
4951 && ss_expr->rank)
4952 nDepend = gfc_check_dependency (dest_expr, ss_expr, true);
4953
4954 /* Check for cases like c(:)(1:2) = c(2)(2:3) */
4955 if (!nDepend && dest_expr->rank > 0
4956 && dest_expr->ts.type == BT_CHARACTER
4957 && ss_expr->expr_type == EXPR_VARIABLE)
4958
4959 nDepend = gfc_check_dependency (dest_expr, ss_expr, false);
4960
4961 if (ss_info->type == GFC_SS_REFERENCE
4962 && gfc_check_dependency (dest_expr, ss_expr, false))
4963 ss_info->data.scalar.needs_temporary = 1;
4964
4965 if (nDepend)
4966 break;
4967 else
4968 continue;
4969 }
4970
4971 if (dest_expr->symtree->n.sym != ss_expr->symtree->n.sym)
4972 {
4973 if (gfc_could_be_alias (dest, ss)
4974 || gfc_are_equivalenced_arrays (dest_expr, ss_expr))
4975 {
4976 nDepend = 1;
4977 break;
4978 }
4979 }
4980 else
4981 {
4982 lref = dest_expr->ref;
4983 rref = ss_expr->ref;
4984
4985 nDepend = gfc_dep_resolver (lref, rref, &loop->reverse[0]);
4986
4987 if (nDepend == 1)
4988 break;
4989
4990 for (i = 0; i < dest->dimen; i++)
4991 for (j = 0; j < ss->dimen; j++)
4992 if (i != j
4993 && dest->dim[i] == ss->dim[j])
4994 {
4995 /* If we don't access array elements in the same order,
4996 there is a dependency. */
4997 nDepend = 1;
4998 goto temporary;
4999 }
5000#if 0
5001 /* TODO : loop shifting. */
5002 if (nDepend == 1)
5003 {
5004 /* Mark the dimensions for LOOP SHIFTING */
5005 for (n = 0; n < loop->dimen; n++)
5006 {
5007 int dim = dest->data.info.dim[n];
5008
5009 if (lref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
5010 depends[n] = 2;
5011 else if (! gfc_is_same_range (&lref->u.ar,
5012 &rref->u.ar, dim, 0))
5013 depends[n] = 1;
5014 }
5015
5016 /* Put all the dimensions with dependencies in the
5017 innermost loops. */
5018 dim = 0;
5019 for (n = 0; n < loop->dimen; n++)
5020 {
5021 gcc_assert (loop->order[n] == n)((void)(!(loop->order[n] == n) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5021, __FUNCTION__), 0 : 0))
;
5022 if (depends[n])
5023 loop->order[dim++] = n;
5024 }
5025 for (n = 0; n < loop->dimen; n++)
5026 {
5027 if (! depends[n])
5028 loop->order[dim++] = n;
5029 }
5030
5031 gcc_assert (dim == loop->dimen)((void)(!(dim == loop->dimen) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5031, __FUNCTION__), 0 : 0))
;
5032 break;
5033 }
5034#endif
5035 }
5036 }
5037
5038temporary:
5039
5040 if (nDepend == 1)
5041 {
5042 tree base_type = gfc_typenode_for_spec (&dest_expr->ts);
5043 if (GFC_ARRAY_TYPE_P (base_type)((tree_class_check ((base_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5043, __FUNCTION__))->type_common.lang_flag_2)
5044 || GFC_DESCRIPTOR_TYPE_P (base_type)((tree_class_check ((base_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5044, __FUNCTION__))->type_common.lang_flag_1)
)
5045 base_type = gfc_get_element_type (base_type);
5046 loop->temp_ss = gfc_get_temp_ss (base_type, dest->info->string_length,
5047 loop->dimen);
5048 gfc_add_ss_to_loop (loop, loop->temp_ss);
5049 }
5050 else
5051 loop->temp_ss = NULL__null;
5052}
5053
5054
5055/* Browse through each array's information from the scalarizer and set the loop
5056 bounds according to the "best" one (per dimension), i.e. the one which
5057 provides the most information (constant bounds, shape, etc.). */
5058
5059static void
5060set_loop_bounds (gfc_loopinfo *loop)
5061{
5062 int n, dim, spec_dim;
5063 gfc_array_info *info;
5064 gfc_array_info *specinfo;
5065 gfc_ss *ss;
5066 tree tmp;
5067 gfc_ss **loopspec;
5068 bool dynamic[GFC_MAX_DIMENSIONS15];
5069 mpz_t *cshape;
5070 mpz_t i;
5071 bool nonoptional_arr;
5072
5073 gfc_loopinfo * const outer_loop = outermost_loop (loop);
5074
5075 loopspec = loop->specloop;
5076
5077 mpz_init__gmpz_init (i);
5078 for (n = 0; n < loop->dimen; n++)
5079 {
5080 loopspec[n] = NULL__null;
5081 dynamic[n] = false;
5082
5083 /* If there are both optional and nonoptional array arguments, scalarize
5084 over the nonoptional; otherwise, it does not matter as then all
5085 (optional) arrays have to be present per F2008, 125.2.12p3(6). */
5086
5087 nonoptional_arr = false;
5088
5089 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
5090 if (ss->info->type != GFC_SS_SCALAR && ss->info->type != GFC_SS_TEMP
5091 && ss->info->type != GFC_SS_REFERENCE && !ss->info->can_be_null_ref)
5092 {
5093 nonoptional_arr = true;
5094 break;
5095 }
5096
5097 /* We use one SS term, and use that to determine the bounds of the
5098 loop for this dimension. We try to pick the simplest term. */
5099 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
5100 {
5101 gfc_ss_type ss_type;
5102
5103 ss_type = ss->info->type;
5104 if (ss_type == GFC_SS_SCALAR
5105 || ss_type == GFC_SS_TEMP
5106 || ss_type == GFC_SS_REFERENCE
5107 || (ss->info->can_be_null_ref && nonoptional_arr))
5108 continue;
5109
5110 info = &ss->info->data.array;
5111 dim = ss->dim[n];
5112
5113 if (loopspec[n] != NULL__null)
5114 {
5115 specinfo = &loopspec[n]->info->data.array;
5116 spec_dim = loopspec[n]->dim[n];
5117 }
5118 else
5119 {
5120 /* Silence uninitialized warnings. */
5121 specinfo = NULL__null;
5122 spec_dim = 0;
5123 }
5124
5125 if (info->shape)
5126 {
5127 gcc_assert (info->shape[dim])((void)(!(info->shape[dim]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5127, __FUNCTION__), 0 : 0))
;
5128 /* The frontend has worked out the size for us. */
5129 if (!loopspec[n]
5130 || !specinfo->shape
5131 || !integer_zerop (specinfo->start[spec_dim]))
5132 /* Prefer zero-based descriptors if possible. */
5133 loopspec[n] = ss;
5134 continue;
5135 }
5136
5137 if (ss_type == GFC_SS_CONSTRUCTOR)
5138 {
5139 gfc_constructor_base base;
5140 /* An unknown size constructor will always be rank one.
5141 Higher rank constructors will either have known shape,
5142 or still be wrapped in a call to reshape. */
5143 gcc_assert (loop->dimen == 1)((void)(!(loop->dimen == 1) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5143, __FUNCTION__), 0 : 0))
;
5144
5145 /* Always prefer to use the constructor bounds if the size
5146 can be determined at compile time. Prefer not to otherwise,
5147 since the general case involves realloc, and it's better to
5148 avoid that overhead if possible. */
5149 base = ss->info->expr->value.constructor;
5150 dynamic[n] = gfc_get_array_constructor_size (&i, base);
5151 if (!dynamic[n] || !loopspec[n])
5152 loopspec[n] = ss;
5153 continue;
5154 }
5155
5156 /* Avoid using an allocatable lhs in an assignment, since
5157 there might be a reallocation coming. */
5158 if (loopspec[n] && ss->is_alloc_lhs)
5159 continue;
5160
5161 if (!loopspec[n])
5162 loopspec[n] = ss;
5163 /* Criteria for choosing a loop specifier (most important first):
5164 doesn't need realloc
5165 stride of one
5166 known stride
5167 known lower bound
5168 known upper bound
5169 */
5170 else if (loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n])
5171 loopspec[n] = ss;
5172 else if (integer_onep (info->stride[dim])
5173 && !integer_onep (specinfo->stride[spec_dim]))
5174 loopspec[n] = ss;
5175 else if (INTEGER_CST_P (info->stride[dim])(((enum tree_code) (info->stride[dim])->base.code) == INTEGER_CST
)
5176 && !INTEGER_CST_P (specinfo->stride[spec_dim])(((enum tree_code) (specinfo->stride[spec_dim])->base.code
) == INTEGER_CST)
)
5177 loopspec[n] = ss;
5178 else if (INTEGER_CST_P (info->start[dim])(((enum tree_code) (info->start[dim])->base.code) == INTEGER_CST
)
5179 && !INTEGER_CST_P (specinfo->start[spec_dim])(((enum tree_code) (specinfo->start[spec_dim])->base.code
) == INTEGER_CST)
5180 && integer_onep (info->stride[dim])
5181 == integer_onep (specinfo->stride[spec_dim])
5182 && INTEGER_CST_P (info->stride[dim])(((enum tree_code) (info->stride[dim])->base.code) == INTEGER_CST
)
5183 == INTEGER_CST_P (specinfo->stride[spec_dim])(((enum tree_code) (specinfo->stride[spec_dim])->base.code
) == INTEGER_CST)
)
5184 loopspec[n] = ss;
5185 /* We don't work out the upper bound.
5186 else if (INTEGER_CST_P (info->finish[n])
5187 && ! INTEGER_CST_P (specinfo->finish[n]))
5188 loopspec[n] = ss; */
5189 }
5190
5191 /* We should have found the scalarization loop specifier. If not,
5192 that's bad news. */
5193 gcc_assert (loopspec[n])((void)(!(loopspec[n]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5193, __FUNCTION__), 0 : 0))
;
5194
5195 info = &loopspec[n]->info->data.array;
5196 dim = loopspec[n]->dim[n];
5197
5198 /* Set the extents of this range. */
5199 cshape = info->shape;
5200 if (cshape && INTEGER_CST_P (info->start[dim])(((enum tree_code) (info->start[dim])->base.code) == INTEGER_CST
)
5201 && INTEGER_CST_P (info->stride[dim])(((enum tree_code) (info->stride[dim])->base.code) == INTEGER_CST
)
)
5202 {
5203 loop->from[n] = info->start[dim];
5204 mpz_set__gmpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]);
5205 mpz_sub_ui__gmpz_sub_ui (i, i, 1);
5206 /* To = from + (size - 1) * stride. */
5207 tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
5208 if (!integer_onep (info->stride[dim]))
5209 tmp = fold_build2_loc (input_location, MULT_EXPR,
5210 gfc_array_index_type, tmp,
5211 info->stride[dim]);
5212 loop->to[n] = fold_build2_loc (input_location, PLUS_EXPR,
5213 gfc_array_index_type,
5214 loop->from[n], tmp);
5215 }
5216 else
5217 {
5218 loop->from[n] = info->start[dim];
5219 switch (loopspec[n]->info->type)
5220 {
5221 case GFC_SS_CONSTRUCTOR:
5222 /* The upper bound is calculated when we expand the
5223 constructor. */
5224 gcc_assert (loop->to[n] == NULL_TREE)((void)(!(loop->to[n] == (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5224, __FUNCTION__), 0 : 0))
;
5225 break;
5226
5227 case GFC_SS_SECTION:
5228 /* Use the end expression if it exists and is not constant,
5229 so that it is only evaluated once. */
5230 loop->to[n] = info->end[dim];
5231 break;
5232
5233 case GFC_SS_FUNCTION:
5234 /* The loop bound will be set when we generate the call. */
5235 gcc_assert (loop->to[n] == NULL_TREE)((void)(!(loop->to[n] == (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5235, __FUNCTION__), 0 : 0))
;
5236 break;
5237
5238 case GFC_SS_INTRINSIC:
5239 {
5240 gfc_expr *expr = loopspec[n]->info->expr;
5241
5242 /* The {l,u}bound of an assumed rank. */
5243 gcc_assert ((expr->value.function.isym->id == GFC_ISYM_LBOUND((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND
|| expr->value.function.isym->id == GFC_ISYM_UBOUND) &&
expr->value.function.actual->next->expr == __null &&
expr->value.function.actual->expr->rank == -1) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5246, __FUNCTION__), 0 : 0))
5244 || expr->value.function.isym->id == GFC_ISYM_UBOUND)((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND
|| expr->value.function.isym->id == GFC_ISYM_UBOUND) &&
expr->value.function.actual->next->expr == __null &&
expr->value.function.actual->expr->rank == -1) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5246, __FUNCTION__), 0 : 0))
5245 && expr->value.function.actual->next->expr == NULL((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND
|| expr->value.function.isym->id == GFC_ISYM_UBOUND) &&
expr->value.function.actual->next->expr == __null &&
expr->value.function.actual->expr->rank == -1) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5246, __FUNCTION__), 0 : 0))
5246 && expr->value.function.actual->expr->rank == -1)((void)(!((expr->value.function.isym->id == GFC_ISYM_LBOUND
|| expr->value.function.isym->id == GFC_ISYM_UBOUND) &&
expr->value.function.actual->next->expr == __null &&
expr->value.function.actual->expr->rank == -1) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5246, __FUNCTION__), 0 : 0))
;
5247
5248 loop->to[n] = info->end[dim];
5249 break;
5250 }
5251
5252 case GFC_SS_COMPONENT:
5253 {
5254 if (info->end[dim] != NULL_TREE(tree) __null)
5255 {
5256 loop->to[n] = info->end[dim];
5257 break;
5258 }
5259 else
5260 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5260, __FUNCTION__))
;
5261 }
5262
5263 default:
5264 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5264, __FUNCTION__))
;
5265 }
5266 }
5267
5268 /* Transform everything so we have a simple incrementing variable. */
5269 if (integer_onep (info->stride[dim]))
5270 info->delta[dim] = gfc_index_zero_nodegfc_rank_cst[0];
5271 else
5272 {
5273 /* Set the delta for this section. */
5274 info->delta[dim] = gfc_evaluate_now (loop->from[n], &outer_loop->pre);
5275 /* Number of iterations is (end - start + step) / step.
5276 with start = 0, this simplifies to
5277 last = end / step;
5278 for (i = 0; i<=last; i++){...}; */
5279 tmp = fold_build2_loc (input_location, MINUS_EXPR,
5280 gfc_array_index_type, loop->to[n],
5281 loop->from[n]);
5282 tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR,
5283 gfc_array_index_type, tmp, info->stride[dim]);
5284 tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
5285 tmp, build_int_cst (gfc_array_index_type, -1));
5286 loop->to[n] = gfc_evaluate_now (tmp, &outer_loop->pre);
5287 /* Make the loop variable start at 0. */
5288 loop->from[n] = gfc_index_zero_nodegfc_rank_cst[0];
5289 }
5290 }
5291 mpz_clear__gmpz_clear (i);
5292
5293 for (loop = loop->nested; loop; loop = loop->next)
5294 set_loop_bounds (loop);
5295}
5296
5297
5298/* Initialize the scalarization loop. Creates the loop variables. Determines
5299 the range of the loop variables. Creates a temporary if required.
5300 Also generates code for scalar expressions which have been
5301 moved outside the loop. */
5302
5303void
5304gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
5305{
5306 gfc_ss *tmp_ss;
5307 tree tmp;
5308
5309 set_loop_bounds (loop);
5310
5311 /* Add all the scalar code that can be taken out of the loops.
5312 This may include calculating the loop bounds, so do it before
5313 allocating the temporary. */
5314 gfc_add_loop_ss_code (loop, loop->ss, false, where);
5315
5316 tmp_ss = loop->temp_ss;
5317 /* If we want a temporary then create it. */
5318 if (tmp_ss != NULL__null)
5319 {
5320 gfc_ss_info *tmp_ss_info;
5321
5322 tmp_ss_info = tmp_ss->info;
5323 gcc_assert (tmp_ss_info->type == GFC_SS_TEMP)((void)(!(tmp_ss_info->type == GFC_SS_TEMP) ? fancy_abort (
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5323, __FUNCTION__), 0 : 0))
;
5324 gcc_assert (loop->parent == NULL)((void)(!(loop->parent == __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5324, __FUNCTION__), 0 : 0))
;
5325
5326 /* Make absolutely sure that this is a complete type. */
5327 if (tmp_ss_info->string_length)
5328 tmp_ss_info->data.temp.type
5329 = gfc_get_character_type_len_for_eltype
5330 (TREE_TYPE (tmp_ss_info->data.temp.type)((contains_struct_check ((tmp_ss_info->data.temp.type), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5330, __FUNCTION__))->typed.type)
,
5331 tmp_ss_info->string_length);
5332
5333 tmp = tmp_ss_info->data.temp.type;
5334 memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info));
5335 tmp_ss_info->type = GFC_SS_SECTION;
5336
5337 gcc_assert (tmp_ss->dimen != 0)((void)(!(tmp_ss->dimen != 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5337, __FUNCTION__), 0 : 0))
;
5338
5339 gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp,
5340 NULL_TREE(tree) __null, false, true, false, where);
5341 }
5342
5343 /* For array parameters we don't have loop variables, so don't calculate the
5344 translations. */
5345 if (!loop->array_parameter)
5346 gfc_set_delta (loop);
5347}
5348
5349
5350/* Calculates how to transform from loop variables to array indices for each
5351 array: once loop bounds are chosen, sets the difference (DELTA field) between
5352 loop bounds and array reference bounds, for each array info. */
5353
5354void
5355gfc_set_delta (gfc_loopinfo *loop)
5356{
5357 gfc_ss *ss, **loopspec;
5358 gfc_array_info *info;
5359 tree tmp;
5360 int n, dim;
5361
5362 gfc_loopinfo * const outer_loop = outermost_loop (loop);
5363
5364 loopspec = loop->specloop;
5365
5366 /* Calculate the translation from loop variables to array indices. */
5367 for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
5368 {
5369 gfc_ss_type ss_type;
5370
5371 ss_type = ss->info->type;
5372 if (ss_type != GFC_SS_SECTION
5373 && ss_type != GFC_SS_COMPONENT
5374 && ss_type != GFC_SS_CONSTRUCTOR)
5375 continue;
5376
5377 info = &ss->info->data.array;
5378
5379 for (n = 0; n < ss->dimen; n++)
5380 {
5381 /* If we are specifying the range the delta is already set. */
5382 if (loopspec[n] != ss)
5383 {
5384 dim = ss->dim[n];
5385
5386 /* Calculate the offset relative to the loop variable.
5387 First multiply by the stride. */
5388 tmp = loop->from[n];
5389 if (!integer_onep (info->stride[dim]))
5390 tmp = fold_build2_loc (input_location, MULT_EXPR,
5391 gfc_array_index_type,
5392 tmp, info->stride[dim]);
5393
5394 /* Then subtract this from our starting value. */
5395 tmp = fold_build2_loc (input_location, MINUS_EXPR,
5396 gfc_array_index_type,
5397 info->start[dim], tmp);
5398
5399 info->delta[dim] = gfc_evaluate_now (tmp, &outer_loop->pre);
5400 }
5401 }
5402 }
5403
5404 for (loop = loop->nested; loop; loop = loop->next)
5405 gfc_set_delta (loop);
5406}
5407
5408
5409/* Calculate the size of a given array dimension from the bounds. This
5410 is simply (ubound - lbound + 1) if this expression is positive
5411 or 0 if it is negative (pick either one if it is zero). Optionally
5412 (if or_expr is present) OR the (expression != 0) condition to it. */
5413
5414tree
5415gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
5416{
5417 tree res;
5418 tree cond;
5419
5420 /* Calculate (ubound - lbound + 1). */
5421 res = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
5422 ubound, lbound);
5423 res = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, res,
5424 gfc_index_one_nodegfc_rank_cst[1]);
5425
5426 /* Check whether the size for this dimension is negative. */
5427 cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res,
5428 gfc_index_zero_nodegfc_rank_cst[0]);
5429 res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
5430 gfc_index_zero_nodegfc_rank_cst[0], res);
5431
5432 /* Build OR expression. */
5433 if (or_expr)
5434 *or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
5435 logical_type_node, *or_expr, cond);
5436
5437 return res;
5438}
5439
5440
5441/* For an array descriptor, get the total number of elements. This is just
5442 the product of the extents along from_dim to to_dim. */
5443
5444static tree
5445gfc_conv_descriptor_size_1 (tree desc, int from_dim, int to_dim)
5446{
5447 tree res;
5448 int dim;
5449
5450 res = gfc_index_one_nodegfc_rank_cst[1];
5451
5452 for (dim = from_dim; dim < to_dim; ++dim)
5453 {
5454 tree lbound;
5455 tree ubound;
5456 tree extent;
5457
5458 lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
5459 ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
5460
5461 extent = gfc_conv_array_extent_dim (lbound, ubound, NULL__null);
5462 res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
5463 res, extent);
5464 }
5465
5466 return res;
5467}
5468
5469
5470/* Full size of an array. */
5471
5472tree
5473gfc_conv_descriptor_size (tree desc, int rank)
5474{
5475 return gfc_conv_descriptor_size_1 (desc, 0, rank);
5476}
5477
5478
5479/* Size of a coarray for all dimensions but the last. */
5480
5481tree
5482gfc_conv_descriptor_cosize (tree desc, int rank, int corank)
5483{
5484 return gfc_conv_descriptor_size_1 (desc, rank, rank + corank - 1);
5485}
5486
5487
5488/* Fills in an array descriptor, and returns the size of the array.
5489 The size will be a simple_val, ie a variable or a constant. Also
5490 calculates the offset of the base. The pointer argument overflow,
5491 which should be of integer type, will increase in value if overflow
5492 occurs during the size calculation. Returns the size of the array.
5493 {
5494 stride = 1;
5495 offset = 0;
5496 for (n = 0; n < rank; n++)
5497 {
5498 a.lbound[n] = specified_lower_bound;
5499 offset = offset + a.lbond[n] * stride;
5500 size = 1 - lbound;
5501 a.ubound[n] = specified_upper_bound;
5502 a.stride[n] = stride;
5503 size = size >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound
5504 overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0);
5505 stride = stride * size;
5506 }
5507 for (n = rank; n < rank+corank; n++)
5508 (Set lcobound/ucobound as above.)
5509 element_size = sizeof (array element);
5510 if (!rank)
5511 return element_size
5512 stride = (size_t) stride;
5513 overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0);
5514 stride = stride * element_size;
5515 return (stride);
5516 } */
5517/*GCC ARRAYS*/
5518
5519static tree
5520gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
5521 gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
5522 stmtblock_t * descriptor_block, tree * overflow,
5523 tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
5524 tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
5525 tree *element_size)
5526{
5527 tree type;
5528 tree tmp;
5529 tree size;
5530 tree offset;
5531 tree stride;
5532 tree or_expr;
5533 tree thencase;
5534 tree elsecase;
5535 tree cond;
5536 tree var;
5537 stmtblock_t thenblock;
5538 stmtblock_t elseblock;
5539 gfc_expr *ubound;
5540 gfc_se se;
5541 int n;
5542
5543 type = TREE_TYPE (descriptor)((contains_struct_check ((descriptor), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5543, __FUNCTION__))->typed.type)
;
5544
5545 stride = gfc_index_one_nodegfc_rank_cst[1];
5546 offset = gfc_index_zero_nodegfc_rank_cst[0];
5547
5548 /* Set the dtype before the alloc, because registration of coarrays needs
5549 it initialized. */
5550 if (expr->ts.type == BT_CHARACTER
5551 && expr->ts.deferred
5552 && VAR_P (expr->ts.u.cl->backend_decl)(((enum tree_code) (expr->ts.u.cl->backend_decl)->base
.code) == VAR_DECL)
)
5553 {
5554 type = gfc_typenode_for_spec (&expr->ts);
5555 tmp = gfc_conv_descriptor_dtype (descriptor);
5556 gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
5557 }
5558 else if (expr->ts.type == BT_CHARACTER
5559 && expr->ts.deferred
5560 && TREE_CODE (descriptor)((enum tree_code) (descriptor)->base.code) == COMPONENT_REF)
5561 {
5562 /* Deferred character components have their string length tucked away
5563 in a hidden field of the derived type. Obtain that and use it to
5564 set the dtype. The charlen backend decl is zero because the field
5565 type is zero length. */
5566 gfc_ref *ref;
5567 tmp = NULL_TREE(tree) __null;
5568 for (ref = expr->ref; ref; ref = ref->next)
5569 if (ref->type == REF_COMPONENT
5570 && gfc_deferred_strlen (ref->u.c.component, &tmp))
5571 break;
5572 gcc_assert (tmp != NULL_TREE)((void)(!(tmp != (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5572, __FUNCTION__), 0 : 0))
;
5573 tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5573, __FUNCTION__))->typed.type)
,
5574 TREE_OPERAND (descriptor, 0)(*((const_cast<tree*> (tree_operand_check ((descriptor)
, (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5574, __FUNCTION__)))))
, tmp, NULL_TREE(tree) __null);
5575 tmp = fold_convert (gfc_charlen_type_node, tmp)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, tmp
)
;
5576 type = gfc_get_character_type_len (expr->ts.kind, tmp);
5577 tmp = gfc_conv_descriptor_dtype (descriptor);
5578 gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
5579 }
5580 else
5581 {
5582 tmp = gfc_conv_descriptor_dtype (descriptor);
5583 gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
5584 }
5585
5586 or_expr = logical_false_node;
5587
5588 for (n = 0; n < rank; n++)
5589 {
5590 tree conv_lbound;
5591 tree conv_ubound;
5592
5593 /* We have 3 possibilities for determining the size of the array:
5594 lower == NULL => lbound = 1, ubound = upper[n]
5595 upper[n] = NULL => lbound = 1, ubound = lower[n]
5596 upper[n] != NULL => lbound = lower[n], ubound = upper[n] */
5597 ubound = upper[n];
5598
5599 /* Set lower bound. */
5600 gfc_init_se (&se, NULL__null);
5601 if (expr3_desc != NULL_TREE(tree) __null)
5602 {
5603 if (e3_has_nodescriptor)
5604 /* The lbound of nondescriptor arrays like array constructors,
5605 nonallocatable/nonpointer function results/variables,
5606 start at zero, but when allocating it, the standard expects
5607 the array to start at one. */
5608 se.expr = gfc_index_one_nodegfc_rank_cst[1];
5609 else
5610 se.expr = gfc_conv_descriptor_lbound_get (expr3_desc,
5611 gfc_rank_cst[n]);
5612 }
5613 else if (lower == NULL__null)
5614 se.expr = gfc_index_one_nodegfc_rank_cst[1];
5615 else
5616 {
5617 gcc_assert (lower[n])((void)(!(lower[n]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5617, __FUNCTION__), 0 : 0))
;
5618 if (ubound)
5619 {
5620 gfc_conv_expr_type (&se, lower[n], gfc_array_index_type);
5621 gfc_add_block_to_block (pblock, &se.pre);
5622 }
5623 else
5624 {
5625 se.expr = gfc_index_one_nodegfc_rank_cst[1];
5626 ubound = lower[n];
5627 }
5628 }
5629 gfc_conv_descriptor_lbound_set (descriptor_block, descriptor,
5630 gfc_rank_cst[n], se.expr);
5631 conv_lbound = se.expr;
5632
5633 /* Work out the offset for this component. */
5634 tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
5635 se.expr, stride);
5636 offset = fold_build2_loc (input_location, MINUS_EXPR,
5637 gfc_array_index_type, offset, tmp);
5638
5639 /* Set upper bound. */
5640 gfc_init_se (&se, NULL__null);
5641 if (expr3_desc != NULL_TREE(tree) __null)
5642 {
5643 if (e3_has_nodescriptor)
5644 {
5645 /* The lbound of nondescriptor arrays like array constructors,
5646 nonallocatable/nonpointer function results/variables,
5647 start at zero, but when allocating it, the standard expects
5648 the array to start at one. Therefore fix the upper bound to be
5649 (desc.ubound - desc.lbound) + 1. */
5650 tmp = fold_build2_loc (input_location, MINUS_EXPR,
5651 gfc_array_index_type,
5652 gfc_conv_descriptor_ubound_get (
5653 expr3_desc, gfc_rank_cst[n]),
5654 gfc_conv_descriptor_lbound_get (
5655 expr3_desc, gfc_rank_cst[n]));
5656 tmp = fold_build2_loc (input_location, PLUS_EXPR,
5657 gfc_array_index_type, tmp,
5658 gfc_index_one_nodegfc_rank_cst[1]);
5659 se.expr = gfc_evaluate_now (tmp, pblock);
5660 }
5661 else
5662 se.expr = gfc_conv_descriptor_ubound_get (expr3_desc,
5663 gfc_rank_cst[n]);
5664 }
5665 else
5666 {
5667 gcc_assert (ubound)((void)(!(ubound) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5667, __FUNCTION__), 0 : 0))
;
5668 gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
5669 gfc_add_block_to_block (pblock, &se.pre);
5670 if (ubound->expr_type == EXPR_FUNCTION)
5671 se.expr = gfc_evaluate_now (se.expr, pblock);
5672 }
5673 gfc_conv_descriptor_ubound_set (descriptor_block, descriptor,
5674 gfc_rank_cst[n], se.expr);
5675 conv_ubound = se.expr;
5676
5677 /* Store the stride. */
5678 gfc_conv_descriptor_stride_set (descriptor_block, descriptor,
5679 gfc_rank_cst[n], stride);
5680
5681 /* Calculate size and check whether extent is negative. */
5682 size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &or_expr);
5683 size = gfc_evaluate_now (size, pblock);
5684
5685 /* Check whether multiplying the stride by the number of
5686 elements in this dimension would overflow. We must also check
5687 whether the current dimension has zero size in order to avoid
5688 division by zero.
5689 */
5690 tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
5691 gfc_array_index_type,
5692 fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_check5
((gfc_array_index_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5693, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
))
5693 TYPE_MAX_VALUE (gfc_array_index_type))fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_check5
((gfc_array_index_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5693, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
))
,
5694 size);
5695 cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
5696 logical_type_node, tmp, stride),
5697 PRED_FORTRAN_OVERFLOW);
5698 tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_nodeinteger_types[itk_int], cond,
5699 integer_one_nodeglobal_trees[TI_INTEGER_ONE], integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
5700 cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
5701 logical_type_node, size,
5702 gfc_index_zero_nodegfc_rank_cst[0]),
5703 PRED_FORTRAN_SIZE_ZERO);
5704 tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_nodeinteger_types[itk_int], cond,
5705 integer_zero_nodeglobal_trees[TI_INTEGER_ZERO], tmp);
5706 tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_nodeinteger_types[itk_int],
5707 *overflow, tmp);
5708 *overflow = gfc_evaluate_now (tmp, pblock);
5709
5710 /* Multiply the stride by the number of elements in this dimension. */
5711 stride = fold_build2_loc (input_location, MULT_EXPR,
5712 gfc_array_index_type, stride, size);
5713 stride = gfc_evaluate_now (stride, pblock);
5714 }
5715
5716 for (n = rank; n < rank + corank; n++)
5717 {
5718 ubound = upper[n];
5719
5720 /* Set lower bound. */
5721 gfc_init_se (&se, NULL__null);
5722 if (lower == NULL__null || lower[n] == NULL__null)
5723 {
5724 gcc_assert (n == rank + corank - 1)((void)(!(n == rank + corank - 1) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5724, __FUNCTION__), 0 : 0))
;
5725 se.expr = gfc_index_one_nodegfc_rank_cst[1];
5726 }
5727 else
5728 {
5729 if (ubound || n == rank + corank - 1)
5730 {
5731 gfc_conv_expr_type (&se, lower[n], gfc_array_index_type);
5732 gfc_add_block_to_block (pblock, &se.pre);
5733 }
5734 else
5735 {
5736 se.expr = gfc_index_one_nodegfc_rank_cst[1];
5737 ubound = lower[n];
5738 }
5739 }
5740 gfc_conv_descriptor_lbound_set (descriptor_block, descriptor,
5741 gfc_rank_cst[n], se.expr);
5742
5743 if (n < rank + corank - 1)
5744 {
5745 gfc_init_se (&se, NULL__null);
5746 gcc_assert (ubound)((void)(!(ubound) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5746, __FUNCTION__), 0 : 0))
;
5747 gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
5748 gfc_add_block_to_block (pblock, &se.pre);
5749 gfc_conv_descriptor_ubound_set (descriptor_block, descriptor,
5750 gfc_rank_cst[n], se.expr);
5751 }
5752 }
5753
5754 /* The stride is the number of elements in the array, so multiply by the
5755 size of an element to get the total size. Obviously, if there is a
5756 SOURCE expression (expr3) we must use its element size. */
5757 if (expr3_elem_size != NULL_TREE(tree) __null)
5758 tmp = expr3_elem_size;
5759 else if (expr3 != NULL__null)
5760 {
5761 if (expr3->ts.type == BT_CLASS)
5762 {
5763 gfc_se se_sz;
5764 gfc_expr *sz = gfc_copy_expr (expr3);
5765 gfc_add_vptr_component (sz)gfc_add_component_ref(sz,"_vptr");
5766 gfc_add_size_component (sz)gfc_add_component_ref(sz,"_size");
5767 gfc_init_se (&se_sz, NULL__null);
5768 gfc_conv_expr (&se_sz, sz);
5769 gfc_free_expr (sz);
5770 tmp = se_sz.expr;
5771 }
5772 else
5773 {
5774 tmp = gfc_typenode_for_spec (&expr3->ts);
5775 tmp = TYPE_SIZE_UNIT (tmp)((tree_class_check ((tmp), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5775, __FUNCTION__))->type_common.size_unit)
;
5776 }
5777 }
5778 else
5779 tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type))((tree_class_check ((gfc_get_element_type (type)), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5779, __FUNCTION__))->type_common.size_unit)
;
5780
5781 /* Convert to size_t. */
5782 *element_size = fold_convert (size_type_node, tmp)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE
], tmp)
;
5783
5784 if (rank == 0)
5785 return *element_size;
5786
5787 *nelems = gfc_evaluate_now (stride, pblock);
5788 stride = fold_convert (size_type_node, stride)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE
], stride)
;
5789
5790 /* First check for overflow. Since an array of type character can
5791 have zero element_size, we must check for that before
5792 dividing. */
5793 tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
5794 size_type_nodeglobal_trees[TI_SIZE_TYPE],
5795 TYPE_MAX_VALUE (size_type_node)((tree_check5 ((global_trees[TI_SIZE_TYPE]), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5795, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
, *element_size);
5796 cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
5797 logical_type_node, tmp, stride),
5798 PRED_FORTRAN_OVERFLOW);
5799 tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_nodeinteger_types[itk_int], cond,
5800 integer_one_nodeglobal_trees[TI_INTEGER_ONE], integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
5801 cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
5802 logical_type_node, *element_size,
5803 build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], 0)),
5804 PRED_FORTRAN_SIZE_ZERO);
5805 tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_nodeinteger_types[itk_int], cond,
5806 integer_zero_nodeglobal_trees[TI_INTEGER_ZERO], tmp);
5807 tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_nodeinteger_types[itk_int],
5808 *overflow, tmp);
5809 *overflow = gfc_evaluate_now (tmp, pblock);
5810
5811 size = fold_build2_loc (input_location, MULT_EXPR, size_type_nodeglobal_trees[TI_SIZE_TYPE],
5812 stride, *element_size);
5813
5814 if (poffset != NULL__null)
5815 {
5816 offset = gfc_evaluate_now (offset, pblock);
5817 *poffset = offset;
5818 }
5819
5820 if (integer_zerop (or_expr))
5821 return size;
5822 if (integer_onep (or_expr))
5823 return build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], 0);
5824
5825 var = gfc_create_var (TREE_TYPE (size)((contains_struct_check ((size), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5825, __FUNCTION__))->typed.type)
, "size");
5826 gfc_start_block (&thenblock);
5827 gfc_add_modify (&thenblock, var, build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], 0));
5828 thencase = gfc_finish_block (&thenblock);
5829
5830 gfc_start_block (&elseblock);
5831 gfc_add_modify (&elseblock, var, size);
5832 elsecase = gfc_finish_block (&elseblock);
5833
5834 tmp = gfc_evaluate_now (or_expr, pblock);
5835 tmp = build3_v (COND_EXPR, tmp, thencase, elsecase)fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], tmp, thencase, elsecase)
;
5836 gfc_add_expr_to_block (pblock, tmp);
5837
5838 return var;
5839}
5840
5841
5842/* Retrieve the last ref from the chain. This routine is specific to
5843 gfc_array_allocate ()'s needs. */
5844
5845bool
5846retrieve_last_ref (gfc_ref **ref_in, gfc_ref **prev_ref_in)
5847{
5848 gfc_ref *ref, *prev_ref;
5849
5850 ref = *ref_in;
5851 /* Prevent warnings for uninitialized variables. */
5852 prev_ref = *prev_ref_in;
5853 while (ref && ref->next != NULL__null)
5854 {
5855 gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT((void)(!(ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT
|| (ref->u.ar.dimen == 0 && ref->u.ar.codimen >
0)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5856, __FUNCTION__), 0 : 0))
5856 || (ref->u.ar.dimen == 0 && ref->u.ar.codimen > 0))((void)(!(ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT
|| (ref->u.ar.dimen == 0 && ref->u.ar.codimen >
0)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-array.c"
, 5856, __FUNCTION__), 0 : 0))
;
5857 prev_ref = ref;
5858 ref = ref->next;
5859 }
5860
5861 if (ref == NULL__null || ref->type != REF_ARRAY)
5862 return false;
5863
5864 *ref_in = ref;
5865 *prev_ref_in = prev_ref;
5866 return true;
5867}
5868
5869/* Initializes the descriptor and generates a call to _gfor_allocate. Does
5870 the work for an ALLOCATE statement. */
5871/*GCC ARRAYS*/
5872
5873bool
5874gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
5875 tree errlen, tree label_finish, tree expr3_elem_size,
5876 tree *nelems, gfc_expr *expr3, tree e3_arr_desc,
5877 bool e3_has_nodescriptor)
5878{
5879 tree tmp;
5880 tree pointer;
5881 tree offset = NULL_TREE(tree) __null;
5882 tree token = NULL_TREE(tree) __null;
5883 tree size;
5884 tree msg;
5885 tree error = NULL_TREE(tree) __null;
5886 tree overflow; /* Boolean storing whether size calculation overflows. */
5887 tree var_overflow = NULL_TREE(tree) __null;
5888 tree cond;
5889 tree set_descriptor;
5890 tree not_prev_allocated = NULL_TREE(tree) __null;
5891 tree element_size = NULL_TREE(tree) __null;
5892 stmtblock_t set_descriptor_block;
5893 stmtblock_t elseblock;
5894 gfc_expr **lower;
5895 gfc_expr **upper;
5896 gfc_ref *ref, *prev_ref = NULL__null, *coref;
5897 bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false,
5898 non_ulimate_coarray_ptr_comp;
5899
5900 ref = expr->ref;
5901
5902 /* Find the last reference in the chain. */
5903 if (!retrieve_last_ref (&ref, &prev_ref))
5904 return false;
5905
5906 /* Take the allocatable and coarray properties solely from the expr-ref's
5907 attributes and not from source=-expression. */
5908 if (!prev_ref)
5909 {
5910 allocatable = expr->symtree->n.sym->attr.allocatable;
5911 dimension = expr->symtree->n.sym->attr.dimension;
5912 non_ulimate_coarray_ptr_comp = false;
5913 }
5914 else
5915 {
5916 allocatable = prev_ref->u.c.component->attr.allocatable;
5917 /* Pointer components in coarrayed derived types must be treated
5918 specially in that they are registered without a check if the are
5919 already associated. This does not hold for ultimate coarray
5920 pointers. */
5921 non_ulimate_coarray_ptr_comp = (prev_ref->u.c.component->attr.pointer
5922 && !prev_ref->u.c.component->attr.codimension);
5923 dimension = prev_ref->u.c.component->attr.dimension;
5924 }
5925
5926 /* For allocatable/pointer arrays in derived types, one of the refs has to be
5927 a coarray. In this case it does not matter whether we are on this_image
5928 or not. */
5929 coarray = false;
5930 for (coref = expr->ref; coref; coref = coref->next)
5931 if (coref->type == REF_ARRAY && coref->u.ar.codimen > 0)
5932 {
5933 coarray = true;