/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc

Bug Summary

File:	build/gcc/fortran/trans-stmt.cc
Warning:	line 245, column 3 Value stored to 'ss' is never read

Annotated Source Code

Press '?' to see keyboard shortcuts

Show analyzer invocation

clang -cc1 -cc1 -triple x86_64-suse-linux -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name trans-stmt.cc -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 -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/15.0.7 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/backward -internal-isystem /usr/lib64/clang/15.0.7/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/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 -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2023-03-27-141847-20772-1/report-KBirie.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc

1	/* Statement translation -- generate GCC trees from gfc_code.
2	Copyright (C) 2002-2023 Free Software Foundation, Inc.
3	Contributed by Paul Brook <paul@nowt.org>
4	and Steven Bosscher <s.bosscher@student.tudelft.nl>
5
6	This file is part of GCC.
7
8	GCC is free software; you can redistribute it and/or modify it under
9	the terms of the GNU General Public License as published by the Free
10	Software Foundation; either version 3, or (at your option) any later
11	version.
12
13	GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14	WARRANTY; without even the implied warranty of MERCHANTABILITY or
15	FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16	for more details.
17
18	You should have received a copy of the GNU General Public License
19	along with GCC; see the file COPYING3. If not see
20	<http://www.gnu.org/licenses/>. */
21
22
23	#include "config.h"
24	#include "system.h"
25	#include "coretypes.h"
26	#include "options.h"
27	#include "tree.h"
28	#include "gfortran.h"
29	#include "trans.h"
30	#include "stringpool.h"
31	#include "fold-const.h"
32	#include "trans-stmt.h"
33	#include "trans-types.h"
34	#include "trans-array.h"
35	#include "trans-const.h"
36	#include "dependency.h"
37
38	typedef struct iter_info
39	{
40	tree var;
41	tree start;
42	tree end;
43	tree step;
44	struct iter_info *next;
45	}
46	iter_info;
47
48	typedef struct forall_info
49	{
50	iter_info *this_loop;
51	tree mask;
52	tree maskindex;
53	int nvar;
54	tree size;
55	struct forall_info *prev_nest;
56	bool do_concurrent;
57	}
58	forall_info;
59
60	static void gfc_trans_where_2 (gfc_code *, tree, bool,
61	forall_info , stmtblock_t );
62
63	/* Translate a F95 label number to a LABEL_EXPR. */
64
65	tree
66	gfc_trans_label_here (gfc_code * code)
67	{
68	return build1_v (LABEL_EXPR, gfc_get_label_decl (code->here))fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], gfc_get_label_decl (code->here));
69	}
70
71
72	/* Given a variable expression which has been ASSIGNed to, find the decl
73	containing the auxiliary variables. For variables in common blocks this
74	is a field_decl. */
75
76	void
77	gfc_conv_label_variable (gfc_se * se, gfc_expr * expr)
78	{
79	gcc_assert (expr->symtree->n.sym->attr.assign == 1)((void)(!(expr->symtree->n.sym->attr.assign == 1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 79, __FUNCTION__), 0 : 0));
80	gfc_conv_expr (se, expr);
81	/* Deals with variable in common block. Get the field declaration. */
82	if (TREE_CODE (se->expr)((enum tree_code) (se->expr)->base.code) == COMPONENT_REF)
83	se->expr = TREE_OPERAND (se->expr, 1)(((const_cast<tree> (tree_operand_check ((se->expr ), (1), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 83, __FUNCTION__)))));
84	/* Deals with dummy argument. Get the parameter declaration. */
85	else if (TREE_CODE (se->expr)((enum tree_code) (se->expr)->base.code) == INDIRECT_REF)
86	se->expr = TREE_OPERAND (se->expr, 0)(((const_cast<tree> (tree_operand_check ((se->expr ), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 86, __FUNCTION__)))));
87	}
88
89	/* Translate a label assignment statement. */
90
91	tree
92	gfc_trans_label_assign (gfc_code * code)
93	{
94	tree label_tree;
95	gfc_se se;
96	tree len;
97	tree addr;
98	tree len_tree;
99	int label_len;
100
101	/* Start a new block. */
102	gfc_init_se (&se, NULL__null);
103	gfc_start_block (&se.pre);
104	gfc_conv_label_variable (&se, code->expr1);
105
106	len = GFC_DECL_STRING_LEN (se.expr)((contains_struct_check ((se.expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 106, __FUNCTION__))->decl_common.lang_specific)->stringlen;
107	addr = GFC_DECL_ASSIGN_ADDR (se.expr)((contains_struct_check ((se.expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 107, __FUNCTION__))->decl_common.lang_specific)->addr;
108
109	label_tree = gfc_get_label_decl (code->label1);
110
111	if (code->label1->defined == ST_LABEL_TARGET
112	\|\| code->label1->defined == ST_LABEL_DO_TARGET)
113	{
114	label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
115	len_tree = build_int_cst (gfc_charlen_type_node, -1);
116	}
117	else
118	{
119	gfc_expr *format = code->label1->format;
120
121	label_len = format->value.character.length;
122	len_tree = build_int_cst (gfc_charlen_type_node, label_len);
123	label_tree = gfc_build_wide_string_const (format->ts.kind, label_len + 1,
124	format->value.character.string);
125	label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
126	}
127
128	gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (len), len_tree)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 128, __FUNCTION__))->typed.type), len_tree));
129	gfc_add_modify (&se.pre, addr, label_tree);
130
131	return gfc_finish_block (&se.pre);
132	}
133
134	/* Translate a GOTO statement. */
135
136	tree
137	gfc_trans_goto (gfc_code * code)
138	{
139	locus loc = code->loc;
140	tree assigned_goto;
141	tree target;
142	tree tmp;
143	gfc_se se;
144
145	if (code->label1 != NULL__null)
146	return build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1))fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], gfc_get_label_decl (code->label1));
147
148	/* ASSIGNED GOTO. */
149	gfc_init_se (&se, NULL__null);
150	gfc_start_block (&se.pre);
151	gfc_conv_label_variable (&se, code->expr1);
152	tmp = GFC_DECL_STRING_LEN (se.expr)((contains_struct_check ((se.expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 152, __FUNCTION__))->decl_common.lang_specific)->stringlen;
153	tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
154	build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 154, __FUNCTION__))->typed.type), -1));
155	gfc_trans_runtime_check (true, false, tmp, &se.pre, &loc,
156	"Assigned label is not a target label");
157
158	assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr)((contains_struct_check ((se.expr), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 158, __FUNCTION__))->decl_common.lang_specific)->addr;
159
160	/* We're going to ignore a label list. It does not really change the
161	statement's semantics (because it is just a further restriction on
162	what's legal code); before, we were comparing label addresses here, but
163	that's a very fragile business and may break with optimization. So
164	just ignore it. */
165
166	target = fold_build1_loc (input_location, GOTO_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
167	assigned_goto);
168	gfc_add_expr_to_block (&se.pre, target);
169	return gfc_finish_block (&se.pre);
170	}
171
172
173	/* Translate an ENTRY statement. Just adds a label for this entry point. */
174	tree
175	gfc_trans_entry (gfc_code * code)
176	{
177	return build1_v (LABEL_EXPR, code->ext.entry->label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], code->ext.entry->label);
178	}
179
180
181	/* Replace a gfc_ss structure by another both in the gfc_se struct
182	and the gfc_loopinfo struct. This is used in gfc_conv_elemental_dependencies
183	to replace a variable ss by the corresponding temporary. */
184
185	static void
186	replace_ss (gfc_se se, gfc_ss old_ss, gfc_ss *new_ss)
187	{
188	gfc_ss sess, loopss;
189
190	/* The old_ss is a ss for a single variable. */
191	gcc_assert (old_ss->info->type == GFC_SS_SECTION)((void)(!(old_ss->info->type == GFC_SS_SECTION) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 191, __FUNCTION__), 0 : 0));
192
193	for (sess = &(se->ss); sess != gfc_ss_terminator; sess = &((sess)->next))
194	if (*sess == old_ss)
195	break;
196	gcc_assert (sess != gfc_ss_terminator)((void)(!(sess != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 196, __FUNCTION__), 0 : 0));
197
198	*sess = new_ss;
199	new_ss->next = old_ss->next;
200
201	/* Make sure that trailing references are not lost. */
202	if (old_ss->info
203	&& old_ss->info->data.array.ref
204	&& old_ss->info->data.array.ref->next
205	&& !(new_ss->info->data.array.ref
206	&& new_ss->info->data.array.ref->next))
207	new_ss->info->data.array.ref = old_ss->info->data.array.ref;
208
209	for (loopss = &(se->loop->ss); *loopss != gfc_ss_terminator;
210	loopss = &((*loopss)->loop_chain))
211	if (*loopss == old_ss)
212	break;
213	gcc_assert (loopss != gfc_ss_terminator)((void)(!(loopss != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 213, __FUNCTION__), 0 : 0));
214
215	*loopss = new_ss;
216	new_ss->loop_chain = old_ss->loop_chain;
217	new_ss->loop = old_ss->loop;
218
219	gfc_free_ss (old_ss);
220	}
221
222
223	/* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
224	elemental subroutines. Make temporaries for output arguments if any such
225	dependencies are found. Output arguments are chosen because internal_unpack
226	can be used, as is, to copy the result back to the variable. */
227	static void
228	gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
229	gfc_symbol * sym, gfc_actual_arglist * arg,
230	gfc_dep_check check_variable)
231	{
232	gfc_actual_arglist *arg0;
233	gfc_expr *e;
234	gfc_formal_arglist *formal;
235	gfc_se parmse;
236	gfc_ss *ss;
237	gfc_symbol *fsym;
238	tree data;
239	tree size;
240	tree tmp;
241
242	if (loopse->ss == NULL__null)
243	return;
244
245	ss = loopse->ss;
	Value stored to 'ss' is never read
246	arg0 = arg;
247	formal = gfc_sym_get_dummy_args (sym);
248
249	/* Loop over all the arguments testing for dependencies. */
250	for (; arg != NULL__null; arg = arg->next, formal = formal ? formal->next : NULL__null)
251	{
252	e = arg->expr;
253	if (e == NULL__null)
254	continue;
255
256	/* Obtain the info structure for the current argument. */
257	for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
258	if (ss->info->expr == e)
259	break;
260
261	/* If there is a dependency, create a temporary and use it
262	instead of the variable. */
263	fsym = formal ? formal->sym : NULL__null;
264	if (e->expr_type == EXPR_VARIABLE
265	&& e->rank && fsym
266	&& fsym->attr.intent != INTENT_IN
267	&& !fsym->attr.value
268	&& gfc_check_fncall_dependency (e, fsym->attr.intent,
269	sym, arg0, check_variable))
270	{
271	tree initial, temptype;
272	stmtblock_t temp_post;
273	gfc_ss *tmp_ss;
274
275	tmp_ss = gfc_get_array_ss (gfc_ss_terminator, NULL__null, ss->dimen,
276	GFC_SS_SECTION);
277	gfc_mark_ss_chain_used (tmp_ss, 1);
278	tmp_ss->info->expr = ss->info->expr;
279	replace_ss (loopse, ss, tmp_ss);
280
281	/* Obtain the argument descriptor for unpacking. */
282	gfc_init_se (&parmse, NULL__null);
283	parmse.want_pointer = 1;
284	gfc_conv_expr_descriptor (&parmse, e);
285	gfc_add_block_to_block (&se->pre, &parmse.pre);
286
287	/* If we've got INTENT(INOUT) or a derived type with INTENT(OUT),
288	initialize the array temporary with a copy of the values. */
289	if (fsym->attr.intent == INTENT_INOUT
290	\|\| (fsym->ts.type ==BT_DERIVED
291	&& fsym->attr.intent == INTENT_OUT))
292	initial = parmse.expr;
293	/* For class expressions, we always initialize with the copy of
294	the values. */
295	else if (e->ts.type == BT_CLASS)
296	initial = parmse.expr;
297	else
298	initial = NULL_TREE(tree) __null;
299
300	if (e->ts.type != BT_CLASS)
301	{
302	/* Find the type of the temporary to create; we don't use the type
303	of e itself as this breaks for subcomponent-references in e
304	(where the type of e is that of the final reference, but
305	parmse.expr's type corresponds to the full derived-type). */
306	/* TODO: Fix this somehow so we don't need a temporary of the whole
307	array but instead only the components referenced. */
308	temptype = TREE_TYPE (parmse.expr)((contains_struct_check ((parmse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 308, __FUNCTION__))->typed.type); /* Pointer to descriptor. */
309	gcc_assert (TREE_CODE (temptype) == POINTER_TYPE)((void)(!(((enum tree_code) (temptype)->base.code) == POINTER_TYPE ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 309, __FUNCTION__), 0 : 0));
310	temptype = TREE_TYPE (temptype)((contains_struct_check ((temptype), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 310, __FUNCTION__))->typed.type);
311	temptype = gfc_get_element_type (temptype);
312	}
313
314	else
315	/* For class arrays signal that the size of the dynamic type has to
316	be obtained from the vtable, using the 'initial' expression. */
317	temptype = NULL_TREE(tree) __null;
318
319	/* Generate the temporary. Cleaning up the temporary should be the
320	very last thing done, so we add the code to a new block and add it
321	to se->post as last instructions. */
322	size = gfc_create_var (gfc_array_index_type, NULL__null);
323	data = gfc_create_var (pvoid_type_node, NULL__null);
324	gfc_init_block (&temp_post);
325	tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss,
326	temptype, initial, false, true,
327	false, &arg->expr->where);
328	gfc_add_modify (&se->pre, size, tmp);
329	tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data)fold_convert_loc (((location_t) 0), pvoid_type_node, tmp_ss-> info->data.array.data);
330	gfc_add_modify (&se->pre, data, tmp);
331
332	/* Update other ss' delta. */
333	gfc_set_delta (loopse->loop);
334
335	/* Copy the result back using unpack..... */
336	if (e->ts.type != BT_CLASS)
337	tmp = build_call_expr_loc (input_location,
338	gfor_fndecl_in_unpack, 2, parmse.expr, data);
339	else
340	{
341	/* ... except for class results where the copy is
342	unconditional. */
343	tmp = build_fold_indirect_ref_loc (input_location, parmse.expr);
344	tmp = gfc_conv_descriptor_data_get (tmp);
345	tmp = build_call_expr_loc (input_location,
346	builtin_decl_explicit (BUILT_IN_MEMCPY),
347	3, tmp, data,
348	fold_convert (size_type_node, size)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], size));
349	}
350	gfc_add_expr_to_block (&se->post, tmp);
351
352	/* parmse.pre is already added above. */
353	gfc_add_block_to_block (&se->post, &parmse.post);
354	gfc_add_block_to_block (&se->post, &temp_post);
355	}
356	}
357	}
358
359
360	/* Given an executable statement referring to an intrinsic function call,
361	returns the intrinsic symbol. */
362
363	static gfc_intrinsic_sym *
364	get_intrinsic_for_code (gfc_code *code)
365	{
366	if (code->op == EXEC_CALL)
367	{
368	gfc_intrinsic_sym * const isym = code->resolved_isym;
369	if (isym)
370	return isym;
371	else
372	return gfc_get_intrinsic_for_expr (code->expr1);
373	}
374
375	return NULL__null;
376	}
377
378
379	/* Translate the CALL statement. Builds a call to an F95 subroutine. */
380
381	tree
382	gfc_trans_call (gfc_code * code, bool dependency_check,
383	tree mask, tree count1, bool invert)
384	{
385	gfc_se se;
386	gfc_ss * ss;
387	int has_alternate_specifier;
388	gfc_dep_check check_variable;
389	tree index = NULL_TREE(tree) __null;
390	tree maskexpr = NULL_TREE(tree) __null;
391	tree tmp;
392	bool is_intrinsic_mvbits;
393
394	/* A CALL starts a new block because the actual arguments may have to
395	be evaluated first. */
396	gfc_init_se (&se, NULL__null);
397	gfc_start_block (&se.pre);
398
399	gcc_assert (code->resolved_sym)((void)(!(code->resolved_sym) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 399, __FUNCTION__), 0 : 0));
400
401	ss = gfc_ss_terminator;
402	if (code->resolved_sym->attr.elemental)
403	ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
404	get_intrinsic_for_code (code),
405	GFC_SS_REFERENCE);
406
407	/* MVBITS is inlined but needs the dependency checking found here. */
408	is_intrinsic_mvbits = code->resolved_isym
409	&& code->resolved_isym->id == GFC_ISYM_MVBITS;
410
411	/* Is not an elemental subroutine call with array valued arguments. */
412	if (ss == gfc_ss_terminator)
413	{
414
415	if (is_intrinsic_mvbits)
416	{
417	has_alternate_specifier = 0;
418	gfc_conv_intrinsic_mvbits (&se, code->ext.actual, NULL__null);
419	}
420	else
421	{
422	/* Translate the call. */
423	has_alternate_specifier =
424	gfc_conv_procedure_call (&se, code->resolved_sym,
425	code->ext.actual, code->expr1, NULL__null);
426
427	/* A subroutine without side-effect, by definition, does nothing! */
428	TREE_SIDE_EFFECTS (se.expr)((non_type_check ((se.expr), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 428, __FUNCTION__))->base.side_effects_flag) = 1;
429	}
430
431	/* Chain the pieces together and return the block. */
432	if (has_alternate_specifier)
433	{
434	gfc_code *select_code;
435	gfc_symbol *sym;
436	select_code = code->next;
437	gcc_assert(select_code->op == EXEC_SELECT)((void)(!(select_code->op == EXEC_SELECT) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 437, __FUNCTION__), 0 : 0));
438	sym = select_code->expr1->symtree->n.sym;
439	se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr);
440	if (sym->backend_decl == NULL__null)
441	sym->backend_decl = gfc_get_symbol_decl (sym);
442	gfc_add_modify (&se.pre, sym->backend_decl, se.expr);
443	}
444	else
445	gfc_add_expr_to_block (&se.pre, se.expr);
446
447	gfc_add_block_to_block (&se.finalblock, &se.post);
448	gfc_add_block_to_block (&se.pre, &se.finalblock);
449	}
450
451	else
452	{
453	/* An elemental subroutine call with array valued arguments has
454	to be scalarized. */
455	gfc_loopinfo loop;
456	stmtblock_t body;
457	stmtblock_t block;
458	gfc_se loopse;
459	gfc_se depse;
460
461	/* gfc_walk_elemental_function_args renders the ss chain in the
462	reverse order to the actual argument order. */
463	ss = gfc_reverse_ss (ss);
464
465	/* Initialize the loop. */
466	gfc_init_se (&loopse, NULL__null);
467	gfc_init_loopinfo (&loop);
468	gfc_add_ss_to_loop (&loop, ss);
469
470	gfc_conv_ss_startstride (&loop);
471	/* TODO: gfc_conv_loop_setup generates a temporary for vector
472	subscripts. This could be prevented in the elemental case
473	as temporaries are handled separatedly
474	(below in gfc_conv_elemental_dependencies). */
475	if (code->expr1)
476	gfc_conv_loop_setup (&loop, &code->expr1->where);
477	else
478	gfc_conv_loop_setup (&loop, &code->loc);
479
480	gfc_mark_ss_chain_used (ss, 1);
481
482	/* Convert the arguments, checking for dependencies. */
483	gfc_copy_loopinfo_to_se (&loopse, &loop);
484	loopse.ss = ss;
485
486	/* For operator assignment, do dependency checking. */
487	if (dependency_check)
488	check_variable = ELEM_CHECK_VARIABLE;
489	else
490	check_variable = ELEM_DONT_CHECK_VARIABLE;
491
492	gfc_init_se (&depse, NULL__null);
493	gfc_conv_elemental_dependencies (&depse, &loopse, code->resolved_sym,
494	code->ext.actual, check_variable);
495
496	gfc_add_block_to_block (&loop.pre, &depse.pre);
497	gfc_add_block_to_block (&loop.post, &depse.post);
498
499	/* Generate the loop body. */
500	gfc_start_scalarized_body (&loop, &body);
501	gfc_init_block (&block);
502
503	if (mask && count1)
504	{
505	/* Form the mask expression according to the mask. */
506	index = count1;
507	maskexpr = gfc_build_array_ref (mask, index, NULL__null);
508	if (invert)
509	maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
510	TREE_TYPE (maskexpr)((contains_struct_check ((maskexpr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 510, __FUNCTION__))->typed.type), maskexpr);
511	}
512
513	if (is_intrinsic_mvbits)
514	{
515	has_alternate_specifier = 0;
516	gfc_conv_intrinsic_mvbits (&loopse, code->ext.actual, &loop);
517	}
518	else
519	{
520	/* Add the subroutine call to the block. */
521	gfc_conv_procedure_call (&loopse, code->resolved_sym,
522	code->ext.actual, code->expr1,
523	NULL__null);
524	}
525
526	if (mask && count1)
527	{
528	tmp = build3_v (COND_EXPR, maskexpr, loopse.expr,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], maskexpr, loopse.expr, build_empty_stmt (input_location))
529	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], maskexpr, loopse.expr, build_empty_stmt (input_location));
530	gfc_add_expr_to_block (&loopse.pre, tmp);
531	tmp = fold_build2_loc (input_location, PLUS_EXPR,
532	gfc_array_index_type,
533	count1, gfc_index_one_nodegfc_rank_cst[1]);
534	gfc_add_modify (&loopse.pre, count1, tmp);
535	}
536	else
537	gfc_add_expr_to_block (&loopse.pre, loopse.expr);
538
539	gfc_add_block_to_block (&block, &loopse.pre);
540	gfc_add_block_to_block (&block, &loopse.post);
541
542	/* Finish up the loop block and the loop. */
543	gfc_add_expr_to_block (&body, gfc_finish_block (&block));
544	gfc_trans_scalarizing_loops (&loop, &body);
545	gfc_add_block_to_block (&se.pre, &loop.pre);
546	gfc_add_block_to_block (&se.pre, &loop.post);
547	gfc_add_block_to_block (&se.pre, &loopse.finalblock);
548	gfc_add_block_to_block (&se.pre, &se.post);
549	gfc_cleanup_loop (&loop);
550	}
551
552	return gfc_finish_block (&se.pre);
553	}
554
555
556	/* Translate the RETURN statement. */
557
558	tree
559	gfc_trans_return (gfc_code * code)
560	{
561	if (code->expr1)
562	{
563	gfc_se se;
564	tree tmp;
565	tree result;
566
567	/* If code->expr is not NULL, this return statement must appear
568	in a subroutine and current_fake_result_decl has already
569	been generated. */
570
571	result = gfc_get_fake_result_decl (NULL__null, 0);
572	if (!result)
573	{
574	gfc_warning (0,
575	"An alternate return at %L without a * dummy argument",
576	&code->expr1->where);
577	return gfc_generate_return ();
578	}
579
580	/* Start a new block for this statement. */
581	gfc_init_se (&se, NULL__null);
582	gfc_start_block (&se.pre);
583
584	gfc_conv_expr (&se, code->expr1);
585
586	/* Note that the actually returned expression is a simple value and
587	does not depend on any pointers or such; thus we can clean-up with
588	se.post before returning. */
589	tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (result)((contains_struct_check ((result), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 589, __FUNCTION__))->typed.type),
590	result, fold_convert (TREE_TYPE (result),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (result), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 590, __FUNCTION__))->typed.type), se.expr)
591	se.expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (result), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 590, __FUNCTION__))->typed.type), se.expr));
592	gfc_add_expr_to_block (&se.pre, tmp);
593	gfc_add_block_to_block (&se.pre, &se.post);
594
595	tmp = gfc_generate_return ();
596	gfc_add_expr_to_block (&se.pre, tmp);
597	return gfc_finish_block (&se.pre);
598	}
599
600	return gfc_generate_return ();
601	}
602
603
604	/* Translate the PAUSE statement. We have to translate this statement
605	to a runtime library call. */
606
607	tree
608	gfc_trans_pause (gfc_code * code)
609	{
610	tree gfc_int8_type_node = gfc_get_int_type (8);
611	gfc_se se;
612	tree tmp;
613
614	/* Start a new block for this statement. */
615	gfc_init_se (&se, NULL__null);
616	gfc_start_block (&se.pre);
617
618
619	if (code->expr1 == NULL__null)
620	{
621	tmp = build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], 0);
622	tmp = build_call_expr_loc (input_location,
623	gfor_fndecl_pause_string, 2,
624	build_int_cst (pchar_type_node, 0), tmp);
625	}
626	else if (code->expr1->ts.type == BT_INTEGER)
627	{
628	gfc_conv_expr (&se, code->expr1);
629	tmp = build_call_expr_loc (input_location,
630	gfor_fndecl_pause_numeric, 1,
631	fold_convert (gfc_int8_type_node, se.expr)fold_convert_loc (((location_t) 0), gfc_int8_type_node, se.expr ));
632	}
633	else
634	{
635	gfc_conv_expr_reference (&se, code->expr1);
636	tmp = build_call_expr_loc (input_location,
637	gfor_fndecl_pause_string, 2,
638	se.expr, fold_convert (size_type_node,fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], se.string_length)
639	se.string_length)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], se.string_length));
640	}
641
642	gfc_add_expr_to_block (&se.pre, tmp);
643
644	gfc_add_block_to_block (&se.pre, &se.post);
645
646	return gfc_finish_block (&se.pre);
647	}
648
649
650	/* Translate the STOP statement. We have to translate this statement
651	to a runtime library call. */
652
653	tree
654	gfc_trans_stop (gfc_code *code, bool error_stop)
655	{
656	gfc_se se;
657	tree tmp;
658	tree quiet;
659
660	/* Start a new block for this statement. */
661	gfc_init_se (&se, NULL__null);
662	gfc_start_block (&se.pre);
663
664	if (code->expr2)
665	{
666	gfc_conv_expr_val (&se, code->expr2);
667	quiet = fold_convert (boolean_type_node, se.expr)fold_convert_loc (((location_t) 0), global_trees[TI_BOOLEAN_TYPE ], se.expr);
668	}
669	else
670	quiet = boolean_false_nodeglobal_trees[TI_BOOLEAN_FALSE];
671
672	if (code->expr1 == NULL__null)
673	{
674	tmp = build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], 0);
675	tmp = build_call_expr_loc (input_location,
676	error_stop
677	? (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
678	? gfor_fndecl_caf_error_stop_str
679	: gfor_fndecl_error_stop_string)
680	: (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
681	? gfor_fndecl_caf_stop_str
682	: gfor_fndecl_stop_string),
683	3, build_int_cst (pchar_type_node, 0), tmp,
684	quiet);
685	}
686	else if (code->expr1->ts.type == BT_INTEGER)
687	{
688	gfc_conv_expr (&se, code->expr1);
689	tmp = build_call_expr_loc (input_location,
690	error_stop
691	? (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
692	? gfor_fndecl_caf_error_stop
693	: gfor_fndecl_error_stop_numeric)
694	: (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
695	? gfor_fndecl_caf_stop_numeric
696	: gfor_fndecl_stop_numeric), 2,
697	fold_convert (integer_type_node, se.expr)fold_convert_loc (((location_t) 0), integer_types[itk_int], se .expr),
698	quiet);
699	}
700	else
701	{
702	gfc_conv_expr_reference (&se, code->expr1);
703	tmp = build_call_expr_loc (input_location,
704	error_stop
705	? (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
706	? gfor_fndecl_caf_error_stop_str
707	: gfor_fndecl_error_stop_string)
708	: (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
709	? gfor_fndecl_caf_stop_str
710	: gfor_fndecl_stop_string),
711	3, se.expr, fold_convert (size_type_node,fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], se.string_length)
712	se.string_length)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], se.string_length),
713	quiet);
714	}
715
716	gfc_add_expr_to_block (&se.pre, tmp);
717
718	gfc_add_block_to_block (&se.pre, &se.post);
719
720	return gfc_finish_block (&se.pre);
721	}
722
723	/* Translate the FAIL IMAGE statement. */
724
725	tree
726	gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED__attribute__ ((__unused__)))
727	{
728	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
729	return build_call_expr_loc (input_location,
730	gfor_fndecl_caf_fail_image, 0);
731	else
732	{
733	const char *name = gfc_get_string (PREFIX ("exit_i%d")"_gfortran_" "exit_i%d", 4);
734	gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
735	tree tmp = gfc_get_symbol_decl (exsym);
736	return build_call_expr_loc (input_location, tmp, 1, integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
737	}
738	}
739
740	/* Translate the FORM TEAM statement. */
741
742	tree
743	gfc_trans_form_team (gfc_code *code)
744	{
745	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
746	{
747	gfc_se se;
748	gfc_se argse1, argse2;
749	tree team_id, team_type, tmp;
750
751	gfc_init_se (&se, NULL__null);
752	gfc_init_se (&argse1, NULL__null);
753	gfc_init_se (&argse2, NULL__null);
754	gfc_start_block (&se.pre);
755
756	gfc_conv_expr_val (&argse1, code->expr1);
757	gfc_conv_expr_val (&argse2, code->expr2);
758	team_id = fold_convert (integer_type_node, argse1.expr)fold_convert_loc (((location_t) 0), integer_types[itk_int], argse1 .expr);
759	team_type = gfc_build_addr_expr (ppvoid_type_node, argse2.expr);
760
761	gfc_add_block_to_block (&se.pre, &argse1.pre);
762	gfc_add_block_to_block (&se.pre, &argse2.pre);
763	tmp = build_call_expr_loc (input_location,
764	gfor_fndecl_caf_form_team, 3,
765	team_id, team_type,
766	build_int_cst (integer_type_nodeinteger_types[itk_int], 0));
767	gfc_add_expr_to_block (&se.pre, tmp);
768	gfc_add_block_to_block (&se.pre, &argse1.post);
769	gfc_add_block_to_block (&se.pre, &argse2.post);
770	return gfc_finish_block (&se.pre);
771	}
772	else
773	{
774	const char *name = gfc_get_string (PREFIX ("exit_i%d")"_gfortran_" "exit_i%d", 4);
775	gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
776	tree tmp = gfc_get_symbol_decl (exsym);
777	return build_call_expr_loc (input_location, tmp, 1, integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
778	}
779	}
780
781	/* Translate the CHANGE TEAM statement. */
782
783	tree
784	gfc_trans_change_team (gfc_code *code)
785	{
786	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
787	{
788	gfc_se argse;
789	tree team_type, tmp;
790
791	gfc_init_se (&argse, NULL__null);
792	gfc_conv_expr_val (&argse, code->expr1);
793	team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
794
795	tmp = build_call_expr_loc (input_location,
796	gfor_fndecl_caf_change_team, 2, team_type,
797	build_int_cst (integer_type_nodeinteger_types[itk_int], 0));
798	gfc_add_expr_to_block (&argse.pre, tmp);
799	gfc_add_block_to_block (&argse.pre, &argse.post);
800	return gfc_finish_block (&argse.pre);
801	}
802	else
803	{
804	const char *name = gfc_get_string (PREFIX ("exit_i%d")"_gfortran_" "exit_i%d", 4);
805	gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
806	tree tmp = gfc_get_symbol_decl (exsym);
807	return build_call_expr_loc (input_location, tmp, 1, integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
808	}
809	}
810
811	/* Translate the END TEAM statement. */
812
813	tree
814	gfc_trans_end_team (gfc_code *code ATTRIBUTE_UNUSED__attribute__ ((__unused__)))
815	{
816	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
817	{
818	return build_call_expr_loc (input_location,
819	gfor_fndecl_caf_end_team, 1,
820	build_int_cst (pchar_type_node, 0));
821	}
822	else
823	{
824	const char *name = gfc_get_string (PREFIX ("exit_i%d")"_gfortran_" "exit_i%d", 4);
825	gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
826	tree tmp = gfc_get_symbol_decl (exsym);
827	return build_call_expr_loc (input_location, tmp, 1, integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
828	}
829	}
830
831	/* Translate the SYNC TEAM statement. */
832
833	tree
834	gfc_trans_sync_team (gfc_code *code)
835	{
836	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
837	{
838	gfc_se argse;
839	tree team_type, tmp;
840
841	gfc_init_se (&argse, NULL__null);
842	gfc_conv_expr_val (&argse, code->expr1);
843	team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
844
845	tmp = build_call_expr_loc (input_location,
846	gfor_fndecl_caf_sync_team, 2,
847	team_type,
848	build_int_cst (integer_type_nodeinteger_types[itk_int], 0));
849	gfc_add_expr_to_block (&argse.pre, tmp);
850	gfc_add_block_to_block (&argse.pre, &argse.post);
851	return gfc_finish_block (&argse.pre);
852	}
853	else
854	{
855	const char *name = gfc_get_string (PREFIX ("exit_i%d")"_gfortran_" "exit_i%d", 4);
856	gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
857	tree tmp = gfc_get_symbol_decl (exsym);
858	return build_call_expr_loc (input_location, tmp, 1, integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
859	}
860	}
861
862	tree
863	gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
864	{
865	gfc_se se, argse;
866	tree stat = NULL_TREE(tree) __null, stat2 = NULL_TREE(tree) __null;
867	tree lock_acquired = NULL_TREE(tree) __null, lock_acquired2 = NULL_TREE(tree) __null;
868
869	/* Short cut: For single images without STAT= or LOCK_ACQUIRED
870	return early. (ERRMSG= is always untouched for -fcoarray=single.) */
871	if (!code->expr2 && !code->expr4 && flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB)
872	return NULL_TREE(tree) __null;
873
874	if (code->expr2)
875	{
876	gcc_assert (code->expr2->expr_type == EXPR_VARIABLE)((void)(!(code->expr2->expr_type == EXPR_VARIABLE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 876, __FUNCTION__), 0 : 0));
877	gfc_init_se (&argse, NULL__null);
878	gfc_conv_expr_val (&argse, code->expr2);
879	stat = argse.expr;
880	}
881	else if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
882	stat = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
883
884	if (code->expr4)
885	{
886	gcc_assert (code->expr4->expr_type == EXPR_VARIABLE)((void)(!(code->expr4->expr_type == EXPR_VARIABLE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 886, __FUNCTION__), 0 : 0));
887	gfc_init_se (&argse, NULL__null);
888	gfc_conv_expr_val (&argse, code->expr4);
889	lock_acquired = argse.expr;
890	}
891	else if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
892	lock_acquired = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
893
894	gfc_start_block (&se.pre);
895	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
896	{
897	tree tmp, token, image_index, errmsg, errmsg_len;
898	tree index = build_zero_cst (gfc_array_index_type);
899	tree caf_decl = gfc_get_tree_for_caf_expr (code->expr1);
900
901	if (code->expr1->symtree->n.sym->ts.type != BT_DERIVED
902	\|\| code->expr1->symtree->n.sym->ts.u.derived->from_intmod
903	!= INTMOD_ISO_FORTRAN_ENV
904	\|\| code->expr1->symtree->n.sym->ts.u.derived->intmod_sym_id
905	!= ISOFORTRAN_LOCK_TYPE)
906	{
907	gfc_error ("Sorry, the lock component of derived type at %L is not "
908	"yet supported", &code->expr1->where);
909	return NULL_TREE(tree) __null;
910	}
911
912	gfc_get_caf_token_offset (&se, &token, NULL__null, caf_decl, NULL_TREE(tree) __null,
913	code->expr1);
914
915	if (gfc_is_coindexed (code->expr1))
916	image_index = gfc_caf_get_image_index (&se.pre, code->expr1, caf_decl);
917	else
918	image_index = integer_zero_nodeglobal_trees[TI_INTEGER_ZERO];
919
920	/* For arrays, obtain the array index. */
921	if (gfc_expr_attr (code->expr1).dimension)
922	{
923	tree desc, tmp, extent, lbound, ubound;
924	gfc_array_ref *ar, ar2;
925	int i;
926
927	/* TODO: Extend this, once DT components are supported. */
928	ar = &code->expr1->ref->u.ar;
929	ar2 = *ar;
930	memset (ar, '\0', sizeof (*ar));
931	ar->as = ar2.as;
932	ar->type = AR_FULL;
933
934	gfc_init_se (&argse, NULL__null);
935	argse.descriptor_only = 1;
936	gfc_conv_expr_descriptor (&argse, code->expr1);
937	gfc_add_block_to_block (&se.pre, &argse.pre);
938	desc = argse.expr;
939	*ar = ar2;
940
941	extent = build_one_cst (gfc_array_index_type);
942	for (i = 0; i < ar->dimen; i++)
943	{
944	gfc_init_se (&argse, NULL__null);
945	gfc_conv_expr_type (&argse, ar->start[i], gfc_array_index_type);
946	gfc_add_block_to_block (&argse.pre, &argse.pre);
947	lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
948	tmp = fold_build2_loc (input_location, MINUS_EXPR,
949	TREE_TYPE (lbound)((contains_struct_check ((lbound), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 949, __FUNCTION__))->typed.type), argse.expr, lbound);
950	tmp = fold_build2_loc (input_location, MULT_EXPR,
951	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 951, __FUNCTION__))->typed.type), extent, tmp);
952	index = fold_build2_loc (input_location, PLUS_EXPR,
953	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 953, __FUNCTION__))->typed.type), index, tmp);
954	if (i < ar->dimen - 1)
955	{
956	ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
957	tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL__null);
958	extent = fold_build2_loc (input_location, MULT_EXPR,
959	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 959, __FUNCTION__))->typed.type), extent, tmp);
960	}
961	}
962	}
963
964	/* errmsg. */
965	if (code->expr3)
966	{
967	gfc_init_se (&argse, NULL__null);
968	argse.want_pointer = 1;
969	gfc_conv_expr (&argse, code->expr3);
970	gfc_add_block_to_block (&se.pre, &argse.pre);
971	errmsg = argse.expr;
972	errmsg_len = fold_convert (size_type_node, argse.string_length)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], argse.string_length);
973	}
974	else
975	{
976	errmsg = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
977	errmsg_len = build_zero_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
978	}
979
980	if (stat != null_pointer_nodeglobal_trees[TI_NULL_POINTER] && TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 980, __FUNCTION__))->typed.type) != integer_type_nodeinteger_types[itk_int])
981	{
982	stat2 = stat;
983	stat = gfc_create_var (integer_type_nodeinteger_types[itk_int], "stat");
984	}
985
986	if (lock_acquired != null_pointer_nodeglobal_trees[TI_NULL_POINTER]
987	&& TREE_TYPE (lock_acquired)((contains_struct_check ((lock_acquired), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 987, __FUNCTION__))->typed.type) != integer_type_nodeinteger_types[itk_int])
988	{
989	lock_acquired2 = lock_acquired;
990	lock_acquired = gfc_create_var (integer_type_nodeinteger_types[itk_int], "acquired");
991	}
992
993	index = fold_convert (size_type_node, index)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], index);
994	if (op == EXEC_LOCK)
995	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
996	token, index, image_index,
997	lock_acquired != null_pointer_nodeglobal_trees[TI_NULL_POINTER]
998	? gfc_build_addr_expr (NULL__null, lock_acquired)
999	: lock_acquired,
1000	stat != null_pointer_nodeglobal_trees[TI_NULL_POINTER]
1001	? gfc_build_addr_expr (NULL__null, stat) : stat,
1002	errmsg, errmsg_len);
1003	else
1004	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_unlock, 6,
1005	token, index, image_index,
1006	stat != null_pointer_nodeglobal_trees[TI_NULL_POINTER]
1007	? gfc_build_addr_expr (NULL__null, stat) : stat,
1008	errmsg, errmsg_len);
1009	gfc_add_expr_to_block (&se.pre, tmp);
1010
1011	/* It guarantees memory consistency within the same segment */
1012	tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
1013	tmp = build5_loc (input_location, ASM_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1014	gfc_build_string_const (1, ""), NULL_TREE(tree) __null, NULL_TREE(tree) __null,
1015	tree_cons (NULL_TREE(tree) __null, tmp, NULL_TREE(tree) __null), NULL_TREE(tree) __null);
1016	ASM_VOLATILE_P (tmp)((tree_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1016, __FUNCTION__, (ASM_EXPR)))->base.public_flag) = 1;
1017
1018	gfc_add_expr_to_block (&se.pre, tmp);
1019
1020	if (stat2 != NULL_TREE(tree) __null)
1021	gfc_add_modify (&se.pre, stat2,
1022	fold_convert (TREE_TYPE (stat2), stat)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (stat2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1022, __FUNCTION__))->typed.type), stat));
1023
1024	if (lock_acquired2 != NULL_TREE(tree) __null)
1025	gfc_add_modify (&se.pre, lock_acquired2,
1026	fold_convert (TREE_TYPE (lock_acquired2),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (lock_acquired2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1026, __FUNCTION__))->typed.type), lock_acquired)
1027	lock_acquired)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (lock_acquired2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1026, __FUNCTION__))->typed.type), lock_acquired));
1028
1029	return gfc_finish_block (&se.pre);
1030	}
1031
1032	if (stat != NULL_TREE(tree) __null)
1033	gfc_add_modify (&se.pre, stat, build_int_cst (TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1033, __FUNCTION__))->typed.type), 0));
1034
1035	if (lock_acquired != NULL_TREE(tree) __null)
1036	gfc_add_modify (&se.pre, lock_acquired,
1037	fold_convert (TREE_TYPE (lock_acquired),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (lock_acquired), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1037, __FUNCTION__))->typed.type), global_trees[TI_BOOLEAN_TRUE ])
1038	boolean_true_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (lock_acquired), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1037, __FUNCTION__))->typed.type), global_trees[TI_BOOLEAN_TRUE ]));
1039
1040	return gfc_finish_block (&se.pre);
1041	}
1042
1043	tree
1044	gfc_trans_event_post_wait (gfc_code *code, gfc_exec_op op)
1045	{
1046	gfc_se se, argse;
1047	tree stat = NULL_TREE(tree) __null, stat2 = NULL_TREE(tree) __null;
1048	tree until_count = NULL_TREE(tree) __null;
1049
1050	if (code->expr2)
1051	{
1052	gcc_assert (code->expr2->expr_type == EXPR_VARIABLE)((void)(!(code->expr2->expr_type == EXPR_VARIABLE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1052, __FUNCTION__), 0 : 0));
1053	gfc_init_se (&argse, NULL__null);
1054	gfc_conv_expr_val (&argse, code->expr2);
1055	stat = argse.expr;
1056	}
1057	else if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1058	stat = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
1059
1060	if (code->expr4)
1061	{
1062	gfc_init_se (&argse, NULL__null);
1063	gfc_conv_expr_val (&argse, code->expr4);
1064	until_count = fold_convert (integer_type_node, argse.expr)fold_convert_loc (((location_t) 0), integer_types[itk_int], argse .expr);
1065	}
1066	else
1067	until_count = integer_one_nodeglobal_trees[TI_INTEGER_ONE];
1068
1069	if (flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB)
1070	{
1071	gfc_start_block (&se.pre);
1072	gfc_init_se (&argse, NULL__null);
1073	gfc_conv_expr_val (&argse, code->expr1);
1074
1075	if (op == EXEC_EVENT_POST)
1076	gfc_add_modify (&se.pre, argse.expr,
1077	fold_build2_loc (input_location, PLUS_EXPR,
1078	TREE_TYPE (argse.expr)((contains_struct_check ((argse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1078, __FUNCTION__))->typed.type), argse.expr,
1079	build_int_cst (TREE_TYPE (argse.expr)((contains_struct_check ((argse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1079, __FUNCTION__))->typed.type), 1)));
1080	else
1081	gfc_add_modify (&se.pre, argse.expr,
1082	fold_build2_loc (input_location, MINUS_EXPR,
1083	TREE_TYPE (argse.expr)((contains_struct_check ((argse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1083, __FUNCTION__))->typed.type), argse.expr,
1084	fold_convert (TREE_TYPE (argse.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (argse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1084, __FUNCTION__))->typed.type), until_count)
1085	until_count)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (argse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1084, __FUNCTION__))->typed.type), until_count)));
1086	if (stat != NULL_TREE(tree) __null)
1087	gfc_add_modify (&se.pre, stat, build_int_cst (TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1087, __FUNCTION__))->typed.type), 0));
1088
1089	return gfc_finish_block (&se.pre);
1090	}
1091
1092	gfc_start_block (&se.pre);
1093	tree tmp, token, image_index, errmsg, errmsg_len;
1094	tree index = build_zero_cst (gfc_array_index_type);
1095	tree caf_decl = gfc_get_tree_for_caf_expr (code->expr1);
1096
1097	if (code->expr1->symtree->n.sym->ts.type != BT_DERIVED
1098	\|\| code->expr1->symtree->n.sym->ts.u.derived->from_intmod
1099	!= INTMOD_ISO_FORTRAN_ENV
1100	\|\| code->expr1->symtree->n.sym->ts.u.derived->intmod_sym_id
1101	!= ISOFORTRAN_EVENT_TYPE)
1102	{
1103	gfc_error ("Sorry, the event component of derived type at %L is not "
1104	"yet supported", &code->expr1->where);
1105	return NULL_TREE(tree) __null;
1106	}
1107
1108	gfc_init_se (&argse, NULL__null);
1109	gfc_get_caf_token_offset (&argse, &token, NULL__null, caf_decl, NULL_TREE(tree) __null,
1110	code->expr1);
1111	gfc_add_block_to_block (&se.pre, &argse.pre);
1112
1113	if (gfc_is_coindexed (code->expr1))
1114	image_index = gfc_caf_get_image_index (&se.pre, code->expr1, caf_decl);
1115	else
1116	image_index = integer_zero_nodeglobal_trees[TI_INTEGER_ZERO];
1117
1118	/* For arrays, obtain the array index. */
1119	if (gfc_expr_attr (code->expr1).dimension)
1120	{
1121	tree desc, tmp, extent, lbound, ubound;
1122	gfc_array_ref *ar, ar2;
1123	int i;
1124
1125	/* TODO: Extend this, once DT components are supported. */
1126	ar = &code->expr1->ref->u.ar;
1127	ar2 = *ar;
1128	memset (ar, '\0', sizeof (*ar));
1129	ar->as = ar2.as;
1130	ar->type = AR_FULL;
1131
1132	gfc_init_se (&argse, NULL__null);
1133	argse.descriptor_only = 1;
1134	gfc_conv_expr_descriptor (&argse, code->expr1);
1135	gfc_add_block_to_block (&se.pre, &argse.pre);
1136	desc = argse.expr;
1137	*ar = ar2;
1138
1139	extent = build_one_cst (gfc_array_index_type);
1140	for (i = 0; i < ar->dimen; i++)
1141	{
1142	gfc_init_se (&argse, NULL__null);
1143	gfc_conv_expr_type (&argse, ar->start[i], gfc_array_index_type);
1144	gfc_add_block_to_block (&argse.pre, &argse.pre);
1145	lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
1146	tmp = fold_build2_loc (input_location, MINUS_EXPR,
1147	TREE_TYPE (lbound)((contains_struct_check ((lbound), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1147, __FUNCTION__))->typed.type), argse.expr, lbound);
1148	tmp = fold_build2_loc (input_location, MULT_EXPR,
1149	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1149, __FUNCTION__))->typed.type), extent, tmp);
1150	index = fold_build2_loc (input_location, PLUS_EXPR,
1151	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1151, __FUNCTION__))->typed.type), index, tmp);
1152	if (i < ar->dimen - 1)
1153	{
1154	ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
1155	tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL__null);
1156	extent = fold_build2_loc (input_location, MULT_EXPR,
1157	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1157, __FUNCTION__))->typed.type), extent, tmp);
1158	}
1159	}
1160	}
1161
1162	/* errmsg. */
1163	if (code->expr3)
1164	{
1165	gfc_init_se (&argse, NULL__null);
1166	argse.want_pointer = 1;
1167	gfc_conv_expr (&argse, code->expr3);
1168	gfc_add_block_to_block (&se.pre, &argse.pre);
1169	errmsg = argse.expr;
1170	errmsg_len = fold_convert (size_type_node, argse.string_length)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], argse.string_length);
1171	}
1172	else
1173	{
1174	errmsg = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
1175	errmsg_len = build_zero_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1176	}
1177
1178	if (stat != null_pointer_nodeglobal_trees[TI_NULL_POINTER] && TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1178, __FUNCTION__))->typed.type) != integer_type_nodeinteger_types[itk_int])
1179	{
1180	stat2 = stat;
1181	stat = gfc_create_var (integer_type_nodeinteger_types[itk_int], "stat");
1182	}
1183
1184	index = fold_convert (size_type_node, index)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], index);
1185	if (op == EXEC_EVENT_POST)
1186	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_event_post, 6,
1187	token, index, image_index,
1188	stat != null_pointer_nodeglobal_trees[TI_NULL_POINTER]
1189	? gfc_build_addr_expr (NULL__null, stat) : stat,
1190	errmsg, errmsg_len);
1191	else
1192	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_event_wait, 6,
1193	token, index, until_count,
1194	stat != null_pointer_nodeglobal_trees[TI_NULL_POINTER]
1195	? gfc_build_addr_expr (NULL__null, stat) : stat,
1196	errmsg, errmsg_len);
1197	gfc_add_expr_to_block (&se.pre, tmp);
1198
1199	/* It guarantees memory consistency within the same segment */
1200	tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
1201	tmp = build5_loc (input_location, ASM_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1202	gfc_build_string_const (1, ""), NULL_TREE(tree) __null, NULL_TREE(tree) __null,
1203	tree_cons (NULL_TREE(tree) __null, tmp, NULL_TREE(tree) __null), NULL_TREE(tree) __null);
1204	ASM_VOLATILE_P (tmp)((tree_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1204, __FUNCTION__, (ASM_EXPR)))->base.public_flag) = 1;
1205	gfc_add_expr_to_block (&se.pre, tmp);
1206
1207	if (stat2 != NULL_TREE(tree) __null)
1208	gfc_add_modify (&se.pre, stat2, fold_convert (TREE_TYPE (stat2), stat)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (stat2), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1208, __FUNCTION__))->typed.type), stat));
1209
1210	return gfc_finish_block (&se.pre);
1211	}
1212
1213	tree
1214	gfc_trans_sync (gfc_code *code, gfc_exec_op type)
1215	{
1216	gfc_se se, argse;
1217	tree tmp;
1218	tree images = NULL_TREE(tree) __null, stat = NULL_TREE(tree) __null,
1219	errmsg = NULL_TREE(tree) __null, errmsglen = NULL_TREE(tree) __null;
1220
1221	/* Short cut: For single images without bound checking or without STAT=,
1222	return early. (ERRMSG= is always untouched for -fcoarray=single.) */
1223	if (!code->expr2 && !(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
1224	&& flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB)
1225	return NULL_TREE(tree) __null;
1226
1227	gfc_init_se (&se, NULL__null);
1228	gfc_start_block (&se.pre);
1229
1230	if (code->expr1 && code->expr1->rank == 0)
1231	{
1232	gfc_init_se (&argse, NULL__null);
1233	gfc_conv_expr_val (&argse, code->expr1);
1234	images = argse.expr;
1235	}
1236
1237	if (code->expr2)
1238	{
1239	gcc_assert (code->expr2->expr_type == EXPR_VARIABLE((void)(!(code->expr2->expr_type == EXPR_VARIABLE \|\| code ->expr2->expr_type == EXPR_FUNCTION) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1240, __FUNCTION__), 0 : 0))
1240	\|\| code->expr2->expr_type == EXPR_FUNCTION)((void)(!(code->expr2->expr_type == EXPR_VARIABLE \|\| code ->expr2->expr_type == EXPR_FUNCTION) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1240, __FUNCTION__), 0 : 0));
1241	gfc_init_se (&argse, NULL__null);
1242	gfc_conv_expr_val (&argse, code->expr2);
1243	stat = argse.expr;
1244	}
1245	else
1246	stat = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
1247
1248	if (code->expr3 && flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1249	{
1250	gcc_assert (code->expr3->expr_type == EXPR_VARIABLE((void)(!(code->expr3->expr_type == EXPR_VARIABLE \|\| code ->expr3->expr_type == EXPR_FUNCTION) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1251, __FUNCTION__), 0 : 0))
1251	\|\| code->expr3->expr_type == EXPR_FUNCTION)((void)(!(code->expr3->expr_type == EXPR_VARIABLE \|\| code ->expr3->expr_type == EXPR_FUNCTION) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1251, __FUNCTION__), 0 : 0));
1252	gfc_init_se (&argse, NULL__null);
1253	argse.want_pointer = 1;
1254	gfc_conv_expr (&argse, code->expr3);
1255	gfc_conv_string_parameter (&argse);
1256	errmsg = gfc_build_addr_expr (NULL__null, argse.expr);
1257	errmsglen = fold_convert (size_type_node, argse.string_length)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], argse.string_length);
1258	}
1259	else if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1260	{
1261	errmsg = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
1262	errmsglen = build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], 0);
1263	}
1264
1265	/* Check SYNC IMAGES(imageset) for valid image index.
1266	FIXME: Add a check for image-set arrays. */
1267	if (code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
1268	&& code->expr1->rank == 0)
1269	{
1270	tree images2 = fold_convert (integer_type_node, images)fold_convert_loc (((location_t) 0), integer_types[itk_int], images );
1271	tree cond;
1272	if (flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB)
1273	cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
1274	images, build_int_cst (TREE_TYPE (images)((contains_struct_check ((images), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1274, __FUNCTION__))->typed.type), 1));
1275	else
1276	{
1277	tree cond2;
1278	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
1279	2, integer_zero_nodeglobal_trees[TI_INTEGER_ZERO],
1280	build_int_cst (integer_type_nodeinteger_types[itk_int], -1));
1281	cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
1282	images2, tmp);
1283	cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
1284	images,
1285	build_int_cst (TREE_TYPE (images)((contains_struct_check ((images), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1285, __FUNCTION__))->typed.type), 1));
1286	cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
1287	logical_type_node, cond, cond2);
1288	}
1289	gfc_trans_runtime_check (true, false, cond, &se.pre,
1290	&code->expr1->where, "Invalid image number "
1291	"%d in SYNC IMAGES", images2);
1292	}
1293
1294	/* Per F2008, 8.5.1, a SYNC MEMORY is implied by calling the
1295	image control statements SYNC IMAGES and SYNC ALL. */
1296	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1297	{
1298	tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
1299	tmp = build5_loc (input_location, ASM_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1300	gfc_build_string_const (1, ""), NULL_TREE(tree) __null, NULL_TREE(tree) __null,
1301	tree_cons (NULL_TREE(tree) __null, tmp, NULL_TREE(tree) __null), NULL_TREE(tree) __null);
1302	ASM_VOLATILE_P (tmp)((tree_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1302, __FUNCTION__, (ASM_EXPR)))->base.public_flag) = 1;
1303	gfc_add_expr_to_block (&se.pre, tmp);
1304	}
1305
1306	if (flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB)
1307	{
1308	/* Set STAT to zero. */
1309	if (code->expr2)
1310	gfc_add_modify (&se.pre, stat, build_int_cst (TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1310, __FUNCTION__))->typed.type), 0));
1311	}
1312	else if (type == EXEC_SYNC_ALL \|\| type == EXEC_SYNC_MEMORY)
1313	{
1314	/* SYNC ALL => stat == null_pointer_node
1315	SYNC ALL(stat=s) => stat has an integer type
1316
1317	If "stat" has the wrong integer type, use a temp variable of
1318	the right type and later cast the result back into "stat". */
1319	if (stat == null_pointer_nodeglobal_trees[TI_NULL_POINTER] \|\| TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1319, __FUNCTION__))->typed.type) == integer_type_nodeinteger_types[itk_int])
1320	{
1321	if (TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1321, __FUNCTION__))->typed.type) == integer_type_nodeinteger_types[itk_int])
1322	stat = gfc_build_addr_expr (NULL__null, stat);
1323
1324	if(type == EXEC_SYNC_MEMORY)
1325	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_memory,
1326	3, stat, errmsg, errmsglen);
1327	else
1328	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
1329	3, stat, errmsg, errmsglen);
1330
1331	gfc_add_expr_to_block (&se.pre, tmp);
1332	}
1333	else
1334	{
1335	tree tmp_stat = gfc_create_var (integer_type_nodeinteger_types[itk_int], "stat");
1336
1337	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
1338	3, gfc_build_addr_expr (NULL__null, tmp_stat),
1339	errmsg, errmsglen);
1340	gfc_add_expr_to_block (&se.pre, tmp);
1341
1342	gfc_add_modify (&se.pre, stat,
1343	fold_convert (TREE_TYPE (stat), tmp_stat)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1343, __FUNCTION__))->typed.type), tmp_stat));
1344	}
1345	}
1346	else
1347	{
1348	tree len;
1349
1350	gcc_assert (type == EXEC_SYNC_IMAGES)((void)(!(type == EXEC_SYNC_IMAGES) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1350, __FUNCTION__), 0 : 0));
1351
1352	if (!code->expr1)
1353	{
1354	len = build_int_cst (integer_type_nodeinteger_types[itk_int], -1);
1355	images = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
1356	}
1357	else if (code->expr1->rank == 0)
1358	{
1359	len = build_int_cst (integer_type_nodeinteger_types[itk_int], 1);
1360	images = gfc_build_addr_expr (NULL_TREE(tree) __null, images);
1361	}
1362	else
1363	{
1364	/* FIXME. */
1365	if (code->expr1->ts.kind != gfc_c_int_kind)
1366	gfc_fatal_error ("Sorry, only support for integer kind %d "
1367	"implemented for image-set at %L",
1368	gfc_c_int_kind, &code->expr1->where);
1369
1370	gfc_conv_array_parameter (&se, code->expr1, true, NULL__null, NULL__null, &len);
1371	images = se.expr;
1372
1373	tmp = gfc_typenode_for_spec (&code->expr1->ts);
1374	if (GFC_ARRAY_TYPE_P (tmp)((tree_class_check ((tmp), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1374, __FUNCTION__))->type_common.lang_flag_2) \|\| GFC_DESCRIPTOR_TYPE_P (tmp)((tree_class_check ((tmp), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1374, __FUNCTION__))->type_common.lang_flag_1))
1375	tmp = gfc_get_element_type (tmp);
1376
1377	len = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
1378	TREE_TYPE (len)((contains_struct_check ((len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1378, __FUNCTION__))->typed.type), len,
1379	fold_convert (TREE_TYPE (len),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1379, __FUNCTION__))->typed.type), ((tree_class_check (( tmp), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1380, __FUNCTION__))->type_common.size_unit))
1380	TYPE_SIZE_UNIT (tmp))fold_convert_loc (((location_t) 0), ((contains_struct_check ( (len), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1379, __FUNCTION__))->typed.type), ((tree_class_check (( tmp), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1380, __FUNCTION__))->type_common.size_unit)));
1381	len = fold_convert (integer_type_node, len)fold_convert_loc (((location_t) 0), integer_types[itk_int], len );
1382	}
1383
1384	/* SYNC IMAGES(imgs) => stat == null_pointer_node
1385	SYNC IMAGES(imgs,stat=s) => stat has an integer type
1386
1387	If "stat" has the wrong integer type, use a temp variable of
1388	the right type and later cast the result back into "stat". */
1389	if (stat == null_pointer_nodeglobal_trees[TI_NULL_POINTER] \|\| TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1389, __FUNCTION__))->typed.type) == integer_type_nodeinteger_types[itk_int])
1390	{
1391	if (TREE_TYPE (stat)((contains_struct_check ((stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1391, __FUNCTION__))->typed.type) == integer_type_nodeinteger_types[itk_int])
1392	stat = gfc_build_addr_expr (NULL__null, stat);
1393
1394	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images,
1395	5, fold_convert (integer_type_node, len)fold_convert_loc (((location_t) 0), integer_types[itk_int], len ),
1396	images, stat, errmsg, errmsglen);
1397	gfc_add_expr_to_block (&se.pre, tmp);
1398	}
1399	else
1400	{
1401	tree tmp_stat = gfc_create_var (integer_type_nodeinteger_types[itk_int], "stat");
1402
1403	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images,
1404	5, fold_convert (integer_type_node, len)fold_convert_loc (((location_t) 0), integer_types[itk_int], len ),
1405	images, gfc_build_addr_expr (NULL__null, tmp_stat),
1406	errmsg, errmsglen);
1407	gfc_add_expr_to_block (&se.pre, tmp);
1408
1409	gfc_add_modify (&se.pre, stat,
1410	fold_convert (TREE_TYPE (stat), tmp_stat)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (stat), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1410, __FUNCTION__))->typed.type), tmp_stat));
1411	}
1412	}
1413
1414	return gfc_finish_block (&se.pre);
1415	}
1416
1417
1418	/* Generate GENERIC for the IF construct. This function also deals with
1419	the simple IF statement, because the front end translates the IF
1420	statement into an IF construct.
1421
1422	We translate:
1423
1424	IF (cond) THEN
1425	then_clause
1426	ELSEIF (cond2)
1427	elseif_clause
1428	ELSE
1429	else_clause
1430	ENDIF
1431
1432	into:
1433
1434	pre_cond_s;
1435	if (cond_s)
1436	{
1437	then_clause;
1438	}
1439	else
1440	{
1441	pre_cond_s
1442	if (cond_s)
1443	{
1444	elseif_clause
1445	}
1446	else
1447	{
1448	else_clause;
1449	}
1450	}
1451
1452	where COND_S is the simplified version of the predicate. PRE_COND_S
1453	are the pre side-effects produced by the translation of the
1454	conditional.
1455	We need to build the chain recursively otherwise we run into
1456	problems with folding incomplete statements. */
1457
1458	static tree
1459	gfc_trans_if_1 (gfc_code * code)
1460	{
1461	gfc_se if_se;
1462	tree stmt, elsestmt;
1463	locus saved_loc;
1464	location_t loc;
1465
1466	/* Check for an unconditional ELSE clause. */
1467	if (!code->expr1)
1468	return gfc_trans_code (code->next);
1469
1470	/* Initialize a statement builder for each block. Puts in NULL_TREEs. */
1471	gfc_init_se (&if_se, NULL__null);
1472	gfc_start_block (&if_se.pre);
1473
1474	/* Calculate the IF condition expression. */
1475	if (code->expr1->where.lb)
1476	{
1477	gfc_save_backend_locus (&saved_loc);
1478	gfc_set_backend_locus (&code->expr1->where);
1479	}
1480
1481	gfc_conv_expr_val (&if_se, code->expr1);
1482
1483	if (code->expr1->where.lb)
1484	gfc_restore_backend_locus (&saved_loc);
1485
1486	/* Translate the THEN clause. */
1487	stmt = gfc_trans_code (code->next);
1488
1489	/* Translate the ELSE clause. */
1490	if (code->block)
1491	elsestmt = gfc_trans_if_1 (code->block);
1492	else
1493	elsestmt = build_empty_stmt (input_location);
1494
1495	/* Build the condition expression and add it to the condition block. */
1496	loc = code->expr1->where.lb ? gfc_get_location (&code->expr1->where)
1497	: input_location;
1498	stmt = fold_build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], if_se.expr, stmt,
1499	elsestmt);
1500
1501	gfc_add_expr_to_block (&if_se.pre, stmt);
1502
1503	/* Finish off this statement. */
1504	return gfc_finish_block (&if_se.pre);
1505	}
1506
1507	tree
1508	gfc_trans_if (gfc_code * code)
1509	{
1510	stmtblock_t body;
1511	tree exit_label;
1512
1513	/* Create exit label so it is available for trans'ing the body code. */
1514	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
1515	code->exit_label = exit_label;
1516
1517	/* Translate the actual code in code->block. */
1518	gfc_init_block (&body);
1519	gfc_add_expr_to_block (&body, gfc_trans_if_1 (code->block));
1520
1521	/* Add exit label. */
1522	gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label));
1523
1524	return gfc_finish_block (&body);
1525	}
1526
1527
1528	/* Translate an arithmetic IF expression.
1529
1530	IF (cond) label1, label2, label3 translates to
1531
1532	if (cond <= 0)
1533	{
1534	if (cond < 0)
1535	goto label1;
1536	else // cond == 0
1537	goto label2;
1538	}
1539	else // cond > 0
1540	goto label3;
1541
1542	An optimized version can be generated in case of equal labels.
1543	E.g., if label1 is equal to label2, we can translate it to
1544
1545	if (cond <= 0)
1546	goto label1;
1547	else
1548	goto label3;
1549	*/
1550
1551	tree
1552	gfc_trans_arithmetic_if (gfc_code * code)
1553	{
1554	gfc_se se;
1555	tree tmp;
1556	tree branch1;
1557	tree branch2;
1558	tree zero;
1559
1560	/* Start a new block. */
1561	gfc_init_se (&se, NULL__null);
1562	gfc_start_block (&se.pre);
1563
1564	/* Pre-evaluate COND. */
1565	gfc_conv_expr_val (&se, code->expr1);
1566	se.expr = gfc_evaluate_now (se.expr, &se.pre);
1567
1568	/* Build something to compare with. */
1569	zero = gfc_build_const (TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1569, __FUNCTION__))->typed.type), integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
1570
1571	if (code->label1->value != code->label2->value)
1572	{
1573	/* If (cond < 0) take branch1 else take branch2.
1574	First build jumps to the COND .LT. 0 and the COND .EQ. 0 cases. */
1575	branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1))fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], gfc_get_label_decl (code->label1));
1576	branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2))fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], gfc_get_label_decl (code->label2));
1577
1578	if (code->label1->value != code->label3->value)
1579	tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
1580	se.expr, zero);
1581	else
1582	tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
1583	se.expr, zero);
1584
1585	branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1586	tmp, branch1, branch2);
1587	}
1588	else
1589	branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1))fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], gfc_get_label_decl (code->label1));
1590
1591	if (code->label1->value != code->label3->value
1592	&& code->label2->value != code->label3->value)
1593	{
1594	/* if (cond <= 0) take branch1 else take branch2. */
1595	branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label3))fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], gfc_get_label_decl (code->label3));
1596	tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
1597	se.expr, zero);
1598	branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1599	tmp, branch1, branch2);
1600	}
1601
1602	/* Append the COND_EXPR to the evaluation of COND, and return. */
1603	gfc_add_expr_to_block (&se.pre, branch1);
1604	return gfc_finish_block (&se.pre);
1605	}
1606
1607
1608	/* Translate a CRITICAL block. */
1609	tree
1610	gfc_trans_critical (gfc_code *code)
1611	{
1612	stmtblock_t block;
1613	tree tmp, token = NULL_TREE(tree) __null;
1614
1615	gfc_start_block (&block);
1616
1617	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1618	{
1619	tree zero_size = build_zero_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1620	token = gfc_get_symbol_decl (code->resolved_sym);
1621	token = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (token))(((tree_class_check ((((contains_struct_check ((token), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1621, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1621, __FUNCTION__))->type_with_lang_specific.lang_specific )->caf_token);
1622	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
1623	token, zero_size, integer_one_nodeglobal_trees[TI_INTEGER_ONE],
1624	null_pointer_nodeglobal_trees[TI_NULL_POINTER], null_pointer_nodeglobal_trees[TI_NULL_POINTER],
1625	null_pointer_nodeglobal_trees[TI_NULL_POINTER], zero_size);
1626	gfc_add_expr_to_block (&block, tmp);
1627
1628	/* It guarantees memory consistency within the same segment */
1629	tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
1630	tmp = build5_loc (input_location, ASM_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1631	gfc_build_string_const (1, ""),
1632	NULL_TREE(tree) __null, NULL_TREE(tree) __null,
1633	tree_cons (NULL_TREE(tree) __null, tmp, NULL_TREE(tree) __null),
1634	NULL_TREE(tree) __null);
1635	ASM_VOLATILE_P (tmp)((tree_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1635, __FUNCTION__, (ASM_EXPR)))->base.public_flag) = 1;
1636
1637	gfc_add_expr_to_block (&block, tmp);
1638	}
1639
1640	tmp = gfc_trans_code (code->block->next);
1641	gfc_add_expr_to_block (&block, tmp);
1642
1643	if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1644	{
1645	tree zero_size = build_zero_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1646	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_unlock, 6,
1647	token, zero_size, integer_one_nodeglobal_trees[TI_INTEGER_ONE],
1648	null_pointer_nodeglobal_trees[TI_NULL_POINTER], null_pointer_nodeglobal_trees[TI_NULL_POINTER],
1649	zero_size);
1650	gfc_add_expr_to_block (&block, tmp);
1651
1652	/* It guarantees memory consistency within the same segment */
1653	tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
1654	tmp = build5_loc (input_location, ASM_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
1655	gfc_build_string_const (1, ""),
1656	NULL_TREE(tree) __null, NULL_TREE(tree) __null,
1657	tree_cons (NULL_TREE(tree) __null, tmp, NULL_TREE(tree) __null),
1658	NULL_TREE(tree) __null);
1659	ASM_VOLATILE_P (tmp)((tree_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1659, __FUNCTION__, (ASM_EXPR)))->base.public_flag) = 1;
1660
1661	gfc_add_expr_to_block (&block, tmp);
1662	}
1663
1664	return gfc_finish_block (&block);
1665	}
1666
1667
1668	/* Return true, when the class has a _len component. */
1669
1670	static bool
1671	class_has_len_component (gfc_symbol *sym)
1672	{
1673	gfc_component *comp = sym->ts.u.derived->components;
1674	while (comp)
1675	{
1676	if (strcmp (comp->name, "_len") == 0)
1677	return true;
1678	comp = comp->next;
1679	}
1680	return false;
1681	}
1682
1683
1684	static void
1685	copy_descriptor (stmtblock_t *block, tree dst, tree src, int rank)
1686	{
1687	int n;
1688	tree dim;
1689	tree tmp;
1690	tree tmp2;
1691	tree size;
1692	tree offset;
1693
1694	offset = gfc_index_zero_nodegfc_rank_cst[0];
1695
1696	/* Use memcpy to copy the descriptor. The size is the minimum of
1697	the sizes of 'src' and 'dst'. This avoids a non-trivial conversion. */
1698	tmp = TYPE_SIZE_UNIT (TREE_TYPE (src))((tree_class_check ((((contains_struct_check ((src), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1698, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1698, __FUNCTION__))->type_common.size_unit);
1699	tmp2 = TYPE_SIZE_UNIT (TREE_TYPE (dst))((tree_class_check ((((contains_struct_check ((dst), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1699, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1699, __FUNCTION__))->type_common.size_unit);
1700	size = fold_build2_loc (input_location, MIN_EXPR,
1701	TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1701, __FUNCTION__))->typed.type), tmp, tmp2);
1702	tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
1703	tmp = build_call_expr_loc (input_location, tmp, 3,
1704	gfc_build_addr_expr (NULL_TREE(tree) __null, dst),
1705	gfc_build_addr_expr (NULL_TREE(tree) __null, src),
1706	fold_convert (size_type_node, size)fold_convert_loc (((location_t) 0), global_trees[TI_SIZE_TYPE ], size));
1707	gfc_add_expr_to_block (block, tmp);
1708
1709	/* Set the offset correctly. */
1710	for (n = 0; n < rank; n++)
1711	{
1712	dim = gfc_rank_cst[n];
1713	tmp = gfc_conv_descriptor_lbound_get (src, dim);
1714	tmp2 = gfc_conv_descriptor_stride_get (src, dim);
1715	tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1715, __FUNCTION__))->typed.type),
1716	tmp, tmp2);
1717	offset = fold_build2_loc (input_location, MINUS_EXPR,
1718	TREE_TYPE (offset)((contains_struct_check ((offset), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1718, __FUNCTION__))->typed.type), offset, tmp);
1719	offset = gfc_evaluate_now (offset, block);
1720	}
1721
1722	gfc_conv_descriptor_offset_set (block, dst, offset);
1723	}
1724
1725
1726	/* Do proper initialization for ASSOCIATE names. */
1727
1728	static void
1729	trans_associate_var (gfc_symbol sym, gfc_wrapped_block block)
1730	{
1731	gfc_expr *e;
1732	tree tmp;
1733	bool class_target;
1734	bool unlimited;
1735	tree desc;
1736	tree offset;
1737	tree dim;
1738	int n;
1739	tree charlen;
1740	bool need_len_assign;
1741	bool whole_array = true;
1742	gfc_ref *ref;
1743	gfc_symbol *sym2;
1744
1745	gcc_assert (sym->assoc)((void)(!(sym->assoc) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1745, __FUNCTION__), 0 : 0));
1746	e = sym->assoc->target;
1747
1748	class_target = (e->expr_type == EXPR_VARIABLE)
1749	&& (gfc_is_class_scalar_expr (e)
1750	\|\| gfc_is_class_array_ref (e, NULL__null));
1751
1752	unlimited = UNLIMITED_POLY (e)(e != __null && e->ts.type == BT_CLASS && e ->ts.u.derived->components && e->ts.u.derived ->components->ts.u.derived && e->ts.u.derived ->components->ts.u.derived->attr.unlimited_polymorphic );
1753
1754	for (ref = e->ref; ref; ref = ref->next)
1755	if (ref->type == REF_ARRAY
1756	&& ref->u.ar.type == AR_FULL
1757	&& ref->next)
1758	{
1759	whole_array = false;
1760	break;
1761	}
1762
1763	/* Assignments to the string length need to be generated, when
1764	( sym is a char array or
1765	sym has a _len component)
1766	and the associated expression is unlimited polymorphic, which is
1767	not (yet) correctly in 'unlimited', because for an already associated
1768	BT_DERIVED the u-poly flag is not set, i.e.,
1769	__tmp_CHARACTER_0_1 => w => arg
1770	^ generated temp ^ from code, the w does not have the u-poly
1771	flag set, where UNLIMITED_POLY(e) expects it. */
1772	need_len_assign = ((unlimited \|\| (e->ts.type == BT_DERIVED
1773	&& e->ts.u.derived->attr.unlimited_polymorphic))
1774	&& (sym->ts.type == BT_CHARACTER
1775	\|\| ((sym->ts.type == BT_CLASS \|\| sym->ts.type == BT_DERIVED)
1776	&& class_has_len_component (sym)))
1777	&& !sym->attr.select_rank_temporary);
1778
1779	/* Do a `pointer assignment' with updated descriptor (or assign descriptor
1780	to array temporary) for arrays with either unknown shape or if associating
1781	to a variable. Select rank temporaries need somewhat different treatment
1782	to other associate names and case temporaries. This because the selector
1783	is assumed rank and so the offset in particular has to be changed. Also,
1784	the case temporaries carry both allocatable and target attributes if
1785	present in the selector. This means that an allocatation or change of
1786	association can occur and so has to be dealt with. */
1787	if (sym->attr.select_rank_temporary)
1788	{
1789	gfc_se se;
1790	tree class_decl = NULL_TREE(tree) __null;
1791	int rank = 0;
1792	bool class_ptr;
1793
1794	sym2 = e->symtree->n.sym;
1795	gfc_init_se (&se, NULL__null);
1796	if (e->ts.type == BT_CLASS)
1797	{
1798	/* Go straight to the class data. */
1799	if (sym2->attr.dummy && !sym2->attr.optional)
1800	{
1801	class_decl = sym2->backend_decl;
1802	if (DECL_LANG_SPECIFIC (class_decl)((contains_struct_check ((class_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1802, __FUNCTION__))->decl_common.lang_specific)
1803	&& GFC_DECL_SAVED_DESCRIPTOR (class_decl)(((contains_struct_check ((class_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1803, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor ))
1804	class_decl = GFC_DECL_SAVED_DESCRIPTOR (class_decl)(((contains_struct_check ((class_decl), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1804, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
1805	if (POINTER_TYPE_P (TREE_TYPE (class_decl))(((enum tree_code) (((contains_struct_check ((class_decl), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1805, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((class_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1805, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
1806	class_decl = build_fold_indirect_ref_loc (input_location,
1807	class_decl);
1808	gcc_assert (GFC_CLASS_TYPE_P (TREE_TYPE (class_decl)))((void)(!(((tree_class_check ((((contains_struct_check ((class_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1808, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1808, __FUNCTION__))->type_common.lang_flag_4)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1808, __FUNCTION__), 0 : 0));
1809	se.expr = gfc_class_data_get (class_decl);
1810	}
1811	else
1812	{
1813	class_decl = sym2->backend_decl;
1814	gfc_conv_expr_descriptor (&se, e);
1815	if (POINTER_TYPE_P (TREE_TYPE (se.expr))(((enum tree_code) (((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1815, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1815, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
1816	se.expr = build_fold_indirect_ref_loc (input_location,
1817	se.expr);
1818	}
1819
1820	if (CLASS_DATA (sym)sym->ts.u.derived->components->as && CLASS_DATA (sym)sym->ts.u.derived->components->as->rank > 0)
1821	rank = CLASS_DATA (sym)sym->ts.u.derived->components->as->rank;
1822	}
1823	else
1824	{
1825	gfc_conv_expr_descriptor (&se, e);
1826	if (sym->as && sym->as->rank > 0)
1827	rank = sym->as->rank;
1828	}
1829
1830	desc = sym->backend_decl;
1831
1832	/* The SELECT TYPE mechanisms turn class temporaries into pointers, which
1833	point to the selector. */
1834	class_ptr = class_decl != NULL_TREE(tree) __null && POINTER_TYPE_P (TREE_TYPE (desc))(((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1834, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1834, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE );
1835	if (class_ptr)
1836	{
1837	tmp = gfc_create_var (TREE_TYPE (TREE_TYPE (desc))((contains_struct_check ((((contains_struct_check ((desc), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1837, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1837, __FUNCTION__))->typed.type), "class");
1838	tmp = gfc_build_addr_expr (NULL__null, tmp);
1839	gfc_add_modify (&se.pre, desc, tmp);
1840
1841	tmp = gfc_class_vptr_get (class_decl);
1842	gfc_add_modify (&se.pre, gfc_class_vptr_get (desc), tmp);
1843	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 ))
1844	gfc_add_modify (&se.pre, gfc_class_len_get (desc),
1845	gfc_class_len_get (class_decl));
1846
1847	desc = gfc_class_data_get (desc);
1848	}
1849
1850	/* SELECT RANK temporaries can carry the allocatable and pointer
1851	attributes so the selector descriptor must be copied in and
1852	copied out. */
1853	if (rank > 0)
1854	copy_descriptor (&se.pre, desc, se.expr, rank);
1855	else
1856	{
1857	tmp = gfc_conv_descriptor_data_get (se.expr);
1858	gfc_add_modify (&se.pre, desc,
1859	fold_convert (TREE_TYPE (desc), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1859, __FUNCTION__))->typed.type), tmp));
1860	}
1861
1862	/* Deal with associate_name => selector. Class associate names are
1863	treated in the same way as in SELECT TYPE. */
1864	sym2 = sym->assoc->target->symtree->n.sym;
1865	if (sym2->assoc && sym->assoc->target && sym2->ts.type != BT_CLASS)
1866	{
1867	sym2 = sym2->assoc->target->symtree->n.sym;
1868	se.expr = sym2->backend_decl;
1869
1870	if (POINTER_TYPE_P (TREE_TYPE (se.expr))(((enum tree_code) (((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1870, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1870, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
1871	se.expr = build_fold_indirect_ref_loc (input_location,
1872	se.expr);
1873	}
1874
1875	/* There could have been reallocation. Copy descriptor back to the
1876	selector and update the offset. */
1877	if (sym->attr.allocatable \|\| sym->attr.pointer
1878	\|\| (sym->ts.type == BT_CLASS
1879	&& (CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable
1880	\|\| CLASS_DATA (sym)sym->ts.u.derived->components->attr.pointer)))
1881	{
1882	if (rank > 0)
1883	copy_descriptor (&se.post, se.expr, desc, rank);
1884	else
1885	gfc_conv_descriptor_data_set (&se.post, se.expr, desc);
1886
1887	/* The dynamic type could have changed too. */
1888	if (sym->ts.type == BT_CLASS)
1889	{
1890	tmp = sym->backend_decl;
1891	if (class_ptr)
1892	tmp = build_fold_indirect_ref_loc (input_location, tmp);
1893	gfc_add_modify (&se.post, gfc_class_vptr_get (class_decl),
1894	gfc_class_vptr_get (tmp));
1895	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 ))
1896	gfc_add_modify (&se.post, gfc_class_len_get (class_decl),
1897	gfc_class_len_get (tmp));
1898	}
1899	}
1900
1901	tmp = gfc_finish_block (&se.post);
1902
1903	gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), tmp);
1904	}
1905	/* Now all the other kinds of associate variable. */
1906	else if (sym->attr.dimension && !class_target
1907	&& (sym->as->type == AS_DEFERRED \|\| sym->assoc->variable))
1908	{
1909	gfc_se se;
1910	tree desc;
1911	bool cst_array_ctor;
1912
1913	desc = sym->backend_decl;
1914	cst_array_ctor = e->expr_type == EXPR_ARRAY
1915	&& gfc_constant_array_constructor_p (e->value.constructor)
1916	&& e->ts.type != BT_CHARACTER;
1917
1918	/* If association is to an expression, evaluate it and create temporary.
1919	Otherwise, get descriptor of target for pointer assignment. */
1920	gfc_init_se (&se, NULL__null);
1921
1922	if (sym->assoc->variable \|\| cst_array_ctor)
1923	{
1924	se.direct_byref = 1;
1925	se.use_offset = 1;
1926	se.expr = desc;
1927	GFC_DECL_PTR_ARRAY_P (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1927, __FUNCTION__))->decl_common.lang_flag_6) = 1;
1928	}
1929
1930	gfc_conv_expr_descriptor (&se, e);
1931
1932	if (sym->ts.type == BT_CHARACTER
1933	&& sym->ts.deferred
1934	&& !sym->attr.select_type_temporary
1935	&& VAR_P (sym->ts.u.cl->backend_decl)(((enum tree_code) (sym->ts.u.cl->backend_decl)->base .code) == VAR_DECL)
1936	&& se.string_length != sym->ts.u.cl->backend_decl)
1937	{
1938	gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
1939	fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (sym->ts.u.cl->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1939, __FUNCTION__))->typed.type), se.string_length)
1940	se.string_length)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (sym->ts.u.cl->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1939, __FUNCTION__))->typed.type), se.string_length));
1941	}
1942
1943	/* If we didn't already do the pointer assignment, set associate-name
1944	descriptor to the one generated for the temporary. */
1945	if ((!sym->assoc->variable && !cst_array_ctor)
1946	\|\| !whole_array)
1947	{
1948	int dim;
1949
1950	if (whole_array)
1951	gfc_add_modify (&se.pre, desc, se.expr);
1952
1953	/* The generated descriptor has lower bound zero (as array
1954	temporary), shift bounds so we get lower bounds of 1. */
1955	for (dim = 0; dim < e->rank; ++dim)
1956	gfc_conv_shift_descriptor_lbound (&se.pre, desc,
1957	dim, gfc_index_one_nodegfc_rank_cst[1]);
1958	}
1959
1960	/* If this is a subreference array pointer associate name use the
1961	associate variable element size for the value of 'span'. */
1962	if (sym->attr.subref_array_pointer && !se.direct_byref)
1963	{
1964	gcc_assert (e->expr_type == EXPR_VARIABLE)((void)(!(e->expr_type == EXPR_VARIABLE) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 1964, __FUNCTION__), 0 : 0));
1965	tmp = gfc_get_array_span (se.expr, e);
1966
1967	gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
1968	}
1969
1970	if (e->expr_type == EXPR_FUNCTION
1971	&& sym->ts.type == BT_DERIVED
1972	&& sym->ts.u.derived
1973	&& sym->ts.u.derived->attr.pdt_type)
1974	{
1975	tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, se.expr,
1976	sym->as->rank);
1977	gfc_add_expr_to_block (&se.post, tmp);
1978	}
1979
1980	/* Done, register stuff as init / cleanup code. */
1981	gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
1982	gfc_finish_block (&se.post));
1983	}
1984
1985	/* Temporaries, arising from TYPE IS, just need the descriptor of class
1986	arrays to be assigned directly. */
1987	else if (class_target && sym->attr.dimension
1988	&& (sym->ts.type == BT_DERIVED \|\| unlimited))
1989	{
1990	gfc_se se;
1991
1992	gfc_init_se (&se, NULL__null);
1993	se.descriptor_only = 1;
1994	/* In a select type the (temporary) associate variable shall point to
1995	a standard fortran array (lower bound == 1), but conv_expr ()
1996	just maps to the input array in the class object, whose lbound may
1997	be arbitrary. conv_expr_descriptor solves this by inserting a
1998	temporary array descriptor. */
1999	gfc_conv_expr_descriptor (&se, e);
2000
2001	gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))((void)(!(((tree_class_check ((((contains_struct_check ((se.expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2001, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2001, __FUNCTION__))->type_common.lang_flag_1) \|\| ((tree_class_check ((((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2002, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2002, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2002, __FUNCTION__), 0 : 0))
2002	\|\| GFC_ARRAY_TYPE_P (TREE_TYPE (se.expr)))((void)(!(((tree_class_check ((((contains_struct_check ((se.expr ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2001, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2001, __FUNCTION__))->type_common.lang_flag_1) \|\| ((tree_class_check ((((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2002, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2002, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2002, __FUNCTION__), 0 : 0));
2003	gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)))((void)(!(((tree_class_check ((((contains_struct_check ((sym-> backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2003, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2003, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2003, __FUNCTION__), 0 : 0));
2004
2005	if (GFC_ARRAY_TYPE_P (TREE_TYPE (se.expr))((tree_class_check ((((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2005, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2005, __FUNCTION__))->type_common.lang_flag_2))
2006	{
2007	if (INDIRECT_REF_P (se.expr)(((enum tree_code) (se.expr)->base.code) == INDIRECT_REF))
2008	tmp = TREE_OPERAND (se.expr, 0)(((const_cast<tree> (tree_operand_check ((se.expr), ( 0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2008, __FUNCTION__)))));
2009	else
2010	tmp = se.expr;
2011
2012	gfc_add_modify (&se.pre, sym->backend_decl,
2013	gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (tmp)(((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2013, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor )));
2014	}
2015	else
2016	gfc_add_modify (&se.pre, sym->backend_decl, se.expr);
2017
2018	if (unlimited)
2019	{
2020	/* Recover the dtype, which has been overwritten by the
2021	assignment from an unlimited polymorphic object. */
2022	tmp = gfc_conv_descriptor_dtype (sym->backend_decl);
2023	gfc_add_modify (&se.pre, tmp,
2024	gfc_get_dtype (TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2024, __FUNCTION__))->typed.type)));
2025	}
2026
2027	gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
2028	gfc_finish_block (&se.post));
2029	}
2030
2031	/* Do a scalar pointer assignment; this is for scalar variable targets. */
2032	else if (gfc_is_associate_pointer (sym))
2033	{
2034	gfc_se se;
2035
2036	gcc_assert (!sym->attr.dimension)((void)(!(!sym->attr.dimension) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2036, __FUNCTION__), 0 : 0));
2037
2038	gfc_init_se (&se, NULL__null);
2039
2040	/* Class associate-names come this way because they are
2041	unconditionally associate pointers and the symbol is scalar. */
2042	if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension)
2043	{
2044	tree target_expr;
2045	/* For a class array we need a descriptor for the selector. */
2046	gfc_conv_expr_descriptor (&se, e);
2047	/* Needed to get/set the _len component below. */
2048	target_expr = se.expr;
2049
2050	/* Obtain a temporary class container for the result. */
2051	gfc_conv_class_to_class (&se, e, sym->ts, false, true, false, false);
2052	se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
2053
2054	/* Set the offset. */
2055	desc = gfc_class_data_get (se.expr);
2056	offset = gfc_index_zero_nodegfc_rank_cst[0];
2057	for (n = 0; n < e->rank; n++)
2058	{
2059	dim = gfc_rank_cst[n];
2060	tmp = fold_build2_loc (input_location, MULT_EXPR,
2061	gfc_array_index_type,
2062	gfc_conv_descriptor_stride_get (desc, dim),
2063	gfc_conv_descriptor_lbound_get (desc, dim));
2064	offset = fold_build2_loc (input_location, MINUS_EXPR,
2065	gfc_array_index_type,
2066	offset, tmp);
2067	}
2068	if (need_len_assign)
2069	{
2070	if (e->symtree
2071	&& DECL_LANG_SPECIFIC (e->symtree->n.sym->backend_decl)((contains_struct_check ((e->symtree->n.sym->backend_decl ), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2071, __FUNCTION__))->decl_common.lang_specific)
2072	&& GFC_DECL_SAVED_DESCRIPTOR (e->symtree->n.sym->backend_decl)(((contains_struct_check ((e->symtree->n.sym->backend_decl ), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2072, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor )
2073	&& TREE_CODE (target_expr)((enum tree_code) (target_expr)->base.code) != COMPONENT_REF)
2074	/* Use the original class descriptor stored in the saved
2075	descriptor to get the target_expr. */
2076	target_expr =
2077	GFC_DECL_SAVED_DESCRIPTOR (e->symtree->n.sym->backend_decl)(((contains_struct_check ((e->symtree->n.sym->backend_decl ), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2077, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor );
2078	else
2079	/* Strip the _data component from the target_expr. */
2080	target_expr = TREE_OPERAND (target_expr, 0)(((const_cast<tree> (tree_operand_check ((target_expr ), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2080, __FUNCTION__)))));
2081	/* Add a reference to the _len comp to the target expr. */
2082	tmp = gfc_class_len_get (target_expr);
2083	/* Get the component-ref for the temp structure's _len comp. */
2084	charlen = gfc_class_len_get (se.expr);
2085	/* Add the assign to the beginning of the block... */
2086	gfc_add_modify (&se.pre, charlen,
2087	fold_convert (TREE_TYPE (charlen), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (charlen), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2087, __FUNCTION__))->typed.type), tmp));
2088	/* and the oposite way at the end of the block, to hand changes
2089	on the string length back. */
2090	gfc_add_modify (&se.post, tmp,
2091	fold_convert (TREE_TYPE (tmp), charlen)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2091, __FUNCTION__))->typed.type), charlen));
2092	/* Length assignment done, prevent adding it again below. */
2093	need_len_assign = false;
2094	}
2095	gfc_conv_descriptor_offset_set (&se.pre, desc, offset);
2096	}
2097	else if (sym->ts.type == BT_CLASS && e->ts.type == BT_CLASS
2098	&& CLASS_DATA (e)e->ts.u.derived->components->attr.dimension)
2099	{
2100	/* This is bound to be a class array element. */
2101	gfc_conv_expr_reference (&se, e);
2102	/* Get the _vptr component of the class object. */
2103	tmp = gfc_get_vptr_from_expr (se.expr);
2104	/* Obtain a temporary class container for the result. */
2105	gfc_conv_derived_to_class (&se, e, sym->ts, tmp, false, false);
2106	se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
2107	need_len_assign = false;
2108	}
2109	else
2110	{
2111	/* For BT_CLASS and BT_DERIVED, this boils down to a pointer assign,
2112	which has the string length included. For CHARACTERS it is still
2113	needed and will be done at the end of this routine. */
2114	gfc_conv_expr (&se, e);
2115	need_len_assign = need_len_assign && sym->ts.type == BT_CHARACTER;
2116	}
2117
2118	if (sym->ts.type == BT_CHARACTER
2119	&& !sym->attr.select_type_temporary
2120	&& VAR_P (sym->ts.u.cl->backend_decl)(((enum tree_code) (sym->ts.u.cl->backend_decl)->base .code) == VAR_DECL)
2121	&& se.string_length != sym->ts.u.cl->backend_decl)
2122	{
2123	gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
2124	fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (sym->ts.u.cl->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2124, __FUNCTION__))->typed.type), se.string_length)
2125	se.string_length)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (sym->ts.u.cl->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2124, __FUNCTION__))->typed.type), se.string_length));
2126	if (e->expr_type == EXPR_FUNCTION)
2127	{
2128	tmp = gfc_call_free (sym->backend_decl);
2129	gfc_add_expr_to_block (&se.post, tmp);
2130	}
2131	}
2132
2133	if (sym->ts.type == BT_CHARACTER && e->ts.type == BT_CHARACTER
2134	&& POINTER_TYPE_P (TREE_TYPE (se.expr))(((enum tree_code) (((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2134, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE \|\| ((enum tree_code) (((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2134, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE ))
2135	{
2136	/* These are pointer types already. */
2137	tmp = fold_convert (TREE_TYPE (sym->backend_decl), se.expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (sym->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2137, __FUNCTION__))->typed.type), se.expr);
2138	}
2139	else
2140	{
2141	tree ctree = gfc_get_class_from_expr (se.expr);
2142	tmp = TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2142, __FUNCTION__))->typed.type);
2143
2144	/* Coarray scalar component expressions can emerge from
2145	the front end as array elements of the _data field. */
2146	if (sym->ts.type == BT_CLASS
2147	&& e->ts.type == BT_CLASS && e->rank == 0
2148	&& !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr))((tree_class_check ((((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2148, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2148, __FUNCTION__))->type_common.lang_flag_4) && ctree)
2149	{
2150	tree stmp;
2151	tree dtmp;
2152
2153	se.expr = ctree;
2154	dtmp = TREE_TYPE (TREE_TYPE (sym->backend_decl))((contains_struct_check ((((contains_struct_check ((sym->backend_decl ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2154, __FUNCTION__))->typed.type)), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2154, __FUNCTION__))->typed.type);
2155	ctree = gfc_create_var (dtmp, "class");
2156
2157	stmp = gfc_class_data_get (se.expr);
2158	gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)))((void)(!(((tree_class_check ((((contains_struct_check ((stmp ), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2158, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2158, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2158, __FUNCTION__), 0 : 0));
2159
2160	/* Set the fields of the target class variable. */
2161	stmp = gfc_conv_descriptor_data_get (stmp);
2162	dtmp = gfc_class_data_get (ctree);
2163	stmp = fold_convert (TREE_TYPE (dtmp), stmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (dtmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2163, __FUNCTION__))->typed.type), stmp);
2164	gfc_add_modify (&se.pre, dtmp, stmp);
2165	stmp = gfc_class_vptr_get (se.expr);
2166	dtmp = gfc_class_vptr_get (ctree);
2167	stmp = fold_convert (TREE_TYPE (dtmp), stmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (dtmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2167, __FUNCTION__))->typed.type), stmp);
2168	gfc_add_modify (&se.pre, dtmp, stmp);
2169	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 ))
2170	{
2171	stmp = gfc_class_len_get (se.expr);
2172	dtmp = gfc_class_len_get (ctree);
2173	stmp = fold_convert (TREE_TYPE (dtmp), stmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (dtmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2173, __FUNCTION__))->typed.type), stmp);
2174	gfc_add_modify (&se.pre, dtmp, stmp);
2175	}
2176	se.expr = ctree;
2177	}
2178	tmp = gfc_build_addr_expr (tmp, se.expr);
2179	}
2180
2181	gfc_add_modify (&se.pre, sym->backend_decl, tmp);
2182
2183	gfc_add_init_cleanup (block, gfc_finish_block( &se.pre),
2184	gfc_finish_block (&se.post));
2185	}
2186
2187	/* Do a simple assignment. This is for scalar expressions, where we
2188	can simply use expression assignment. */
2189	else
2190	{
2191	gfc_expr *lhs;
2192	tree res;
2193	gfc_se se;
2194	stmtblock_t final_block;
2195
2196	gfc_init_se (&se, NULL__null);
2197
2198	/* resolve.cc converts some associate names to allocatable so that
2199	allocation can take place automatically in gfc_trans_assignment.
2200	The frontend prevents them from being either allocated,
2201	deallocated or reallocated. */
2202	if (sym->ts.type == BT_DERIVED
2203	&& sym->ts.u.derived->attr.alloc_comp)
2204	{
2205	tmp = sym->backend_decl;
2206	tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, tmp,
2207	sym->attr.dimension ? sym->as->rank : 0);
2208	gfc_add_expr_to_block (&se.pre, tmp);
2209	}
2210
2211	if (sym->attr.allocatable)
2212	{
2213	tmp = sym->backend_decl;
2214	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))((tree_class_check ((((contains_struct_check ((tmp), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2214, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2214, __FUNCTION__))->type_common.lang_flag_1))
2215	tmp = gfc_conv_descriptor_data_get (tmp);
2216	gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2216, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ])
2217	null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2216, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER ]));
2218	}
2219
2220	lhs = gfc_lval_expr_from_sym (sym);
2221	lhs->must_finalize = 0;
2222	res = gfc_trans_assignment (lhs, e, false, true);
2223	gfc_add_expr_to_block (&se.pre, res);
2224
2225	gfc_init_block (&final_block);
2226
2227	if (sym->attr.associate_var
2228	&& sym->ts.type == BT_DERIVED
2229	&& sym->ts.u.derived->attr.defined_assign_comp
2230	&& gfc_may_be_finalized (sym->ts)
2231	&& e->expr_type == EXPR_FUNCTION)
2232	{
2233	gfc_expr *ef;
2234	ef = gfc_lval_expr_from_sym (sym);
2235	gfc_add_finalizer_call (&final_block, ef);
2236	gfc_free_expr (ef);
2237	}
2238
2239	if (sym->ts.type == BT_DERIVED
2240	&& sym->ts.u.derived->attr.alloc_comp)
2241	{
2242	tmp = sym->backend_decl;
2243	tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived,
2244	tmp, 0);
2245	gfc_add_expr_to_block (&final_block, tmp);
2246	}
2247
2248	tmp = sym->backend_decl;
2249	if (e->expr_type == EXPR_FUNCTION
2250	&& sym->ts.type == BT_DERIVED
2251	&& sym->ts.u.derived
2252	&& sym->ts.u.derived->attr.pdt_type)
2253	{
2254	tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, tmp,
2255	0);
2256	}
2257	else if (e->expr_type == EXPR_FUNCTION
2258	&& sym->ts.type == BT_CLASS
2259	&& CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived
2260	&& CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived->attr.pdt_type)
2261	{
2262	tmp = gfc_class_data_get (tmp);
2263	tmp = gfc_deallocate_pdt_comp (CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived,
2264	tmp, 0);
2265	}
2266	else if (sym->attr.allocatable)
2267	{
2268	tmp = sym->backend_decl;
2269
2270	if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))((tree_class_check ((((contains_struct_check ((tmp), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2270, __FUNCTION__))->typed.type)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2270, __FUNCTION__))->type_common.lang_flag_1))
2271	tmp = gfc_conv_descriptor_data_get (tmp);
2272
2273	/* A simple call to free suffices here. */
2274	tmp = gfc_call_free (tmp);
2275
2276	/* Make sure that reallocation on assignment cannot occur. */
2277	sym->attr.allocatable = 0;
2278	}
2279	else
2280	tmp = NULL_TREE(tree) __null;
2281
2282	gfc_add_expr_to_block (&final_block, tmp);
2283	tmp = gfc_finish_block (&final_block);
2284	res = gfc_finish_block (&se.pre);
2285	gfc_add_init_cleanup (block, res, tmp);
2286	gfc_free_expr (lhs);
2287	}
2288
2289	/* Set the stringlength, when needed. */
2290	if (need_len_assign)
2291	{
2292	gfc_se se;
2293	gfc_init_se (&se, NULL__null);
2294	if (e->symtree->n.sym->ts.type == BT_CHARACTER)
2295	{
2296	/* Deferred strings are dealt with in the preceeding. */
2297	gcc_assert (!e->symtree->n.sym->ts.deferred)((void)(!(!e->symtree->n.sym->ts.deferred) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2297, __FUNCTION__), 0 : 0));
2298	tmp = e->symtree->n.sym->ts.u.cl->backend_decl;
2299	}
2300	else if (e->symtree->n.sym->attr.function
2301	&& e->symtree->n.sym == e->symtree->n.sym->result)
2302	{
2303	tmp = gfc_get_fake_result_decl (e->symtree->n.sym, 0);
2304	tmp = gfc_class_len_get (tmp);
2305	}
2306	else
2307	tmp = gfc_class_len_get (gfc_get_symbol_decl (e->symtree->n.sym));
2308	gfc_get_symbol_decl (sym);
2309	charlen = sym->ts.type == BT_CHARACTER ? sym->ts.u.cl->backend_decl
2310	: gfc_class_len_get (sym->backend_decl);
2311	/* Prevent adding a noop len= len. */
2312	if (tmp != charlen)
2313	{
2314	gfc_add_modify (&se.pre, charlen,
2315	fold_convert (TREE_TYPE (charlen), tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (charlen), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2315, __FUNCTION__))->typed.type), tmp));
2316	gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
2317	gfc_finish_block (&se.post));
2318	}
2319	}
2320	}
2321
2322
2323	/* Translate a BLOCK construct. This is basically what we would do for a
2324	procedure body. */
2325
2326	tree
2327	gfc_trans_block_construct (gfc_code* code)
2328	{
2329	gfc_namespace* ns;
2330	gfc_symbol* sym;
2331	gfc_wrapped_block block;
2332	tree exit_label;
2333	stmtblock_t body;
2334	gfc_association_list *ass;
2335
2336	ns = code->ext.block.ns;
2337	gcc_assert (ns)((void)(!(ns) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2337, __FUNCTION__), 0 : 0));
2338	sym = ns->proc_name;
2339	gcc_assert (sym)((void)(!(sym) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2339, __FUNCTION__), 0 : 0));
2340
2341	/* Process local variables. */
2342	gcc_assert (!sym->tlink)((void)(!(!sym->tlink) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2342, __FUNCTION__), 0 : 0));
2343	sym->tlink = sym;
2344	gfc_process_block_locals (ns);
2345
2346	/* Generate code including exit-label. */
2347	gfc_init_block (&body);
2348	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2349	code->exit_label = exit_label;
2350
2351	finish_oacc_declare (ns, sym, true);
2352
2353	gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
2354	gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label));
2355
2356	/* Finish everything. */
2357	gfc_start_wrapped_block (&block, gfc_finish_block (&body));
2358	gfc_trans_deferred_vars (sym, &block);
2359	for (ass = code->ext.block.assoc; ass; ass = ass->next)
2360	trans_associate_var (ass->st->n.sym, &block);
2361
2362	return gfc_finish_wrapped_block (&block);
2363	}
2364
2365	/* Translate the simple DO construct in a C-style manner.
2366	This is where the loop variable has integer type and step +-1.
2367	Following code will generate infinite loop in case where TO is INT_MAX
2368	(for +1 step) or INT_MIN (for -1 step)
2369
2370	We translate a do loop from:
2371
2372	DO dovar = from, to, step
2373	body
2374	END DO
2375
2376	to:
2377
2378	[Evaluate loop bounds and step]
2379	dovar = from;
2380	for (;;)
2381	{
2382	if (dovar > to)
2383	goto end_label;
2384	body;
2385	cycle_label:
2386	dovar += step;
2387	}
2388	end_label:
2389
2390	This helps the optimizers by avoiding the extra pre-header condition and
2391	we save a register as we just compare the updated IV (not a value in
2392	previous step). */
2393
2394	static tree
2395	gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
2396	tree from, tree to, tree step, tree exit_cond)
2397	{
2398	stmtblock_t body;
2399	tree type;
2400	tree cond;
2401	tree tmp;
2402	tree saved_dovar = NULL__null;
2403	tree cycle_label;
2404	tree exit_label;
2405	location_t loc;
2406	type = TREE_TYPE (dovar)((contains_struct_check ((dovar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2406, __FUNCTION__))->typed.type);
2407	bool is_step_positive = tree_int_cst_sgn (step) > 0;
2408
2409	loc = gfc_get_location (&code->ext.iterator->start->where);
2410
2411	/* Initialize the DO variable: dovar = from. */
2412	gfc_add_modify_loc (loc, pblock, dovar,
2413	fold_convert (TREE_TYPE (dovar), from)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (dovar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2413, __FUNCTION__))->typed.type), from));
2414
2415	/* Save value for do-tinkering checking. */
2416	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2417	{
2418	saved_dovar = gfc_create_var (type, ".saved_dovar");
2419	gfc_add_modify_loc (loc, pblock, saved_dovar, dovar);
2420	}
2421
2422	/* Cycle and exit statements are implemented with gotos. */
2423	cycle_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2424	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2425
2426	/* Put the labels where they can be found later. See gfc_trans_do(). */
2427	code->cycle_label = cycle_label;
2428	code->exit_label = exit_label;
2429
2430	/* Loop body. */
2431	gfc_start_block (&body);
2432
2433	/* Exit the loop if there is an I/O result condition or error. */
2434	if (exit_cond)
2435	{
2436	tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2437	tmp = fold_build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2438	exit_cond, tmp,
2439	build_empty_stmt (loc));
2440	gfc_add_expr_to_block (&body, tmp);
2441	}
2442
2443	/* Evaluate the loop condition. */
2444	if (is_step_positive)
2445	cond = fold_build2_loc (loc, GT_EXPR, logical_type_node, dovar,
2446	fold_convert (type, to)fold_convert_loc (((location_t) 0), type, to));
2447	else
2448	cond = fold_build2_loc (loc, LT_EXPR, logical_type_node, dovar,
2449	fold_convert (type, to)fold_convert_loc (((location_t) 0), type, to));
2450
2451	cond = gfc_evaluate_now_loc (loc, cond, &body);
2452	if (code->ext.iterator->unroll && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2453	cond
2454	= build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2454, __FUNCTION__))->typed.type), cond,
2455	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_unroll_kind),
2456	build_int_cst (integer_type_nodeinteger_types[itk_int], code->ext.iterator->unroll));
2457
2458	if (code->ext.iterator->ivdep && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2459	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2459, __FUNCTION__))->typed.type), cond,
2460	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_ivdep_kind),
2461	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
2462	if (code->ext.iterator->vector && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2463	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2463, __FUNCTION__))->typed.type), cond,
2464	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_vector_kind),
2465	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
2466	if (code->ext.iterator->novector && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2467	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2467, __FUNCTION__))->typed.type), cond,
2468	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_no_vector_kind),
2469	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
2470
2471	/* The loop exit. */
2472	tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], exit_label);
2473	TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
2474	tmp = fold_build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2475	cond, tmp, build_empty_stmt (loc));
2476	gfc_add_expr_to_block (&body, tmp);
2477
2478	/* Check whether the induction variable is equal to INT_MAX
2479	(respectively to INT_MIN). */
2480	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2481	{
2482	tree boundary = is_step_positive ? TYPE_MAX_VALUE (type)((tree_check5 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2482, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval )
2483	: TYPE_MIN_VALUE (type)((tree_check5 ((type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2483, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval );
2484
2485	tmp = fold_build2_loc (loc, EQ_EXPR, logical_type_node,
2486	dovar, boundary);
2487	gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
2488	"Loop iterates infinitely");
2489	}
2490
2491	/* Main loop body. */
2492	tmp = gfc_trans_code_cond (code->block->next, exit_cond);
2493	gfc_add_expr_to_block (&body, tmp);
2494
2495	/* Label for cycle statements (if needed). */
2496	if (TREE_USED (cycle_label)((cycle_label)->base.used_flag))
2497	{
2498	tmp = build1_v (LABEL_EXPR, cycle_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], cycle_label);
2499	gfc_add_expr_to_block (&body, tmp);
2500	}
2501
2502	/* Check whether someone has modified the loop variable. */
2503	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2504	{
2505	tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node,
2506	dovar, saved_dovar);
2507	gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
2508	"Loop variable has been modified");
2509	}
2510
2511	/* Increment the loop variable. */
2512	tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
2513	gfc_add_modify_loc (loc, &body, dovar, tmp);
2514
2515	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2516	gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
2517
2518	/* Finish the loop body. */
2519	tmp = gfc_finish_block (&body);
2520	tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], tmp);
2521
2522	gfc_add_expr_to_block (pblock, tmp);
2523
2524	/* Add the exit label. */
2525	tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2526	gfc_add_expr_to_block (pblock, tmp);
2527
2528	return gfc_finish_block (pblock);
2529	}
2530
2531	/* Translate the DO construct. This obviously is one of the most
2532	important ones to get right with any compiler, but especially
2533	so for Fortran.
2534
2535	We special case some loop forms as described in gfc_trans_simple_do.
2536	For other cases we implement them with a separate loop count,
2537	as described in the standard.
2538
2539	We translate a do loop from:
2540
2541	DO dovar = from, to, step
2542	body
2543	END DO
2544
2545	to:
2546
2547	[evaluate loop bounds and step]
2548	empty = (step > 0 ? to < from : to > from);
2549	countm1 = (to - from) / step;
2550	dovar = from;
2551	if (empty) goto exit_label;
2552	for (;;)
2553	{
2554	body;
2555	cycle_label:
2556	dovar += step
2557	countm1t = countm1;
2558	countm1--;
2559	if (countm1t == 0) goto exit_label;
2560	}
2561	exit_label:
2562
2563	countm1 is an unsigned integer. It is equal to the loop count minus one,
2564	because the loop count itself can overflow. */
2565
2566	tree
2567	gfc_trans_do (gfc_code * code, tree exit_cond)
2568	{
2569	gfc_se se;
2570	tree dovar;
2571	tree saved_dovar = NULL__null;
2572	tree from;
2573	tree to;
2574	tree step;
2575	tree countm1;
2576	tree type;
2577	tree utype;
2578	tree cond;
2579	tree cycle_label;
2580	tree exit_label;
2581	tree tmp;
2582	stmtblock_t block;
2583	stmtblock_t body;
2584	location_t loc;
2585
2586	gfc_start_block (&block);
2587
2588	loc = gfc_get_location (&code->ext.iterator->start->where);
2589
2590	/* Evaluate all the expressions in the iterator. */
2591	gfc_init_se (&se, NULL__null);
2592	gfc_conv_expr_lhs (&se, code->ext.iterator->var);
2593	gfc_add_block_to_block (&block, &se.pre);
2594	dovar = se.expr;
2595	type = TREE_TYPE (dovar)((contains_struct_check ((dovar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2595, __FUNCTION__))->typed.type);
2596
2597	gfc_init_se (&se, NULL__null);
2598	gfc_conv_expr_val (&se, code->ext.iterator->start);
2599	gfc_add_block_to_block (&block, &se.pre);
2600	from = gfc_evaluate_now (se.expr, &block);
2601
2602	gfc_init_se (&se, NULL__null);
2603	gfc_conv_expr_val (&se, code->ext.iterator->end);
2604	gfc_add_block_to_block (&block, &se.pre);
2605	to = gfc_evaluate_now (se.expr, &block);
2606
2607	gfc_init_se (&se, NULL__null);
2608	gfc_conv_expr_val (&se, code->ext.iterator->step);
2609	gfc_add_block_to_block (&block, &se.pre);
2610	step = gfc_evaluate_now (se.expr, &block);
2611
2612	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2613	{
2614	tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, step,
2615	build_zero_cst (type));
2616	gfc_trans_runtime_check (true, false, tmp, &block, &code->loc,
2617	"DO step value is zero");
2618	}
2619
2620	/* Special case simple loops. */
2621	if (TREE_CODE (type)((enum tree_code) (type)->base.code) == INTEGER_TYPE
2622	&& (integer_onep (step)
2623	\|\| tree_int_cst_equal (step, integer_minus_one_nodeglobal_trees[TI_INTEGER_MINUS_ONE])))
2624	return gfc_trans_simple_do (code, &block, dovar, from, to, step,
2625	exit_cond);
2626
2627	if (TREE_CODE (type)((enum tree_code) (type)->base.code) == INTEGER_TYPE)
2628	utype = unsigned_type_for (type);
2629	else
2630	utype = unsigned_type_for (gfc_array_index_type);
2631	countm1 = gfc_create_var (utype, "countm1");
2632
2633	/* Cycle and exit statements are implemented with gotos. */
2634	cycle_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2635	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2636	TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
2637
2638	/* Put these labels where they can be found later. */
2639	code->cycle_label = cycle_label;
2640	code->exit_label = exit_label;
2641
2642	/* Initialize the DO variable: dovar = from. */
2643	gfc_add_modify (&block, dovar, from);
2644
2645	/* Save value for do-tinkering checking. */
2646	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2647	{
2648	saved_dovar = gfc_create_var (type, ".saved_dovar");
2649	gfc_add_modify_loc (loc, &block, saved_dovar, dovar);
2650	}
2651
2652	/* Initialize loop count and jump to exit label if the loop is empty.
2653	This code is executed before we enter the loop body. We generate:
2654	if (step > 0)
2655	{
2656	countm1 = (to - from) / step;
2657	if (to < from)
2658	goto exit_label;
2659	}
2660	else
2661	{
2662	countm1 = (from - to) / -step;
2663	if (to > from)
2664	goto exit_label;
2665	}
2666	*/
2667
2668	if (TREE_CODE (type)((enum tree_code) (type)->base.code) == INTEGER_TYPE)
2669	{
2670	tree pos, neg, tou, fromu, stepu, tmp2;
2671
2672	/* The distance from FROM to TO cannot always be represented in a signed
2673	type, thus use unsigned arithmetic, also to avoid any undefined
2674	overflow issues. */
2675	tou = fold_convert (utype, to)fold_convert_loc (((location_t) 0), utype, to);
2676	fromu = fold_convert (utype, from)fold_convert_loc (((location_t) 0), utype, from);
2677	stepu = fold_convert (utype, step)fold_convert_loc (((location_t) 0), utype, step);
2678
2679	/* For a positive step, when to < from, exit, otherwise compute
2680	countm1 = ((unsigned)to - (unsigned)from) / (unsigned)step */
2681	tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, to, from);
2682	tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype,
2683	fold_build2_loc (loc, MINUS_EXPR, utype,
2684	tou, fromu),
2685	stepu);
2686	pos = build2 (COMPOUND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2687	fold_build2 (MODIFY_EXPR, void_type_node,fold_build2_loc (((location_t) 0), MODIFY_EXPR, global_trees[ TI_VOID_TYPE], countm1, tmp2 )
2688	countm1, tmp2)fold_build2_loc (((location_t) 0), MODIFY_EXPR, global_trees[ TI_VOID_TYPE], countm1, tmp2 ),
2689	build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2690	gfc_unlikely (tmp, PRED_FORTRAN_LOOP_PREHEADER),
2691	build1_loc (loc, GOTO_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2692	exit_label), NULL_TREE(tree) __null));
2693
2694	/* For a negative step, when to > from, exit, otherwise compute
2695	countm1 = ((unsigned)from - (unsigned)to) / -(unsigned)step */
2696	tmp = fold_build2_loc (loc, GT_EXPR, logical_type_node, to, from);
2697	tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype,
2698	fold_build2_loc (loc, MINUS_EXPR, utype,
2699	fromu, tou),
2700	fold_build1_loc (loc, NEGATE_EXPR, utype, stepu));
2701	neg = build2 (COMPOUND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2702	fold_build2 (MODIFY_EXPR, void_type_node,fold_build2_loc (((location_t) 0), MODIFY_EXPR, global_trees[ TI_VOID_TYPE], countm1, tmp2 )
2703	countm1, tmp2)fold_build2_loc (((location_t) 0), MODIFY_EXPR, global_trees[ TI_VOID_TYPE], countm1, tmp2 ),
2704	build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2705	gfc_unlikely (tmp, PRED_FORTRAN_LOOP_PREHEADER),
2706	build1_loc (loc, GOTO_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2707	exit_label), NULL_TREE(tree) __null));
2708
2709	tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, step,
2710	build_int_cst (TREE_TYPE (step)((contains_struct_check ((step), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2710, __FUNCTION__))->typed.type), 0));
2711	tmp = fold_build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], tmp, neg, pos);
2712
2713	gfc_add_expr_to_block (&block, tmp);
2714	}
2715	else
2716	{
2717	tree pos_step;
2718
2719	/* TODO: We could use the same width as the real type.
2720	This would probably cause more problems that it solves
2721	when we implement "long double" types. */
2722
2723	tmp = fold_build2_loc (loc, MINUS_EXPR, type, to, from);
2724	tmp = fold_build2_loc (loc, RDIV_EXPR, type, tmp, step);
2725	tmp = fold_build1_loc (loc, FIX_TRUNC_EXPR, utype, tmp);
2726	gfc_add_modify (&block, countm1, tmp);
2727
2728	/* We need a special check for empty loops:
2729	empty = (step > 0 ? to < from : to > from); */
2730	pos_step = fold_build2_loc (loc, GT_EXPR, logical_type_node, step,
2731	build_zero_cst (type));
2732	tmp = fold_build3_loc (loc, COND_EXPR, logical_type_node, pos_step,
2733	fold_build2_loc (loc, LT_EXPR,
2734	logical_type_node, to, from),
2735	fold_build2_loc (loc, GT_EXPR,
2736	logical_type_node, to, from));
2737	/* If the loop is empty, go directly to the exit label. */
2738	tmp = fold_build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], tmp,
2739	build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], exit_label),
2740	build_empty_stmt (input_location));
2741	gfc_add_expr_to_block (&block, tmp);
2742	}
2743
2744	/* Loop body. */
2745	gfc_start_block (&body);
2746
2747	/* Main loop body. */
2748	tmp = gfc_trans_code_cond (code->block->next, exit_cond);
2749	gfc_add_expr_to_block (&body, tmp);
2750
2751	/* Label for cycle statements (if needed). */
2752	if (TREE_USED (cycle_label)((cycle_label)->base.used_flag))
2753	{
2754	tmp = build1_v (LABEL_EXPR, cycle_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], cycle_label);
2755	gfc_add_expr_to_block (&body, tmp);
2756	}
2757
2758	/* Check whether someone has modified the loop variable. */
2759	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2760	{
2761	tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node, dovar,
2762	saved_dovar);
2763	gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
2764	"Loop variable has been modified");
2765	}
2766
2767	/* Exit the loop if there is an I/O result condition or error. */
2768	if (exit_cond)
2769	{
2770	tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2771	tmp = fold_build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2772	exit_cond, tmp,
2773	build_empty_stmt (input_location));
2774	gfc_add_expr_to_block (&body, tmp);
2775	}
2776
2777	/* Increment the loop variable. */
2778	tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
2779	gfc_add_modify_loc (loc, &body, dovar, tmp);
2780
2781	if (gfc_option.rtcheck & GFC_RTCHECK_DO(1<<3))
2782	gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
2783
2784	/* Initialize countm1t. */
2785	tree countm1t = gfc_create_var (utype, "countm1t");
2786	gfc_add_modify_loc (loc, &body, countm1t, countm1);
2787
2788	/* Decrement the loop count. */
2789	tmp = fold_build2_loc (loc, MINUS_EXPR, utype, countm1,
2790	build_int_cst (utype, 1));
2791	gfc_add_modify_loc (loc, &body, countm1, tmp);
2792
2793	/* End with the loop condition. Loop until countm1t == 0. */
2794	cond = fold_build2_loc (loc, EQ_EXPR, logical_type_node, countm1t,
2795	build_int_cst (utype, 0));
2796	if (code->ext.iterator->unroll && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2797	cond
2798	= build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2798, __FUNCTION__))->typed.type), cond,
2799	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_unroll_kind),
2800	build_int_cst (integer_type_nodeinteger_types[itk_int], code->ext.iterator->unroll));
2801
2802	if (code->ext.iterator->ivdep && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2803	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2803, __FUNCTION__))->typed.type), cond,
2804	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_ivdep_kind),
2805	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
2806	if (code->ext.iterator->vector && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2807	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2807, __FUNCTION__))->typed.type), cond,
2808	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_vector_kind),
2809	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
2810	if (code->ext.iterator->novector && cond != error_mark_nodeglobal_trees[TI_ERROR_MARK])
2811	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2811, __FUNCTION__))->typed.type), cond,
2812	build_int_cst (integer_type_nodeinteger_types[itk_int], annot_expr_no_vector_kind),
2813	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
2814
2815	tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], exit_label);
2816	tmp = fold_build3_loc (loc, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
2817	cond, tmp, build_empty_stmt (loc));
2818	gfc_add_expr_to_block (&body, tmp);
2819
2820	/* End of loop body. */
2821	tmp = gfc_finish_block (&body);
2822
2823	/* The for loop itself. */
2824	tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE], tmp);
2825	gfc_add_expr_to_block (&block, tmp);
2826
2827	/* Add the exit label. */
2828	tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2829	gfc_add_expr_to_block (&block, tmp);
2830
2831	return gfc_finish_block (&block);
2832	}
2833
2834
2835	/* Translate the DO WHILE construct.
2836
2837	We translate
2838
2839	DO WHILE (cond)
2840	body
2841	END DO
2842
2843	to:
2844
2845	for ( ; ; )
2846	{
2847	pre_cond;
2848	if (! cond) goto exit_label;
2849	body;
2850	cycle_label:
2851	}
2852	exit_label:
2853
2854	Because the evaluation of the exit condition `cond' may have side
2855	effects, we can't do much for empty loop bodies. The backend optimizers
2856	should be smart enough to eliminate any dead loops. */
2857
2858	tree
2859	gfc_trans_do_while (gfc_code * code)
2860	{
2861	gfc_se cond;
2862	tree tmp;
2863	tree cycle_label;
2864	tree exit_label;
2865	stmtblock_t block;
2866
2867	/* Everything we build here is part of the loop body. */
2868	gfc_start_block (&block);
2869
2870	/* Cycle and exit statements are implemented with gotos. */
2871	cycle_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2872	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
2873
2874	/* Put the labels where they can be found later. See gfc_trans_do(). */
2875	code->cycle_label = cycle_label;
2876	code->exit_label = exit_label;
2877
2878	/* Create a GIMPLE version of the exit condition. */
2879	gfc_init_se (&cond, NULL__null);
2880	gfc_conv_expr_val (&cond, code->expr1);
2881	gfc_add_block_to_block (&block, &cond.pre);
2882	cond.expr = fold_build1_loc (gfc_get_location (&code->expr1->where),
2883	TRUTH_NOT_EXPR, TREE_TYPE (cond.expr)((contains_struct_check ((cond.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2883, __FUNCTION__))->typed.type),
2884	cond.expr);
2885
2886	/* Build "IF (! cond) GOTO exit_label". */
2887	tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2888	TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
2889	tmp = fold_build3_loc (gfc_get_location (&code->expr1->where), COND_EXPR,
2890	void_type_nodeglobal_trees[TI_VOID_TYPE], cond.expr, tmp,
2891	build_empty_stmt (gfc_get_location (
2892	&code->expr1->where)));
2893	gfc_add_expr_to_block (&block, tmp);
2894
2895	/* The main body of the loop. */
2896	tmp = gfc_trans_code (code->block->next);
2897	gfc_add_expr_to_block (&block, tmp);
2898
2899	/* Label for cycle statements (if needed). */
2900	if (TREE_USED (cycle_label)((cycle_label)->base.used_flag))
2901	{
2902	tmp = build1_v (LABEL_EXPR, cycle_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], cycle_label);
2903	gfc_add_expr_to_block (&block, tmp);
2904	}
2905
2906	/* End of loop body. */
2907	tmp = gfc_finish_block (&block);
2908
2909	gfc_init_block (&block);
2910	/* Build the loop. */
2911	tmp = fold_build1_loc (gfc_get_location (&code->expr1->where), LOOP_EXPR,
2912	void_type_nodeglobal_trees[TI_VOID_TYPE], tmp);
2913	gfc_add_expr_to_block (&block, tmp);
2914
2915	/* Add the exit label. */
2916	tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
2917	gfc_add_expr_to_block (&block, tmp);
2918
2919	return gfc_finish_block (&block);
2920	}
2921
2922
2923	/* Deal with the particular case of SELECT_TYPE, where the vtable
2924	addresses are used for the selection. Since these are not sorted,
2925	the selection has to be made by a series of if statements. */
2926
2927	static tree
2928	gfc_trans_select_type_cases (gfc_code * code)
2929	{
2930	gfc_code *c;
2931	gfc_case *cp;
2932	tree tmp;
2933	tree cond;
2934	tree low;
2935	tree high;
2936	gfc_se se;
2937	gfc_se cse;
2938	stmtblock_t block;
2939	stmtblock_t body;
2940	bool def = false;
2941	gfc_expr *e;
2942	gfc_start_block (&block);
2943
2944	/* Calculate the switch expression. */
2945	gfc_init_se (&se, NULL__null);
2946	gfc_conv_expr_val (&se, code->expr1);
2947	gfc_add_block_to_block (&block, &se.pre);
2948
2949	/* Generate an expression for the selector hash value, for
2950	use to resolve character cases. */
2951	e = gfc_copy_expr (code->expr1->value.function.actual->expr);
2952	gfc_add_hash_component (e)gfc_add_component_ref(e,"_hash");
2953
2954	TREE_USED (code->exit_label)((code->exit_label)->base.used_flag) = 0;
2955
2956	repeat:
2957	for (c = code->block; c; c = c->block)
2958	{
2959	cp = c->ext.block.case_list;
2960
2961	/* Assume it's the default case. */
2962	low = NULL_TREE(tree) __null;
2963	high = NULL_TREE(tree) __null;
2964	tmp = NULL_TREE(tree) __null;
2965
2966	/* Put the default case at the end. */
2967	if ((!def && !cp->low) \|\| (def && cp->low))
2968	continue;
2969
2970	if (cp->low && (cp->ts.type == BT_CLASS
2971	\|\| cp->ts.type == BT_DERIVED))
2972	{
2973	gfc_init_se (&cse, NULL__null);
2974	gfc_conv_expr_val (&cse, cp->low);
2975	gfc_add_block_to_block (&block, &cse.pre);
2976	low = cse.expr;
2977	}
2978	else if (cp->ts.type != BT_UNKNOWN)
2979	{
2980	gcc_assert (cp->high)((void)(!(cp->high) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 2980, __FUNCTION__), 0 : 0));
2981	gfc_init_se (&cse, NULL__null);
2982	gfc_conv_expr_val (&cse, cp->high);
2983	gfc_add_block_to_block (&block, &cse.pre);
2984	high = cse.expr;
2985	}
2986
2987	gfc_init_block (&body);
2988
2989	/* Add the statements for this case. */
2990	tmp = gfc_trans_code (c->next);
2991	gfc_add_expr_to_block (&body, tmp);
2992
2993	/* Break to the end of the SELECT TYPE construct. The default
2994	case just falls through. */
2995	if (!def)
2996	{
2997	TREE_USED (code->exit_label)((code->exit_label)->base.used_flag) = 1;
2998	tmp = build1_v (GOTO_EXPR, code->exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], code->exit_label);
2999	gfc_add_expr_to_block (&body, tmp);
3000	}
3001
3002	tmp = gfc_finish_block (&body);
3003
3004	if (low != NULL_TREE(tree) __null)
3005	{
3006	/* Compare vtable pointers. */
3007	cond = fold_build2_loc (input_location, EQ_EXPR,
3008	TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3008, __FUNCTION__))->typed.type), se.expr, low);
3009	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
3010	cond, tmp,
3011	build_empty_stmt (input_location));
3012	}
3013	else if (high != NULL_TREE(tree) __null)
3014	{
3015	/* Compare hash values for character cases. */
3016	gfc_init_se (&cse, NULL__null);
3017	gfc_conv_expr_val (&cse, e);
3018	gfc_add_block_to_block (&block, &cse.pre);
3019
3020	cond = fold_build2_loc (input_location, EQ_EXPR,
3021	TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3021, __FUNCTION__))->typed.type), high, cse.expr);
3022	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
3023	cond, tmp,
3024	build_empty_stmt (input_location));
3025	}
3026
3027	gfc_add_expr_to_block (&block, tmp);
3028	}
3029
3030	if (!def)
3031	{
3032	def = true;
3033	goto repeat;
3034	}
3035
3036	gfc_free_expr (e);
3037
3038	return gfc_finish_block (&block);
3039	}
3040
3041
3042	/* Translate the SELECT CASE construct for INTEGER case expressions,
3043	without killing all potential optimizations. The problem is that
3044	Fortran allows unbounded cases, but the back-end does not, so we
3045	need to intercept those before we enter the equivalent SWITCH_EXPR
3046	we can build.
3047
3048	For example, we translate this,
3049
3050	SELECT CASE (expr)
3051	CASE (:100,101,105:115)
3052	block_1
3053	CASE (190:199,200:)
3054	block_2
3055	CASE (300)
3056	block_3
3057	CASE DEFAULT
3058	block_4
3059	END SELECT
3060
3061	to the GENERIC equivalent,
3062
3063	switch (expr)
3064	{
3065	case (minimum value for typeof(expr) ... 100:
3066	case 101:
3067	case 105 ... 114:
3068	block1:
3069	goto end_label;
3070
3071	case 200 ... (maximum value for typeof(expr):
3072	case 190 ... 199:
3073	block2;
3074	goto end_label;
3075
3076	case 300:
3077	block_3;
3078	goto end_label;
3079
3080	default:
3081	block_4;
3082	goto end_label;
3083	}
3084
3085	end_label: */
3086
3087	static tree
3088	gfc_trans_integer_select (gfc_code * code)
3089	{
3090	gfc_code *c;
3091	gfc_case *cp;
3092	tree end_label;
3093	tree tmp;
3094	gfc_se se;
3095	stmtblock_t block;
3096	stmtblock_t body;
3097
3098	gfc_start_block (&block);
3099
3100	/* Calculate the switch expression. */
3101	gfc_init_se (&se, NULL__null);
3102	gfc_conv_expr_val (&se, code->expr1);
3103	gfc_add_block_to_block (&block, &se.pre);
3104
3105	end_label = gfc_build_label_decl (NULL_TREE(tree) __null);
3106
3107	gfc_init_block (&body);
3108
3109	for (c = code->block; c; c = c->block)
3110	{
3111	for (cp = c->ext.block.case_list; cp; cp = cp->next)
3112	{
3113	tree low, high;
3114	tree label;
3115
3116	/* Assume it's the default case. */
3117	low = high = NULL_TREE(tree) __null;
3118
3119	if (cp->low)
3120	{
3121	low = gfc_conv_mpz_to_tree (cp->low->value.integer,
3122	cp->low->ts.kind);
3123
3124	/* If there's only a lower bound, set the high bound to the
3125	maximum value of the case expression. */
3126	if (!cp->high)
3127	high = TYPE_MAX_VALUE (TREE_TYPE (se.expr))((tree_check5 ((((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3127, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3127, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval );
3128	}
3129
3130	if (cp->high)
3131	{
3132	/* Three cases are possible here:
3133
3134	1) There is no lower bound, e.g. CASE (:N).
3135	2) There is a lower bound .NE. high bound, that is
3136	a case range, e.g. CASE (N:M) where M>N (we make
3137	sure that M>N during type resolution).
3138	3) There is a lower bound, and it has the same value
3139	as the high bound, e.g. CASE (N:N). This is our
3140	internal representation of CASE(N).
3141
3142	In the first and second case, we need to set a value for
3143	high. In the third case, we don't because the GCC middle
3144	end represents a single case value by just letting high be
3145	a NULL_TREE. We can't do that because we need to be able
3146	to represent unbounded cases. */
3147
3148	if (!cp->low
3149	\|\| (mpz_cmp__gmpz_cmp (cp->low->value.integer,
3150	cp->high->value.integer) != 0))
3151	high = gfc_conv_mpz_to_tree (cp->high->value.integer,
3152	cp->high->ts.kind);
3153
3154	/* Unbounded case. */
3155	if (!cp->low)
3156	low = TYPE_MIN_VALUE (TREE_TYPE (se.expr))((tree_check5 ((((contains_struct_check ((se.expr), (TS_TYPED ), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3156, __FUNCTION__))->typed.type)), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3156, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval );
3157	}
3158
3159	/* Build a label. */
3160	label = gfc_build_label_decl (NULL_TREE(tree) __null);
3161
3162	/* Add this case label.
3163	Add parameter 'label', make it match GCC backend. */
3164	tmp = build_case_label (low, high, label);
3165	gfc_add_expr_to_block (&body, tmp);
3166	}
3167
3168	/* Add the statements for this case. */
3169	tmp = gfc_trans_code (c->next);
3170	gfc_add_expr_to_block (&body, tmp);
3171
3172	/* Break to the end of the construct. */
3173	tmp = build1_v (GOTO_EXPR, end_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], end_label);
3174	gfc_add_expr_to_block (&body, tmp);
3175	}
3176
3177	tmp = gfc_finish_block (&body);
3178	tmp = fold_build2_loc (input_location, SWITCH_EXPR, NULL_TREE(tree) __null, se.expr, tmp);
3179	gfc_add_expr_to_block (&block, tmp);
3180
3181	tmp = build1_v (LABEL_EXPR, end_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], end_label);
3182	gfc_add_expr_to_block (&block, tmp);
3183
3184	return gfc_finish_block (&block);
3185	}
3186
3187
3188	/* Translate the SELECT CASE construct for LOGICAL case expressions.
3189
3190	There are only two cases possible here, even though the standard
3191	does allow three cases in a LOGICAL SELECT CASE construct: .TRUE.,
3192	.FALSE., and DEFAULT.
3193
3194	We never generate more than two blocks here. Instead, we always
3195	try to eliminate the DEFAULT case. This way, we can translate this
3196	kind of SELECT construct to a simple
3197
3198	if {} else {};
3199
3200	expression in GENERIC. */
3201
3202	static tree
3203	gfc_trans_logical_select (gfc_code * code)
3204	{
3205	gfc_code *c;
3206	gfc_code t, f, *d;
3207	gfc_case *cp;
3208	gfc_se se;
3209	stmtblock_t block;
3210
3211	/* Assume we don't have any cases at all. */
3212	t = f = d = NULL__null;
3213
3214	/* Now see which ones we actually do have. We can have at most two
3215	cases in a single case list: one for .TRUE. and one for .FALSE.
3216	The default case is always separate. If the cases for .TRUE. and
3217	.FALSE. are in the same case list, the block for that case list
3218	always executed, and we don't generate code a COND_EXPR. */
3219	for (c = code->block; c; c = c->block)
3220	{
3221	for (cp = c->ext.block.case_list; cp; cp = cp->next)
3222	{
3223	if (cp->low)
3224	{
3225	if (cp->low->value.logical == 0) /* .FALSE. */
3226	f = c;
3227	else /* if (cp->value.logical != 0), thus .TRUE. */
3228	t = c;
3229	}
3230	else
3231	d = c;
3232	}
3233	}
3234
3235	/* Start a new block. */
3236	gfc_start_block (&block);
3237
3238	/* Calculate the switch expression. We always need to do this
3239	because it may have side effects. */
3240	gfc_init_se (&se, NULL__null);
3241	gfc_conv_expr_val (&se, code->expr1);
3242	gfc_add_block_to_block (&block, &se.pre);
3243
3244	if (t == f && t != NULL__null)
3245	{
3246	/* Cases for .TRUE. and .FALSE. are in the same block. Just
3247	translate the code for these cases, append it to the current
3248	block. */
3249	gfc_add_expr_to_block (&block, gfc_trans_code (t->next));
3250	}
3251	else
3252	{
3253	tree true_tree, false_tree, stmt;
3254
3255	true_tree = build_empty_stmt (input_location);
3256	false_tree = build_empty_stmt (input_location);
3257
3258	/* If we have a case for .TRUE. and for .FALSE., discard the default case.
3259	Otherwise, if .TRUE. or .FALSE. is missing and there is a default case,
3260	make the missing case the default case. */
3261	if (t != NULL__null && f != NULL__null)
3262	d = NULL__null;
3263	else if (d != NULL__null)
3264	{
3265	if (t == NULL__null)
3266	t = d;
3267	else
3268	f = d;
3269	}
3270
3271	/* Translate the code for each of these blocks, and append it to
3272	the current block. */
3273	if (t != NULL__null)
3274	true_tree = gfc_trans_code (t->next);
3275
3276	if (f != NULL__null)
3277	false_tree = gfc_trans_code (f->next);
3278
3279	stmt = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
3280	se.expr, true_tree, false_tree);
3281	gfc_add_expr_to_block (&block, stmt);
3282	}
3283
3284	return gfc_finish_block (&block);
3285	}
3286
3287
3288	/* The jump table types are stored in static variables to avoid
3289	constructing them from scratch every single time. */
3290	static GTY(()) tree select_struct[2];
3291
3292	/* Translate the SELECT CASE construct for CHARACTER case expressions.
3293	Instead of generating compares and jumps, it is far simpler to
3294	generate a data structure describing the cases in order and call a
3295	library subroutine that locates the right case.
3296	This is particularly true because this is the only case where we
3297	might have to dispose of a temporary.
3298	The library subroutine returns a pointer to jump to or NULL if no
3299	branches are to be taken. */
3300
3301	static tree
3302	gfc_trans_character_select (gfc_code *code)
3303	{
3304	tree init, end_label, tmp, type, case_num, label, fndecl;
3305	stmtblock_t block, body;
3306	gfc_case cp, d;
3307	gfc_code *c;
3308	gfc_se se, expr1se;
3309	int n, k;
3310	vec<constructor_elt, va_gc> *inits = NULL__null;
3311
3312	tree pchartype = gfc_get_pchar_type (code->expr1->ts.kind);
3313
3314	/* The jump table types are stored in static variables to avoid
3315	constructing them from scratch every single time. */
3316	static tree ss_string1[2], ss_string1_len[2];
3317	static tree ss_string2[2], ss_string2_len[2];
3318	static tree ss_target[2];
3319
3320	cp = code->block->ext.block.case_list;
3321	while (cp->left != NULL__null)
3322	cp = cp->left;
3323
3324	/* Generate the body */
3325	gfc_start_block (&block);
3326	gfc_init_se (&expr1se, NULL__null);
3327	gfc_conv_expr_reference (&expr1se, code->expr1);
3328
3329	gfc_add_block_to_block (&block, &expr1se.pre);
3330
3331	end_label = gfc_build_label_decl (NULL_TREE(tree) __null);
3332
3333	gfc_init_block (&body);
3334
3335	/* Attempt to optimize length 1 selects. */
3336	if (integer_onep (expr1se.string_length))
3337	{
3338	for (d = cp; d; d = d->right)
3339	{
3340	gfc_charlen_t i;
3341	if (d->low)
3342	{
3343	gcc_assert (d->low->expr_type == EXPR_CONSTANT((void)(!(d->low->expr_type == EXPR_CONSTANT && d->low->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3344, __FUNCTION__), 0 : 0))
3344	&& d->low->ts.type == BT_CHARACTER)((void)(!(d->low->expr_type == EXPR_CONSTANT && d->low->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3344, __FUNCTION__), 0 : 0));
3345	if (d->low->value.character.length > 1)
3346	{
3347	for (i = 1; i < d->low->value.character.length; i++)
3348	if (d->low->value.character.string[i] != ' ')
3349	break;
3350	if (i != d->low->value.character.length)
3351	{
3352	if (optimizeglobal_options.x_optimize && d->high && i == 1)
3353	{
3354	gcc_assert (d->high->expr_type == EXPR_CONSTANT((void)(!(d->high->expr_type == EXPR_CONSTANT && d->high->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3355, __FUNCTION__), 0 : 0))
3355	&& d->high->ts.type == BT_CHARACTER)((void)(!(d->high->expr_type == EXPR_CONSTANT && d->high->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3355, __FUNCTION__), 0 : 0));
3356	if (d->high->value.character.length > 1
3357	&& (d->low->value.character.string[0]
3358	== d->high->value.character.string[0])
3359	&& d->high->value.character.string[1] != ' '
3360	&& ((d->low->value.character.string[1] < ' ')
3361	== (d->high->value.character.string[1]
3362	< ' ')))
3363	continue;
3364	}
3365	break;
3366	}
3367	}
3368	}
3369	if (d->high)
3370	{
3371	gcc_assert (d->high->expr_type == EXPR_CONSTANT((void)(!(d->high->expr_type == EXPR_CONSTANT && d->high->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3372, __FUNCTION__), 0 : 0))
3372	&& d->high->ts.type == BT_CHARACTER)((void)(!(d->high->expr_type == EXPR_CONSTANT && d->high->ts.type == BT_CHARACTER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3372, __FUNCTION__), 0 : 0));
3373	if (d->high->value.character.length > 1)
3374	{
3375	for (i = 1; i < d->high->value.character.length; i++)
3376	if (d->high->value.character.string[i] != ' ')
3377	break;
3378	if (i != d->high->value.character.length)
3379	break;
3380	}
3381	}
3382	}
3383	if (d == NULL__null)
3384	{
3385	tree ctype = gfc_get_char_type (code->expr1->ts.kind);
3386
3387	for (c = code->block; c; c = c->block)
3388	{
3389	for (cp = c->ext.block.case_list; cp; cp = cp->next)
3390	{
3391	tree low, high;
3392	tree label;
3393	gfc_char_t r;
3394
3395	/* Assume it's the default case. */
3396	low = high = NULL_TREE(tree) __null;
3397
3398	if (cp->low)
3399	{
3400	/* CASE ('ab') or CASE ('ab':'az') will never match
3401	any length 1 character. */
3402	if (cp->low->value.character.length > 1
3403	&& cp->low->value.character.string[1] != ' ')
3404	continue;
3405
3406	if (cp->low->value.character.length > 0)
3407	r = cp->low->value.character.string[0];
3408	else
3409	r = ' ';
3410	low = build_int_cst (ctype, r);
3411
3412	/* If there's only a lower bound, set the high bound
3413	to the maximum value of the case expression. */
3414	if (!cp->high)
3415	high = TYPE_MAX_VALUE (ctype)((tree_check5 ((ctype), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3415, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval );
3416	}
3417
3418	if (cp->high)
3419	{
3420	if (!cp->low
3421	\|\| (cp->low->value.character.string[0]
3422	!= cp->high->value.character.string[0]))
3423	{
3424	if (cp->high->value.character.length > 0)
3425	r = cp->high->value.character.string[0];
3426	else
3427	r = ' ';
3428	high = build_int_cst (ctype, r);
3429	}
3430
3431	/* Unbounded case. */
3432	if (!cp->low)
3433	low = TYPE_MIN_VALUE (ctype)((tree_check5 ((ctype), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3433, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE ), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval );
3434	}
3435
3436	/* Build a label. */
3437	label = gfc_build_label_decl (NULL_TREE(tree) __null);
3438
3439	/* Add this case label.
3440	Add parameter 'label', make it match GCC backend. */
3441	tmp = build_case_label (low, high, label);
3442	gfc_add_expr_to_block (&body, tmp);
3443	}
3444
3445	/* Add the statements for this case. */
3446	tmp = gfc_trans_code (c->next);
3447	gfc_add_expr_to_block (&body, tmp);
3448
3449	/* Break to the end of the construct. */
3450	tmp = build1_v (GOTO_EXPR, end_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], end_label);
3451	gfc_add_expr_to_block (&body, tmp);
3452	}
3453
3454	tmp = gfc_string_to_single_character (expr1se.string_length,
3455	expr1se.expr,
3456	code->expr1->ts.kind);
3457	case_num = gfc_create_var (ctype, "case_num");
3458	gfc_add_modify (&block, case_num, tmp);
3459
3460	gfc_add_block_to_block (&block, &expr1se.post);
3461
3462	tmp = gfc_finish_block (&body);
3463	tmp = fold_build2_loc (input_location, SWITCH_EXPR, NULL_TREE(tree) __null,
3464	case_num, tmp);
3465	gfc_add_expr_to_block (&block, tmp);
3466
3467	tmp = build1_v (LABEL_EXPR, end_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], end_label);
3468	gfc_add_expr_to_block (&block, tmp);
3469
3470	return gfc_finish_block (&block);
3471	}
3472	}
3473
3474	if (code->expr1->ts.kind == 1)
3475	k = 0;
3476	else if (code->expr1->ts.kind == 4)
3477	k = 1;
3478	else
3479	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3479, __FUNCTION__));
3480
3481	if (select_struct[k] == NULL__null)
3482	{
3483	tree *chain = NULL__null;
3484	select_struct[k] = make_node (RECORD_TYPE);
3485
3486	if (code->expr1->ts.kind == 1)
3487	TYPE_NAME (select_struct[k])((tree_class_check ((select_struct[k]), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3487, __FUNCTION__))->type_common.name) = get_identifier ("_jump_struct_char1")(__builtin_constant_p ("_jump_struct_char1") ? get_identifier_with_length (("_jump_struct_char1"), strlen ("_jump_struct_char1")) : get_identifier ("_jump_struct_char1"));
3488	else if (code->expr1->ts.kind == 4)
3489	TYPE_NAME (select_struct[k])((tree_class_check ((select_struct[k]), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3489, __FUNCTION__))->type_common.name) = get_identifier ("_jump_struct_char4")(__builtin_constant_p ("_jump_struct_char4") ? get_identifier_with_length (("_jump_struct_char4"), strlen ("_jump_struct_char4")) : get_identifier ("_jump_struct_char4"));
3490	else
3491	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3491, __FUNCTION__));
3492
3493	#undef ADD_FIELD
3494	#define ADD_FIELD(NAME, TYPE) \
3495	ss_##NAME[k] = gfc_add_field_to_struct (select_struct[k], \
3496	get_identifier (stringize(NAME))(__builtin_constant_p ("NAME") ? get_identifier_with_length ( ("NAME"), strlen ("NAME")) : get_identifier ("NAME")), \
3497	TYPE, \
3498	&chain)
3499
3500	ADD_FIELD (string1, pchartype);
3501	ADD_FIELD (string1_len, gfc_charlen_type_node);
3502
3503	ADD_FIELD (string2, pchartype);
3504	ADD_FIELD (string2_len, gfc_charlen_type_node);
3505
3506	ADD_FIELD (target, integer_type_nodeinteger_types[itk_int]);
3507	#undef ADD_FIELD
3508
3509	gfc_finish_type (select_struct[k]);
3510	}
3511
3512	n = 0;
3513	for (d = cp; d; d = d->right)
3514	d->n = n++;
3515
3516	for (c = code->block; c; c = c->block)
3517	{
3518	for (d = c->ext.block.case_list; d; d = d->next)
3519	{
3520	label = gfc_build_label_decl (NULL_TREE(tree) __null);
3521	tmp = build_case_label ((d->low == NULL__null && d->high == NULL__null)
3522	? NULL__null
3523	: build_int_cst (integer_type_nodeinteger_types[itk_int], d->n),
3524	NULL__null, label);
3525	gfc_add_expr_to_block (&body, tmp);
3526	}
3527
3528	tmp = gfc_trans_code (c->next);
3529	gfc_add_expr_to_block (&body, tmp);
3530
3531	tmp = build1_v (GOTO_EXPR, end_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], end_label);
3532	gfc_add_expr_to_block (&body, tmp);
3533	}
3534
3535	/* Generate the structure describing the branches */
3536	for (d = cp; d; d = d->right)
3537	{
3538	vec<constructor_elt, va_gc> *node = NULL__null;
3539
3540	gfc_init_se (&se, NULL__null);
3541
3542	if (d->low == NULL__null)
3543	{
3544	CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], null_pointer_node)do { constructor_elt _ce___ = {ss_string1[k], global_trees[TI_NULL_POINTER ]}; vec_safe_push ((node), _ce___); } while (0);
3545	CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_node))do { constructor_elt _ce___ = {ss_string1_len[k], build_zero_cst (gfc_charlen_type_node)}; vec_safe_push ((node), _ce___); } while (0);
3546	}
3547	else
3548	{
3549	gfc_conv_expr_reference (&se, d->low);
3550
3551	CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], se.expr)do { constructor_elt _ce___ = {ss_string1[k], se.expr}; vec_safe_push ((node), _ce___); } while (0);
3552	CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], se.string_length)do { constructor_elt _ce___ = {ss_string1_len[k], se.string_length }; vec_safe_push ((node), _ce___); } while (0);
3553	}
3554
3555	if (d->high == NULL__null)
3556	{
3557	CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], null_pointer_node)do { constructor_elt _ce___ = {ss_string2[k], global_trees[TI_NULL_POINTER ]}; vec_safe_push ((node), _ce___); } while (0);
3558	CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node))do { constructor_elt _ce___ = {ss_string2_len[k], build_zero_cst (gfc_charlen_type_node)}; vec_safe_push ((node), _ce___); } while (0);
3559	}
3560	else
3561	{
3562	gfc_init_se (&se, NULL__null);
3563	gfc_conv_expr_reference (&se, d->high);
3564
3565	CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], se.expr)do { constructor_elt _ce___ = {ss_string2[k], se.expr}; vec_safe_push ((node), _ce___); } while (0);
3566	CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], se.string_length)do { constructor_elt _ce___ = {ss_string2_len[k], se.string_length }; vec_safe_push ((node), _ce___); } while (0);
3567	}
3568
3569	CONSTRUCTOR_APPEND_ELT (node, ss_target[k],do { constructor_elt _ce___ = {ss_target[k], build_int_cst (integer_types [itk_int], d->n)}; vec_safe_push ((node), _ce___); } while (0)
3570	build_int_cst (integer_type_node, d->n))do { constructor_elt _ce___ = {ss_target[k], build_int_cst (integer_types [itk_int], d->n)}; vec_safe_push ((node), _ce___); } while (0);
3571
3572	tmp = build_constructor (select_struct[k], node);
3573	CONSTRUCTOR_APPEND_ELT (inits, NULL_TREE, tmp)do { constructor_elt _ce___ = {(tree) __null, tmp}; vec_safe_push ((inits), _ce___); } while (0);
3574	}
3575
3576	type = build_array_type (select_struct[k],
3577	build_index_type (size_int (n-1)size_int_kind (n-1, stk_sizetype)));
3578
3579	init = build_constructor (type, inits);
3580	TREE_CONSTANT (init)((non_type_check ((init), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3580, __FUNCTION__))->base.constant_flag) = 1;
3581	TREE_STATIC (init)((init)->base.static_flag) = 1;
3582	/* Create a static variable to hold the jump table. */
3583	tmp = gfc_create_var (type, "jumptable");
3584	TREE_CONSTANT (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3584, __FUNCTION__))->base.constant_flag) = 1;
3585	TREE_STATIC (tmp)((tmp)->base.static_flag) = 1;
3586	TREE_READONLY (tmp)((non_type_check ((tmp), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3586, __FUNCTION__))->base.readonly_flag) = 1;
3587	DECL_INITIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3587, __FUNCTION__))->decl_common.initial) = init;
3588	init = tmp;
3589
3590	/* Build the library call */
3591	init = gfc_build_addr_expr (pvoid_type_node, init);
3592
3593	if (code->expr1->ts.kind == 1)
3594	fndecl = gfor_fndecl_select_string;
3595	else if (code->expr1->ts.kind == 4)
3596	fndecl = gfor_fndecl_select_string_char4;
3597	else
3598	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3598, __FUNCTION__));
3599
3600	tmp = build_call_expr_loc (input_location,
3601	fndecl, 4, init,
3602	build_int_cst (gfc_charlen_type_node, n),
3603	expr1se.expr, expr1se.string_length);
3604	case_num = gfc_create_var (integer_type_nodeinteger_types[itk_int], "case_num");
3605	gfc_add_modify (&block, case_num, tmp);
3606
3607	gfc_add_block_to_block (&block, &expr1se.post);
3608
3609	tmp = gfc_finish_block (&body);
3610	tmp = fold_build2_loc (input_location, SWITCH_EXPR, NULL_TREE(tree) __null,
3611	case_num, tmp);
3612	gfc_add_expr_to_block (&block, tmp);
3613
3614	tmp = build1_v (LABEL_EXPR, end_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], end_label);
3615	gfc_add_expr_to_block (&block, tmp);
3616
3617	return gfc_finish_block (&block);
3618	}
3619
3620
3621	/* Translate the three variants of the SELECT CASE construct.
3622
3623	SELECT CASEs with INTEGER case expressions can be translated to an
3624	equivalent GENERIC switch statement, and for LOGICAL case
3625	expressions we build one or two if-else compares.
3626
3627	SELECT CASEs with CHARACTER case expressions are a whole different
3628	story, because they don't exist in GENERIC. So we sort them and
3629	do a binary search at runtime.
3630
3631	Fortran has no BREAK statement, and it does not allow jumps from
3632	one case block to another. That makes things a lot easier for
3633	the optimizers. */
3634
3635	tree
3636	gfc_trans_select (gfc_code * code)
3637	{
3638	stmtblock_t block;
3639	tree body;
3640	tree exit_label;
3641
3642	gcc_assert (code && code->expr1)((void)(!(code && code->expr1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3642, __FUNCTION__), 0 : 0));
3643	gfc_init_block (&block);
3644
3645	/* Build the exit label and hang it in. */
3646	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
3647	code->exit_label = exit_label;
3648
3649	/* Empty SELECT constructs are legal. */
3650	if (code->block == NULL__null)
3651	body = build_empty_stmt (input_location);
3652
3653	/* Select the correct translation function. */
3654	else
3655	switch (code->expr1->ts.type)
3656	{
3657	case BT_LOGICAL:
3658	body = gfc_trans_logical_select (code);
3659	break;
3660
3661	case BT_INTEGER:
3662	body = gfc_trans_integer_select (code);
3663	break;
3664
3665	case BT_CHARACTER:
3666	body = gfc_trans_character_select (code);
3667	break;
3668
3669	default:
3670	gfc_internal_error ("gfc_trans_select(): Bad type for case expr.");
3671	/* Not reached */
3672	}
3673
3674	/* Build everything together. */
3675	gfc_add_expr_to_block (&block, body);
3676	gfc_add_expr_to_block (&block, build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label));
3677
3678	return gfc_finish_block (&block);
3679	}
3680
3681	tree
3682	gfc_trans_select_type (gfc_code * code)
3683	{
3684	stmtblock_t block;
3685	tree body;
3686	tree exit_label;
3687
3688	gcc_assert (code && code->expr1)((void)(!(code && code->expr1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3688, __FUNCTION__), 0 : 0));
3689	gfc_init_block (&block);
3690
3691	/* Build the exit label and hang it in. */
3692	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
3693	code->exit_label = exit_label;
3694
3695	/* Empty SELECT constructs are legal. */
3696	if (code->block == NULL__null)
3697	body = build_empty_stmt (input_location);
3698	else
3699	body = gfc_trans_select_type_cases (code);
3700
3701	/* Build everything together. */
3702	gfc_add_expr_to_block (&block, body);
3703
3704	if (TREE_USED (exit_label)((exit_label)->base.used_flag))
3705	gfc_add_expr_to_block (&block, build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label));
3706
3707	return gfc_finish_block (&block);
3708	}
3709
3710
3711	static tree
3712	gfc_trans_select_rank_cases (gfc_code * code)
3713	{
3714	gfc_code *c;
3715	gfc_case *cp;
3716	tree tmp;
3717	tree cond;
3718	tree low;
3719	tree rank;
3720	gfc_se se;
3721	gfc_se cse;
3722	stmtblock_t block;
3723	stmtblock_t body;
3724	bool def = false;
3725
3726	gfc_start_block (&block);
3727
3728	/* Calculate the switch expression. */
3729	gfc_init_se (&se, NULL__null);
3730	gfc_conv_expr_descriptor (&se, code->expr1);
3731	rank = gfc_conv_descriptor_rank (se.expr);
3732	rank = gfc_evaluate_now (rank, &block);
3733	symbol_attribute attr = gfc_expr_attr (code->expr1);
3734	if (!attr.pointer && !attr.allocatable)
3735	{
3736	/* Special case for assumed-rank ('rank(*)', internally -1):
3737	rank = (rank == 0 \|\| ubound[rank-1] != -1) ? rank : -1. */
3738	cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
3739	rank, build_int_cst (TREE_TYPE (rank)((contains_struct_check ((rank), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3739, __FUNCTION__))->typed.type), 0));
3740	tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
3741	fold_convert (gfc_array_index_type, rank)fold_convert_loc (((location_t) 0), gfc_array_index_type, rank ),
3742	gfc_index_one_nodegfc_rank_cst[1]);
3743	tmp = gfc_conv_descriptor_ubound_get (se.expr, tmp);
3744	tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
3745	tmp, build_int_cst (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3745, __FUNCTION__))->typed.type), -1));
3746	cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
3747	logical_type_node, cond, tmp);
3748	tmp = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (rank)((contains_struct_check ((rank), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3748, __FUNCTION__))->typed.type),
3749	cond, rank, build_int_cst (TREE_TYPE (rank)((contains_struct_check ((rank), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3749, __FUNCTION__))->typed.type), -1));
3750	rank = gfc_evaluate_now (tmp, &block);
3751	}
3752	TREE_USED (code->exit_label)((code->exit_label)->base.used_flag) = 0;
3753
3754	repeat:
3755	for (c = code->block; c; c = c->block)
3756	{
3757	cp = c->ext.block.case_list;
3758
3759	/* Assume it's the default case. */
3760	low = NULL_TREE(tree) __null;
3761	tmp = NULL_TREE(tree) __null;
3762
3763	/* Put the default case at the end. */
3764	if ((!def && !cp->low) \|\| (def && cp->low))
3765	continue;
3766
3767	if (cp->low)
3768	{
3769	gfc_init_se (&cse, NULL__null);
3770	gfc_conv_expr_val (&cse, cp->low);
3771	gfc_add_block_to_block (&block, &cse.pre);
3772	low = cse.expr;
3773	}
3774
3775	gfc_init_block (&body);
3776
3777	/* Add the statements for this case. */
3778	tmp = gfc_trans_code (c->next);
3779	gfc_add_expr_to_block (&body, tmp);
3780
3781	/* Break to the end of the SELECT RANK construct. The default
3782	case just falls through. */
3783	if (!def)
3784	{
3785	TREE_USED (code->exit_label)((code->exit_label)->base.used_flag) = 1;
3786	tmp = build1_v (GOTO_EXPR, code->exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], code->exit_label);
3787	gfc_add_expr_to_block (&body, tmp);
3788	}
3789
3790	tmp = gfc_finish_block (&body);
3791
3792	if (low != NULL_TREE(tree) __null)
3793	{
3794	cond = fold_build2_loc (input_location, EQ_EXPR,
3795	TREE_TYPE (rank)((contains_struct_check ((rank), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3795, __FUNCTION__))->typed.type), rank,
3796	fold_convert (TREE_TYPE (rank), low)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (rank), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3796, __FUNCTION__))->typed.type), low));
3797	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
3798	cond, tmp,
3799	build_empty_stmt (input_location));
3800	}
3801
3802	gfc_add_expr_to_block (&block, tmp);
3803	}
3804
3805	if (!def)
3806	{
3807	def = true;
3808	goto repeat;
3809	}
3810
3811	return gfc_finish_block (&block);
3812	}
3813
3814
3815	tree
3816	gfc_trans_select_rank (gfc_code * code)
3817	{
3818	stmtblock_t block;
3819	tree body;
3820	tree exit_label;
3821
3822	gcc_assert (code && code->expr1)((void)(!(code && code->expr1) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3822, __FUNCTION__), 0 : 0));
3823	gfc_init_block (&block);
3824
3825	/* Build the exit label and hang it in. */
3826	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
3827	code->exit_label = exit_label;
3828
3829	/* Empty SELECT constructs are legal. */
3830	if (code->block == NULL__null)
3831	body = build_empty_stmt (input_location);
3832	else
3833	body = gfc_trans_select_rank_cases (code);
3834
3835	/* Build everything together. */
3836	gfc_add_expr_to_block (&block, body);
3837
3838	if (TREE_USED (exit_label)((exit_label)->base.used_flag))
3839	gfc_add_expr_to_block (&block, build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label));
3840
3841	return gfc_finish_block (&block);
3842	}
3843
3844
3845	/* Traversal function to substitute a replacement symtree if the symbol
3846	in the expression is the same as that passed. f == 2 signals that
3847	that variable itself is not to be checked - only the references.
3848	This group of functions is used when the variable expression in a
3849	FORALL assignment has internal references. For example:
3850	FORALL (i = 1:4) p(p(i)) = i
3851	The only recourse here is to store a copy of 'p' for the index
3852	expression. */
3853
3854	static gfc_symtree *new_symtree;
3855	static gfc_symtree *old_symtree;
3856
3857	static bool
3858	forall_replace (gfc_expr expr, gfc_symbol sym, int *f)
3859	{
3860	if (expr->expr_type != EXPR_VARIABLE)
3861	return false;
3862
3863	if (*f == 2)
3864	*f = 1;
3865	else if (expr->symtree->n.sym == sym)
3866	expr->symtree = new_symtree;
3867
3868	return false;
3869	}
3870
3871	static void
3872	forall_replace_symtree (gfc_expr e, gfc_symbol sym, int f)
3873	{
3874	gfc_traverse_expr (e, sym, forall_replace, f);
3875	}
3876
3877	static bool
3878	forall_restore (gfc_expr *expr,
3879	gfc_symbol *sym ATTRIBUTE_UNUSED__attribute__ ((__unused__)),
3880	int *f ATTRIBUTE_UNUSED__attribute__ ((__unused__)))
3881	{
3882	if (expr->expr_type != EXPR_VARIABLE)
3883	return false;
3884
3885	if (expr->symtree == new_symtree)
3886	expr->symtree = old_symtree;
3887
3888	return false;
3889	}
3890
3891	static void
3892	forall_restore_symtree (gfc_expr *e)
3893	{
3894	gfc_traverse_expr (e, NULL__null, forall_restore, 0);
3895	}
3896
3897	static void
3898	forall_make_variable_temp (gfc_code c, stmtblock_t pre, stmtblock_t *post)
3899	{
3900	gfc_se tse;
3901	gfc_se rse;
3902	gfc_expr *e;
3903	gfc_symbol *new_sym;
3904	gfc_symbol *old_sym;
3905	gfc_symtree *root;
3906	tree tmp;
3907
3908	/* Build a copy of the lvalue. */
3909	old_symtree = c->expr1->symtree;
3910	old_sym = old_symtree->n.sym;
3911	e = gfc_lval_expr_from_sym (old_sym);
3912	if (old_sym->attr.dimension)
3913	{
3914	gfc_init_se (&tse, NULL__null);
3915	gfc_conv_subref_array_arg (&tse, e, 0, INTENT_IN, false);
3916	gfc_add_block_to_block (pre, &tse.pre);
3917	gfc_add_block_to_block (post, &tse.post);
3918	tse.expr = build_fold_indirect_ref_loc (input_location, tse.expr);
3919
3920	if (c->expr1->ref->u.ar.type != AR_SECTION)
3921	{
3922	/* Use the variable offset for the temporary. */
3923	tmp = gfc_conv_array_offset (old_sym->backend_decl);
3924	gfc_conv_descriptor_offset_set (pre, tse.expr, tmp);
3925	}
3926	}
3927	else
3928	{
3929	gfc_init_se (&tse, NULL__null);
3930	gfc_init_se (&rse, NULL__null);
3931	gfc_conv_expr (&rse, e);
3932	if (e->ts.type == BT_CHARACTER)
3933	{
3934	tse.string_length = rse.string_length;
3935	tmp = gfc_get_character_type_len (gfc_default_character_kind,
3936	tse.string_length);
3937	tse.expr = gfc_conv_string_tmp (&tse, build_pointer_type (tmp),
3938	rse.string_length);
3939	gfc_add_block_to_block (pre, &tse.pre);
3940	gfc_add_block_to_block (post, &tse.post);
3941	}
3942	else
3943	{
3944	tmp = gfc_typenode_for_spec (&e->ts);
3945	tse.expr = gfc_create_var (tmp, "temp");
3946	}
3947
3948	tmp = gfc_trans_scalar_assign (&tse, &rse, e->ts,
3949	e->expr_type == EXPR_VARIABLE, false);
3950	gfc_add_expr_to_block (pre, tmp);
3951	}
3952	gfc_free_expr (e);
3953
3954	/* Create a new symbol to represent the lvalue. */
3955	new_sym = gfc_new_symbol (old_sym->name, NULL__null);
3956	new_sym->ts = old_sym->ts;
3957	new_sym->attr.referenced = 1;
3958	new_sym->attr.temporary = 1;
3959	new_sym->attr.dimension = old_sym->attr.dimension;
3960	new_sym->attr.flavor = old_sym->attr.flavor;
3961
3962	/* Use the temporary as the backend_decl. */
3963	new_sym->backend_decl = tse.expr;
3964
3965	/* Create a fake symtree for it. */
3966	root = NULL__null;
3967	new_symtree = gfc_new_symtree (&root, old_sym->name);
3968	new_symtree->n.sym = new_sym;
3969	gcc_assert (new_symtree == root)((void)(!(new_symtree == root) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 3969, __FUNCTION__), 0 : 0));
3970
3971	/* Go through the expression reference replacing the old_symtree
3972	with the new. */
3973	forall_replace_symtree (c->expr1, old_sym, 2);
3974
3975	/* Now we have made this temporary, we might as well use it for
3976	the right hand side. */
3977	forall_replace_symtree (c->expr2, old_sym, 1);
3978	}
3979
3980
3981	/* Handles dependencies in forall assignments. */
3982	static int
3983	check_forall_dependencies (gfc_code c, stmtblock_t pre, stmtblock_t *post)
3984	{
3985	gfc_ref *lref;
3986	gfc_ref *rref;
3987	int need_temp;
3988	gfc_symbol *lsym;
3989
3990	lsym = c->expr1->symtree->n.sym;
3991	need_temp = gfc_check_dependency (c->expr1, c->expr2, 0);
3992
3993	/* Now check for dependencies within the 'variable'
3994	expression itself. These are treated by making a complete
3995	copy of variable and changing all the references to it
3996	point to the copy instead. Note that the shallow copy of
3997	the variable will not suffice for derived types with
3998	pointer components. We therefore leave these to their
3999	own devices. Likewise for allocatable components. */
4000	if (lsym->ts.type == BT_DERIVED
4001	&& (lsym->ts.u.derived->attr.pointer_comp
4002	\|\| lsym->ts.u.derived->attr.alloc_comp))
4003	return need_temp;
4004
4005	new_symtree = NULL__null;
4006	if (find_forall_index (c->expr1, lsym, 2))
4007	{
4008	forall_make_variable_temp (c, pre, post);
4009	need_temp = 0;
4010	}
4011
4012	/* Substrings with dependencies are treated in the same
4013	way. */
4014	if (c->expr1->ts.type == BT_CHARACTER
4015	&& c->expr1->ref
4016	&& c->expr2->expr_type == EXPR_VARIABLE
4017	&& lsym == c->expr2->symtree->n.sym)
4018	{
4019	for (lref = c->expr1->ref; lref; lref = lref->next)
4020	if (lref->type == REF_SUBSTRING)
4021	break;
4022	for (rref = c->expr2->ref; rref; rref = rref->next)
4023	if (rref->type == REF_SUBSTRING)
4024	break;
4025
4026	if (rref && lref
4027	&& gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start) < 0)
4028	{
4029	forall_make_variable_temp (c, pre, post);
4030	need_temp = 0;
4031	}
4032	}
4033	return need_temp;
4034	}
4035
4036
4037	static void
4038	cleanup_forall_symtrees (gfc_code *c)
4039	{
4040	forall_restore_symtree (c->expr1);
4041	forall_restore_symtree (c->expr2);
4042	free (new_symtree->n.sym);
4043	free (new_symtree);
4044	}
4045
4046
4047	/* Generate the loops for a FORALL block, specified by FORALL_TMP. BODY
4048	is the contents of the FORALL block/stmt to be iterated. MASK_FLAG
4049	indicates whether we should generate code to test the FORALLs mask
4050	array. OUTER is the loop header to be used for initializing mask
4051	indices.
4052
4053	The generated loop format is:
4054	count = (end - start + step) / step
4055	loopvar = start
4056	while (1)
4057	{
4058	if (count <=0 )
4059	goto end_of_loop
4060	<body>
4061	loopvar += step
4062	count --
4063	}
4064	end_of_loop: */
4065
4066	static tree
4067	gfc_trans_forall_loop (forall_info *forall_tmp, tree body,
4068	int mask_flag, stmtblock_t *outer)
4069	{
4070	int n, nvar;
4071	tree tmp;
4072	tree cond;
4073	stmtblock_t block;
4074	tree exit_label;
4075	tree count;
4076	tree var, start, end, step;
4077	iter_info *iter;
4078
4079	/* Initialize the mask index outside the FORALL nest. */
4080	if (mask_flag && forall_tmp->mask)
4081	gfc_add_modify (outer, forall_tmp->maskindex, gfc_index_zero_nodegfc_rank_cst[0]);
4082
4083	iter = forall_tmp->this_loop;
4084	nvar = forall_tmp->nvar;
4085	for (n = 0; n < nvar; n++)
4086	{
4087	var = iter->var;
4088	start = iter->start;
4089	end = iter->end;
4090	step = iter->step;
4091
4092	exit_label = gfc_build_label_decl (NULL_TREE(tree) __null);
4093	TREE_USED (exit_label)((exit_label)->base.used_flag) = 1;
4094
4095	/* The loop counter. */
4096	count = gfc_create_var (TREE_TYPE (var)((contains_struct_check ((var), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4096, __FUNCTION__))->typed.type), "count");
4097
4098	/* The body of the loop. */
4099	gfc_init_block (&block);
4100
4101	/* The exit condition. */
4102	cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
4103	count, build_int_cst (TREE_TYPE (count)((contains_struct_check ((count), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4103, __FUNCTION__))->typed.type), 0));
4104
4105	/* PR 83064 means that we cannot use annot_expr_parallel_kind until
4106	the autoparallelizer can hande this. */
4107	if (forall_tmp->do_concurrent)
4108	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond)((contains_struct_check ((cond), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4108, __FUNCTION__))->typed.type), cond,
4109	build_int_cst (integer_type_nodeinteger_types[itk_int],
4110	annot_expr_ivdep_kind),
4111	integer_zero_nodeglobal_trees[TI_INTEGER_ZERO]);
4112
4113	tmp = build1_v (GOTO_EXPR, exit_label)fold_build1_loc (input_location, GOTO_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
4114	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
4115	cond, tmp, build_empty_stmt (input_location));
4116	gfc_add_expr_to_block (&block, tmp);
4117
4118	/* The main loop body. */
4119	gfc_add_expr_to_block (&block, body);
4120
4121	/* Increment the loop variable. */
4122	tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (var)((contains_struct_check ((var), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4122, __FUNCTION__))->typed.type), var,
4123	step);
4124	gfc_add_modify (&block, var, tmp);
4125
4126	/* Advance to the next mask element. Only do this for the
4127	innermost loop. */
4128	if (n == 0 && mask_flag && forall_tmp->mask)
4129	{
4130	tree maskindex = forall_tmp->maskindex;
4131	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4132	maskindex, gfc_index_one_nodegfc_rank_cst[1]);
4133	gfc_add_modify (&block, maskindex, tmp);
4134	}
4135
4136	/* Decrement the loop counter. */
4137	tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (var)((contains_struct_check ((var), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4137, __FUNCTION__))->typed.type), count,
4138	build_int_cst (TREE_TYPE (var)((contains_struct_check ((var), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4138, __FUNCTION__))->typed.type), 1));
4139	gfc_add_modify (&block, count, tmp);
4140
4141	body = gfc_finish_block (&block);
4142
4143	/* Loop var initialization. */
4144	gfc_init_block (&block);
4145	gfc_add_modify (&block, var, start);
4146
4147
4148	/* Initialize the loop counter. */
4149	tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (var)((contains_struct_check ((var), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4149, __FUNCTION__))->typed.type), step,
4150	start);
4151	tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (var)((contains_struct_check ((var), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4151, __FUNCTION__))->typed.type), end,
4152	tmp);
4153	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, TREE_TYPE (var)((contains_struct_check ((var), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4153, __FUNCTION__))->typed.type),
4154	tmp, step);
4155	gfc_add_modify (&block, count, tmp);
4156
4157	/* The loop expression. */
4158	tmp = build1_v (LOOP_EXPR, body)fold_build1_loc (input_location, LOOP_EXPR, global_trees[TI_VOID_TYPE ], body);
4159	gfc_add_expr_to_block (&block, tmp);
4160
4161	/* The exit label. */
4162	tmp = build1_v (LABEL_EXPR, exit_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], exit_label);
4163	gfc_add_expr_to_block (&block, tmp);
4164
4165	body = gfc_finish_block (&block);
4166	iter = iter->next;
4167	}
4168	return body;
4169	}
4170
4171
4172	/* Generate the body and loops according to MASK_FLAG. If MASK_FLAG
4173	is nonzero, the body is controlled by all masks in the forall nest.
4174	Otherwise, the innermost loop is not controlled by it's mask. This
4175	is used for initializing that mask. */
4176
4177	static tree
4178	gfc_trans_nested_forall_loop (forall_info * nested_forall_info, tree body,
4179	int mask_flag)
4180	{
4181	tree tmp;
4182	stmtblock_t header;
4183	forall_info *forall_tmp;
4184	tree mask, maskindex;
4185
4186	gfc_start_block (&header);
4187
4188	forall_tmp = nested_forall_info;
4189	while (forall_tmp != NULL__null)
4190	{
4191	/* Generate body with masks' control. */
4192	if (mask_flag)
4193	{
4194	mask = forall_tmp->mask;
4195	maskindex = forall_tmp->maskindex;
4196
4197	/* If a mask was specified make the assignment conditional. */
4198	if (mask)
4199	{
4200	tmp = gfc_build_array_ref (mask, maskindex, NULL__null);
4201	body = build3_v (COND_EXPR, tmp, body,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], tmp, body, build_empty_stmt (input_location))
4202	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], tmp, body, build_empty_stmt (input_location));
4203	}
4204	}
4205	body = gfc_trans_forall_loop (forall_tmp, body, mask_flag, &header);
4206	forall_tmp = forall_tmp->prev_nest;
4207	mask_flag = 1;
4208	}
4209
4210	gfc_add_expr_to_block (&header, body);
4211	return gfc_finish_block (&header);
4212	}
4213
4214
4215	/* Allocate data for holding a temporary array. Returns either a local
4216	temporary array or a pointer variable. */
4217
4218	static tree
4219	gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
4220	tree elem_type)
4221	{
4222	tree tmpvar;
4223	tree type;
4224	tree tmp;
4225
4226	if (INTEGER_CST_P (size)(((enum tree_code) (size)->base.code) == INTEGER_CST))
4227	tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
4228	size, gfc_index_one_nodegfc_rank_cst[1]);
4229	else
4230	tmp = NULL_TREE(tree) __null;
4231
4232	type = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0], tmp);
4233	type = build_array_type (elem_type, type);
4234	if (gfc_can_put_var_on_stack (bytesize) && INTEGER_CST_P (size)(((enum tree_code) (size)->base.code) == INTEGER_CST))
4235	{
4236	tmpvar = gfc_create_var (type, "temp");
4237	*pdata = NULL_TREE(tree) __null;
4238	}
4239	else
4240	{
4241	tmpvar = gfc_create_var (build_pointer_type (type), "temp");
4242	*pdata = convert (pvoid_type_node, tmpvar);
4243
4244	tmp = gfc_call_malloc (pblock, TREE_TYPE (tmpvar)((contains_struct_check ((tmpvar), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4244, __FUNCTION__))->typed.type), bytesize);
4245	gfc_add_modify (pblock, tmpvar, tmp);
4246	}
4247	return tmpvar;
4248	}
4249
4250
4251	/* Generate codes to copy the temporary to the actual lhs. */
4252
4253	static tree
4254	generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
4255	tree count1,
4256	gfc_ss lss, gfc_ss rss,
4257	tree wheremask, bool invert)
4258	{
4259	stmtblock_t block, body1;
4260	gfc_loopinfo loop;
4261	gfc_se lse;
4262	gfc_se rse;
4263	tree tmp;
4264	tree wheremaskexpr;
4265
4266	(void) rss; /* TODO: unused. */
4267
4268	gfc_start_block (&block);
4269
4270	gfc_init_se (&rse, NULL__null);
4271	gfc_init_se (&lse, NULL__null);
4272
4273	if (lss == gfc_ss_terminator)
4274	{
4275	gfc_init_block (&body1);
4276	gfc_conv_expr (&lse, expr);
4277	rse.expr = gfc_build_array_ref (tmp1, count1, NULL__null);
4278	}
4279	else
4280	{
4281	/* Initialize the loop. */
4282	gfc_init_loopinfo (&loop);
4283
4284	/* We may need LSS to determine the shape of the expression. */
4285	gfc_add_ss_to_loop (&loop, lss);
4286
4287	gfc_conv_ss_startstride (&loop);
4288	gfc_conv_loop_setup (&loop, &expr->where);
4289
4290	gfc_mark_ss_chain_used (lss, 1);
4291	/* Start the loop body. */
4292	gfc_start_scalarized_body (&loop, &body1);
4293
4294	/* Translate the expression. */
4295	gfc_copy_loopinfo_to_se (&lse, &loop);
4296	lse.ss = lss;
4297	gfc_conv_expr (&lse, expr);
4298
4299	/* Form the expression of the temporary. */
4300	rse.expr = gfc_build_array_ref (tmp1, count1, NULL__null);
4301	}
4302
4303	/* Use the scalar assignment. */
4304	rse.string_length = lse.string_length;
4305	tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts,
4306	expr->expr_type == EXPR_VARIABLE, false);
4307
4308	/* Form the mask expression according to the mask tree list. */
4309	if (wheremask)
4310	{
4311	wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL__null);
4312	if (invert)
4313	wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
4314	TREE_TYPE (wheremaskexpr)((contains_struct_check ((wheremaskexpr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4314, __FUNCTION__))->typed.type),
4315	wheremaskexpr);
4316	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
4317	wheremaskexpr, tmp,
4318	build_empty_stmt (input_location));
4319	}
4320
4321	gfc_add_expr_to_block (&body1, tmp);
4322
4323	tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (count1)((contains_struct_check ((count1), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4323, __FUNCTION__))->typed.type),
4324	count1, gfc_index_one_nodegfc_rank_cst[1]);
4325	gfc_add_modify (&body1, count1, tmp);
4326
4327	if (lss == gfc_ss_terminator)
4328	gfc_add_block_to_block (&block, &body1);
4329	else
4330	{
4331	/* Increment count3. */
4332	if (count3)
4333	{
4334	tmp = fold_build2_loc (input_location, PLUS_EXPR,
4335	gfc_array_index_type,
4336	count3, gfc_index_one_nodegfc_rank_cst[1]);
4337	gfc_add_modify (&body1, count3, tmp);
4338	}
4339
4340	/* Generate the copying loops. */
4341	gfc_trans_scalarizing_loops (&loop, &body1);
4342
4343	gfc_add_block_to_block (&block, &loop.pre);
4344	gfc_add_block_to_block (&block, &loop.post);
4345
4346	gfc_cleanup_loop (&loop);
4347	/* TODO: Reuse lss and rss when copying temp->lhs. Need to be careful
4348	as tree nodes in SS may not be valid in different scope. */
4349	}
4350
4351	tmp = gfc_finish_block (&block);
4352	return tmp;
4353	}
4354
4355
4356	/* Generate codes to copy rhs to the temporary. TMP1 is the address of
4357	temporary, LSS and RSS are formed in function compute_inner_temp_size(),
4358	and should not be freed. WHEREMASK is the conditional execution mask
4359	whose sense may be inverted by INVERT. */
4360
4361	static tree
4362	generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
4363	tree count1, gfc_ss lss, gfc_ss rss,
4364	tree wheremask, bool invert)
4365	{
4366	stmtblock_t block, body1;
4367	gfc_loopinfo loop;
4368	gfc_se lse;
4369	gfc_se rse;
4370	tree tmp;
4371	tree wheremaskexpr;
4372
4373	gfc_start_block (&block);
4374
4375	gfc_init_se (&rse, NULL__null);
4376	gfc_init_se (&lse, NULL__null);
4377
4378	if (lss == gfc_ss_terminator)
4379	{
4380	gfc_init_block (&body1);
4381	gfc_conv_expr (&rse, expr2);
4382	lse.expr = gfc_build_array_ref (tmp1, count1, NULL__null);
4383	}
4384	else
4385	{
4386	/* Initialize the loop. */
4387	gfc_init_loopinfo (&loop);
4388
4389	/* We may need LSS to determine the shape of the expression. */
4390	gfc_add_ss_to_loop (&loop, lss);
4391	gfc_add_ss_to_loop (&loop, rss);
4392
4393	gfc_conv_ss_startstride (&loop);
4394	gfc_conv_loop_setup (&loop, &expr2->where);
4395
4396	gfc_mark_ss_chain_used (rss, 1);
4397	/* Start the loop body. */
4398	gfc_start_scalarized_body (&loop, &body1);
4399
4400	/* Translate the expression. */
4401	gfc_copy_loopinfo_to_se (&rse, &loop);
4402	rse.ss = rss;
4403	gfc_conv_expr (&rse, expr2);
4404
4405	/* Form the expression of the temporary. */
4406	lse.expr = gfc_build_array_ref (tmp1, count1, NULL__null);
4407	}
4408
4409	/* Use the scalar assignment. */
4410	lse.string_length = rse.string_length;
4411	tmp = gfc_trans_scalar_assign (&lse, &rse, expr2->ts,
4412	expr2->expr_type == EXPR_VARIABLE, false);
4413
4414	/* Form the mask expression according to the mask tree list. */
4415	if (wheremask)
4416	{
4417	wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL__null);
4418	if (invert)
4419	wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
4420	TREE_TYPE (wheremaskexpr)((contains_struct_check ((wheremaskexpr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4420, __FUNCTION__))->typed.type),
4421	wheremaskexpr);
4422	tmp = fold_build3_loc (input_location, COND_EXPR, void_type_nodeglobal_trees[TI_VOID_TYPE],
4423	wheremaskexpr, tmp,
4424	build_empty_stmt (input_location));
4425	}
4426
4427	gfc_add_expr_to_block (&body1, tmp);
4428
4429	if (lss == gfc_ss_terminator)
4430	{
4431	gfc_add_block_to_block (&block, &body1);
4432
4433	/* Increment count1. */
4434	tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (count1)((contains_struct_check ((count1), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4434, __FUNCTION__))->typed.type),
4435	count1, gfc_index_one_nodegfc_rank_cst[1]);
4436	gfc_add_modify (&block, count1, tmp);
4437	}
4438	else
4439	{
4440	/* Increment count1. */
4441	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4442	count1, gfc_index_one_nodegfc_rank_cst[1]);
4443	gfc_add_modify (&body1, count1, tmp);
4444
4445	/* Increment count3. */
4446	if (count3)
4447	{
4448	tmp = fold_build2_loc (input_location, PLUS_EXPR,
4449	gfc_array_index_type,
4450	count3, gfc_index_one_nodegfc_rank_cst[1]);
4451	gfc_add_modify (&body1, count3, tmp);
4452	}
4453
4454	/* Generate the copying loops. */
4455	gfc_trans_scalarizing_loops (&loop, &body1);
4456
4457	gfc_add_block_to_block (&block, &loop.pre);
4458	gfc_add_block_to_block (&block, &loop.post);
4459
4460	gfc_cleanup_loop (&loop);
4461	/* TODO: Reuse lss and rss when copying temp->lhs. Need to be careful
4462	as tree nodes in SS may not be valid in different scope. */
4463	}
4464
4465	tmp = gfc_finish_block (&block);
4466	return tmp;
4467	}
4468
4469
4470	/* Calculate the size of temporary needed in the assignment inside forall.
4471	LSS and RSS are filled in this function. */
4472
4473	static tree
4474	compute_inner_temp_size (gfc_expr expr1, gfc_expr expr2,
4475	stmtblock_t * pblock,
4476	gfc_ss lss, gfc_ss rss)
4477	{
4478	gfc_loopinfo loop;
4479	tree size;
4480	int i;
4481	int save_flag;
4482	tree tmp;
4483
4484	*lss = gfc_walk_expr (expr1);
4485	*rss = NULL__null;
4486
4487	size = gfc_index_one_nodegfc_rank_cst[1];
4488	if (*lss != gfc_ss_terminator)
4489	{
4490	gfc_init_loopinfo (&loop);
4491
4492	/* Walk the RHS of the expression. */
4493	*rss = gfc_walk_expr (expr2);
4494	if (*rss == gfc_ss_terminator)
4495	/* The rhs is scalar. Add a ss for the expression. */
4496	*rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
4497
4498	/* Associate the SS with the loop. */
4499	gfc_add_ss_to_loop (&loop, *lss);
4500	/* We don't actually need to add the rhs at this point, but it might
4501	make guessing the loop bounds a bit easier. */
4502	gfc_add_ss_to_loop (&loop, *rss);
4503
4504	/* We only want the shape of the expression, not rest of the junk
4505	generated by the scalarizer. */
4506	loop.array_parameter = 1;
4507
4508	/* Calculate the bounds of the scalarization. */
4509	save_flag = gfc_option.rtcheck;
4510	gfc_option.rtcheck &= ~GFC_RTCHECK_BOUNDS(1<<0);
4511	gfc_conv_ss_startstride (&loop);
4512	gfc_option.rtcheck = save_flag;
4513	gfc_conv_loop_setup (&loop, &expr2->where);
4514
4515	/* Figure out how many elements we need. */
4516	for (i = 0; i < loop.dimen; i++)
4517	{
4518	tmp = fold_build2_loc (input_location, MINUS_EXPR,
4519	gfc_array_index_type,
4520	gfc_index_one_nodegfc_rank_cst[1], loop.from[i]);
4521	tmp = fold_build2_loc (input_location, PLUS_EXPR,
4522	gfc_array_index_type, tmp, loop.to[i]);
4523	size = fold_build2_loc (input_location, MULT_EXPR,
4524	gfc_array_index_type, size, tmp);
4525	}
4526	gfc_add_block_to_block (pblock, &loop.pre);
4527	size = gfc_evaluate_now (size, pblock);
4528	gfc_add_block_to_block (pblock, &loop.post);
4529
4530	/* TODO: write a function that cleans up a loopinfo without freeing
4531	the SS chains. Currently a NOP. */
4532	}
4533
4534	return size;
4535	}
4536
4537
4538	/* Calculate the overall iterator number of the nested forall construct.
4539	This routine actually calculates the number of times the body of the
4540	nested forall specified by NESTED_FORALL_INFO is executed and multiplies
4541	that by the expression INNER_SIZE. The BLOCK argument specifies the
4542	block in which to calculate the result, and the optional INNER_SIZE_BODY
4543	argument contains any statements that need to executed (inside the loop)
4544	to initialize or calculate INNER_SIZE. */
4545
4546	static tree
4547	compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
4548	stmtblock_t inner_size_body, stmtblock_t block)
4549	{
4550	forall_info *forall_tmp = nested_forall_info;
4551	tree tmp, number;
4552	stmtblock_t body;
4553
4554	/* We can eliminate the innermost unconditional loops with constant
4555	array bounds. */
4556	if (INTEGER_CST_P (inner_size)(((enum tree_code) (inner_size)->base.code) == INTEGER_CST ))
4557	{
4558	while (forall_tmp
4559	&& !forall_tmp->mask
4560	&& INTEGER_CST_P (forall_tmp->size)(((enum tree_code) (forall_tmp->size)->base.code) == INTEGER_CST ))
4561	{
4562	inner_size = fold_build2_loc (input_location, MULT_EXPR,
4563	gfc_array_index_type,
4564	inner_size, forall_tmp->size);
4565	forall_tmp = forall_tmp->prev_nest;
4566	}
4567
4568	/* If there are no loops left, we have our constant result. */
4569	if (!forall_tmp)
4570	return inner_size;
4571	}
4572
4573	/* Otherwise, create a temporary variable to compute the result. */
4574	number = gfc_create_var (gfc_array_index_type, "num");
4575	gfc_add_modify (block, number, gfc_index_zero_nodegfc_rank_cst[0]);
4576
4577	gfc_start_block (&body);
4578	if (inner_size_body)
4579	gfc_add_block_to_block (&body, inner_size_body);
4580	if (forall_tmp)
4581	tmp = fold_build2_loc (input_location, PLUS_EXPR,
4582	gfc_array_index_type, number, inner_size);
4583	else
4584	tmp = inner_size;
4585	gfc_add_modify (&body, number, tmp);
4586	tmp = gfc_finish_block (&body);
4587
4588	/* Generate loops. */
4589	if (forall_tmp != NULL__null)
4590	tmp = gfc_trans_nested_forall_loop (forall_tmp, tmp, 1);
4591
4592	gfc_add_expr_to_block (block, tmp);
4593
4594	return number;
4595	}
4596
4597
4598	/* Allocate temporary for forall construct. SIZE is the size of temporary
4599	needed. PTEMP1 is returned for space free. */
4600
4601	static tree
4602	allocate_temp_for_forall_nest_1 (tree type, tree size, stmtblock_t * block,
4603	tree * ptemp1)
4604	{
4605	tree bytesize;
4606	tree unit;
4607	tree tmp;
4608
4609	unit = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (type))fold_convert_loc (((location_t) 0), gfc_array_index_type, ((tree_class_check ((type), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4609, __FUNCTION__))->type_common.size_unit));
4610	if (!integer_onep (unit))
4611	bytesize = fold_build2_loc (input_location, MULT_EXPR,
4612	gfc_array_index_type, size, unit);
4613	else
4614	bytesize = size;
4615
4616	*ptemp1 = NULL__null;
4617	tmp = gfc_do_allocate (bytesize, size, ptemp1, block, type);
4618
4619	if (*ptemp1)
4620	tmp = build_fold_indirect_ref_loc (input_location, tmp);
4621	return tmp;
4622	}
4623
4624
4625	/* Allocate temporary for forall construct according to the information in
4626	nested_forall_info. INNER_SIZE is the size of temporary needed in the
4627	assignment inside forall. PTEMP1 is returned for space free. */
4628
4629	static tree
4630	allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type,
4631	tree inner_size, stmtblock_t * inner_size_body,
4632	stmtblock_t * block, tree * ptemp1)
4633	{
4634	tree size;
4635
4636	/* Calculate the total size of temporary needed in forall construct. */
4637	size = compute_overall_iter_number (nested_forall_info, inner_size,
4638	inner_size_body, block);
4639
4640	return allocate_temp_for_forall_nest_1 (type, size, block, ptemp1);
4641	}
4642
4643
4644	/* Handle assignments inside forall which need temporary.
4645
4646	forall (i=start:end:stride; maskexpr)
4647	e<i> = f<i>
4648	end forall
4649	(where e,f<i> are arbitrary expressions possibly involving i
4650	and there is a dependency between e<i> and f<i>)
4651	Translates to:
4652	masktmp(:) = maskexpr(:)
4653
4654	maskindex = 0;
4655	count1 = 0;
4656	num = 0;
4657	for (i = start; i <= end; i += stride)
4658	num += SIZE (f<i>)
4659	count1 = 0;
4660	ALLOCATE (tmp(num))
4661	for (i = start; i <= end; i += stride)
4662	{
4663	if (masktmp[maskindex++])
4664	tmp[count1++] = f<i>
4665	}
4666	maskindex = 0;
4667	count1 = 0;
4668	for (i = start; i <= end; i += stride)
4669	{
4670	if (masktmp[maskindex++])
4671	e<i> = tmp[count1++]
4672	}
4673	DEALLOCATE (tmp)
4674	*/
4675	static void
4676	gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
4677	tree wheremask, bool invert,
4678	forall_info * nested_forall_info,
4679	stmtblock_t * block)
4680	{
4681	tree type;
4682	tree inner_size;
4683	gfc_ss lss, rss;
4684	tree count, count1;
4685	tree tmp, tmp1;
4686	tree ptemp1;
4687	stmtblock_t inner_size_body;
4688
4689	/* Create vars. count1 is the current iterator number of the nested
4690	forall. */
4691	count1 = gfc_create_var (gfc_array_index_type, "count1");
4692
4693	/* Count is the wheremask index. */
4694	if (wheremask)
4695	{
4696	count = gfc_create_var (gfc_array_index_type, "count");
4697	gfc_add_modify (block, count, gfc_index_zero_nodegfc_rank_cst[0]);
4698	}
4699	else
4700	count = NULL__null;
4701
4702	/* Initialize count1. */
4703	gfc_add_modify (block, count1, gfc_index_zero_nodegfc_rank_cst[0]);
4704
4705	/* Calculate the size of temporary needed in the assignment. Return loop, lss
4706	and rss which are used in function generate_loop_for_rhs_to_temp(). */
4707	/* The type of LHS. Used in function allocate_temp_for_forall_nest */
4708	if (expr1->ts.type == BT_CHARACTER)
4709	{
4710	type = NULL__null;
4711	if (expr1->ref && expr1->ref->type == REF_SUBSTRING)
4712	{
4713	gfc_se ssse;
4714	gfc_init_se (&ssse, NULL__null);
4715	gfc_conv_expr (&ssse, expr1);
4716	type = gfc_get_character_type_len (gfc_default_character_kind,
4717	ssse.string_length);
4718	}
4719	else
4720	{
4721	if (!expr1->ts.u.cl->backend_decl)
4722	{
4723	gfc_se tse;
4724	gcc_assert (expr1->ts.u.cl->length)((void)(!(expr1->ts.u.cl->length) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4724, __FUNCTION__), 0 : 0));
4725	gfc_init_se (&tse, NULL__null);
4726	gfc_conv_expr (&tse, expr1->ts.u.cl->length);
4727	expr1->ts.u.cl->backend_decl = tse.expr;
4728	}
4729	type = gfc_get_character_type_len (gfc_default_character_kind,
4730	expr1->ts.u.cl->backend_decl);
4731	}
4732	}
4733	else
4734	type = gfc_typenode_for_spec (&expr1->ts);
4735
4736	gfc_init_block (&inner_size_body);
4737	inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body,
4738	&lss, &rss);
4739
4740	/* Allocate temporary for nested forall construct according to the
4741	information in nested_forall_info and inner_size. */
4742	tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type, inner_size,
4743	&inner_size_body, block, &ptemp1);
4744
4745	/* Generate codes to copy rhs to the temporary . */
4746	tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, count, count1, lss, rss,
4747	wheremask, invert);
4748
4749	/* Generate body and loops according to the information in
4750	nested_forall_info. */
4751	tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
4752	gfc_add_expr_to_block (block, tmp);
4753
4754	/* Reset count1. */
4755	gfc_add_modify (block, count1, gfc_index_zero_nodegfc_rank_cst[0]);
4756
4757	/* Reset count. */
4758	if (wheremask)
4759	gfc_add_modify (block, count, gfc_index_zero_nodegfc_rank_cst[0]);
4760
4761	/* TODO: Second call to compute_inner_temp_size to initialize lss and
4762	rss; there must be a better way. */
4763	inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body,
4764	&lss, &rss);
4765
4766	/* Generate codes to copy the temporary to lhs. */
4767	tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1,
4768	lss, rss,
4769	wheremask, invert);
4770
4771	/* Generate body and loops according to the information in
4772	nested_forall_info. */
4773	tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
4774	gfc_add_expr_to_block (block, tmp);
4775
4776	if (ptemp1)
4777	{
4778	/* Free the temporary. */
4779	tmp = gfc_call_free (ptemp1);
4780	gfc_add_expr_to_block (block, tmp);
4781	}
4782	}
4783
4784
4785	/* Translate pointer assignment inside FORALL which need temporary. */
4786
4787	static void
4788	gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
4789	forall_info * nested_forall_info,
4790	stmtblock_t * block)
4791	{
4792	tree type;
4793	tree inner_size;
4794	gfc_ss lss, rss;
4795	gfc_se lse;
4796	gfc_se rse;
4797	gfc_array_info *info;
4798	gfc_loopinfo loop;
4799	tree desc;
4800	tree parm;
4801	tree parmtype;
4802	stmtblock_t body;
4803	tree count;
4804	tree tmp, tmp1, ptemp1;
4805
4806	count = gfc_create_var (gfc_array_index_type, "count");
4807	gfc_add_modify (block, count, gfc_index_zero_nodegfc_rank_cst[0]);
4808
4809	inner_size = gfc_index_one_nodegfc_rank_cst[1];
4810	lss = gfc_walk_expr (expr1);
4811	rss = gfc_walk_expr (expr2);
4812	if (lss == gfc_ss_terminator)
4813	{
4814	type = gfc_typenode_for_spec (&expr1->ts);
4815	type = build_pointer_type (type);
4816
4817	/* Allocate temporary for nested forall construct according to the
4818	information in nested_forall_info and inner_size. */
4819	tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type,
4820	inner_size, NULL__null, block, &ptemp1);
4821	gfc_start_block (&body);
4822	gfc_init_se (&lse, NULL__null);
4823	lse.expr = gfc_build_array_ref (tmp1, count, NULL__null);
4824	gfc_init_se (&rse, NULL__null);
4825	rse.want_pointer = 1;
4826	gfc_conv_expr (&rse, expr2);
4827	gfc_add_block_to_block (&body, &rse.pre);
4828	gfc_add_modify (&body, lse.expr,
4829	fold_convert (TREE_TYPE (lse.expr), rse.expr)fold_convert_loc (((location_t) 0), ((contains_struct_check ( (lse.expr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4829, __FUNCTION__))->typed.type), rse.expr));
4830	gfc_add_block_to_block (&body, &rse.post);
4831
4832	/* Increment count. */
4833	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4834	count, gfc_index_one_nodegfc_rank_cst[1]);
4835	gfc_add_modify (&body, count, tmp);
4836
4837	tmp = gfc_finish_block (&body);
4838
4839	/* Generate body and loops according to the information in
4840	nested_forall_info. */
4841	tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
4842	gfc_add_expr_to_block (block, tmp);
4843
4844	/* Reset count. */
4845	gfc_add_modify (block, count, gfc_index_zero_nodegfc_rank_cst[0]);
4846
4847	gfc_start_block (&body);
4848	gfc_init_se (&lse, NULL__null);
4849	gfc_init_se (&rse, NULL__null);
4850	rse.expr = gfc_build_array_ref (tmp1, count, NULL__null);
4851	lse.want_pointer = 1;
4852	gfc_conv_expr (&lse, expr1);
4853	gfc_add_block_to_block (&body, &lse.pre);
4854	gfc_add_modify (&body, lse.expr, rse.expr);
4855	gfc_add_block_to_block (&body, &lse.post);
4856	/* Increment count. */
4857	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4858	count, gfc_index_one_nodegfc_rank_cst[1]);
4859	gfc_add_modify (&body, count, tmp);
4860	tmp = gfc_finish_block (&body);
4861
4862	/* Generate body and loops according to the information in
4863	nested_forall_info. */
4864	tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
4865	gfc_add_expr_to_block (block, tmp);
4866	}
4867	else
4868	{
4869	gfc_init_loopinfo (&loop);
4870
4871	/* Associate the SS with the loop. */
4872	gfc_add_ss_to_loop (&loop, rss);
4873
4874	/* Setup the scalarizing loops and bounds. */
4875	gfc_conv_ss_startstride (&loop);
4876
4877	gfc_conv_loop_setup (&loop, &expr2->where);
4878
4879	info = &rss->info->data.array;
4880	desc = info->descriptor;
4881
4882	/* Make a new descriptor. */
4883	parmtype = gfc_get_element_type (TREE_TYPE (desc)((contains_struct_check ((desc), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 4883, __FUNCTION__))->typed.type));
4884	parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, 0,
4885	loop.from, loop.to, 1,
4886	GFC_ARRAY_UNKNOWN, true);
4887
4888	/* Allocate temporary for nested forall construct. */
4889	tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,
4890	inner_size, NULL__null, block, &ptemp1);
4891	gfc_start_block (&body);
4892	gfc_init_se (&lse, NULL__null);
4893	lse.expr = gfc_build_array_ref (tmp1, count, NULL__null);
4894	lse.direct_byref = 1;
4895	gfc_conv_expr_descriptor (&lse, expr2);
4896
4897	gfc_add_block_to_block (&body, &lse.pre);
4898	gfc_add_block_to_block (&body, &lse.post);
4899
4900	/* Increment count. */
4901	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4902	count, gfc_index_one_nodegfc_rank_cst[1]);
4903	gfc_add_modify (&body, count, tmp);
4904
4905	tmp = gfc_finish_block (&body);
4906
4907	/* Generate body and loops according to the information in
4908	nested_forall_info. */
4909	tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
4910	gfc_add_expr_to_block (block, tmp);
4911
4912	/* Reset count. */
4913	gfc_add_modify (block, count, gfc_index_zero_nodegfc_rank_cst[0]);
4914
4915	parm = gfc_build_array_ref (tmp1, count, NULL__null);
4916	gfc_init_se (&lse, NULL__null);
4917	gfc_conv_expr_descriptor (&lse, expr1);
4918	gfc_add_modify (&lse.pre, lse.expr, parm);
4919	gfc_start_block (&body);
4920	gfc_add_block_to_block (&body, &lse.pre);
4921	gfc_add_block_to_block (&body, &lse.post);
4922
4923	/* Increment count. */
4924	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
4925	count, gfc_index_one_nodegfc_rank_cst[1]);
4926	gfc_add_modify (&body, count, tmp);
4927
4928	tmp = gfc_finish_block (&body);
4929
4930	tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
4931	gfc_add_expr_to_block (block, tmp);
4932	}
4933	/* Free the temporary. */
4934	if (ptemp1)
4935	{
4936	tmp = gfc_call_free (ptemp1);
4937	gfc_add_expr_to_block (block, tmp);
4938	}
4939	}
4940
4941
4942	/* FORALL and WHERE statements are really nasty, especially when you nest
4943	them. All the rhs of a forall assignment must be evaluated before the
4944	actual assignments are performed. Presumably this also applies to all the
4945	assignments in an inner where statement. */
4946
4947	/* Generate code for a FORALL statement. Any temporaries are allocated as a
4948	linear array, relying on the fact that we process in the same order in all
4949	loops.
4950
4951	forall (i=start:end:stride; maskexpr)
4952	e<i> = f<i>
4953	g<i> = h<i>
4954	end forall
4955	(where e,f,g,h<i> are arbitrary expressions possibly involving i)
4956	Translates to:
4957	count = ((end + 1 - start) / stride)
4958	masktmp(:) = maskexpr(:)
4959
4960	maskindex = 0;
4961	for (i = start; i <= end; i += stride)
4962	{
4963	if (masktmp[maskindex++])
4964	e<i> = f<i>
4965	}
4966	maskindex = 0;
4967	for (i = start; i <= end; i += stride)
4968	{
4969	if (masktmp[maskindex++])
4970	g<i> = h<i>
4971	}
4972
4973	Note that this code only works when there are no dependencies.
4974	Forall loop with array assignments and data dependencies are a real pain,
4975	because the size of the temporary cannot always be determined before the
4976	loop is executed. This problem is compounded by the presence of nested
4977	FORALL constructs.
4978	*/
4979
4980	static tree
4981	gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
4982	{
4983	stmtblock_t pre;
4984	stmtblock_t post;
4985	stmtblock_t block;
4986	stmtblock_t body;
4987	tree *var;
4988	tree *start;
4989	tree *end;
4990	tree *step;
4991	gfc_expr **varexpr;
4992	tree tmp;
4993	tree assign;
4994	tree size;
4995	tree maskindex;
4996	tree mask;
4997	tree pmask;
4998	tree cycle_label = NULL_TREE(tree) __null;
4999	int n;
5000	int nvar;
5001	int need_temp;
5002	gfc_forall_iterator *fa;
5003	gfc_se se;
5004	gfc_code *c;
5005	gfc_saved_var *saved_vars;
5006	iter_info *this_forall;
5007	forall_info *info;
5008	bool need_mask;
5009
5010	/* Do nothing if the mask is false. */
5011	if (code->expr1
5012	&& code->expr1->expr_type == EXPR_CONSTANT
5013	&& !code->expr1->value.logical)
5014	return build_empty_stmt (input_location);
5015
5016	n = 0;
5017	/* Count the FORALL index number. */
5018	for (fa = code->ext.forall_iterator; fa; fa = fa->next)
5019	n++;
5020	nvar = n;
5021
5022	/* Allocate the space for var, start, end, step, varexpr. */
5023	var = XCNEWVEC (tree, nvar)((tree *) xcalloc ((nvar), sizeof (tree)));
5024	start = XCNEWVEC (tree, nvar)((tree *) xcalloc ((nvar), sizeof (tree)));
5025	end = XCNEWVEC (tree, nvar)((tree *) xcalloc ((nvar), sizeof (tree)));
5026	step = XCNEWVEC (tree, nvar)((tree *) xcalloc ((nvar), sizeof (tree)));
5027	varexpr = XCNEWVEC (gfc_expr , nvar)((gfc_expr ) xcalloc ((nvar), sizeof (gfc_expr )));
5028	saved_vars = XCNEWVEC (gfc_saved_var, nvar)((gfc_saved_var *) xcalloc ((nvar), sizeof (gfc_saved_var)));
5029
5030	/* Allocate the space for info. */
5031	info = XCNEW (forall_info)((forall_info *) xcalloc (1, sizeof (forall_info)));
5032
5033	gfc_start_block (&pre);
5034	gfc_init_block (&post);
5035	gfc_init_block (&block);
5036
5037	n = 0;
5038	for (fa = code->ext.forall_iterator; fa; fa = fa->next)
5039	{
5040	gfc_symbol *sym = fa->var->symtree->n.sym;
5041
5042	/* Allocate space for this_forall. */
5043	this_forall = XCNEW (iter_info)((iter_info *) xcalloc (1, sizeof (iter_info)));
5044
5045	/* Create a temporary variable for the FORALL index. */
5046	tmp = gfc_typenode_for_spec (&sym->ts);
5047	var[n] = gfc_create_var (tmp, sym->name);
5048	gfc_shadow_sym (sym, var[n], &saved_vars[n]);
5049
5050	/* Record it in this_forall. */
5051	this_forall->var = var[n];
5052
5053	/* Replace the index symbol's backend_decl with the temporary decl. */
5054	sym->backend_decl = var[n];
5055
5056	/* Work out the start, end and stride for the loop. */
5057	gfc_init_se (&se, NULL__null);
5058	gfc_conv_expr_val (&se, fa->start);
5059	/* Record it in this_forall. */
5060	this_forall->start = se.expr;
5061	gfc_add_block_to_block (&block, &se.pre);
5062	start[n] = se.expr;
5063
5064	gfc_init_se (&se, NULL__null);
5065	gfc_conv_expr_val (&se, fa->end);
5066	/* Record it in this_forall. */
5067	this_forall->end = se.expr;
5068	gfc_make_safe_expr (&se);
5069	gfc_add_block_to_block (&block, &se.pre);
5070	end[n] = se.expr;
5071
5072	gfc_init_se (&se, NULL__null);
5073	gfc_conv_expr_val (&se, fa->stride);
5074	/* Record it in this_forall. */
5075	this_forall->step = se.expr;
5076	gfc_make_safe_expr (&se);
5077	gfc_add_block_to_block (&block, &se.pre);
5078	step[n] = se.expr;
5079
5080	/* Set the NEXT field of this_forall to NULL. */
5081	this_forall->next = NULL__null;
5082	/* Link this_forall to the info construct. */
5083	if (info->this_loop)
5084	{
5085	iter_info *iter_tmp = info->this_loop;
5086	while (iter_tmp->next != NULL__null)
5087	iter_tmp = iter_tmp->next;
5088	iter_tmp->next = this_forall;
5089	}
5090	else
5091	info->this_loop = this_forall;
5092
5093	n++;
5094	}
5095	nvar = n;
5096
5097	/* Calculate the size needed for the current forall level. */
5098	size = gfc_index_one_nodegfc_rank_cst[1];
5099	for (n = 0; n < nvar; n++)
5100	{
5101	/* size = (end + step - start) / step. */
5102	tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (start[n])((contains_struct_check ((start[n]), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5102, __FUNCTION__))->typed.type),
5103	step[n], start[n]);
5104	tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (end[n])((contains_struct_check ((end[n]), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5104, __FUNCTION__))->typed.type),
5105	end[n], tmp);
5106	tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5106, __FUNCTION__))->typed.type),
5107	tmp, step[n]);
5108	tmp = convert (gfc_array_index_type, tmp);
5109
5110	size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
5111	size, tmp);
5112	}
5113
5114	/* Record the nvar and size of current forall level. */
5115	info->nvar = nvar;
5116	info->size = size;
5117
5118	if (code->expr1)
5119	{
5120	/* If the mask is .true., consider the FORALL unconditional. */
5121	if (code->expr1->expr_type == EXPR_CONSTANT
5122	&& code->expr1->value.logical)
5123	need_mask = false;
5124	else
5125	need_mask = true;
5126	}
5127	else
5128	need_mask = false;
5129
5130	/* First we need to allocate the mask. */
5131	if (need_mask)
5132	{
5133	/* As the mask array can be very big, prefer compact boolean types. */
5134	tree mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
5135	mask = allocate_temp_for_forall_nest (nested_forall_info, mask_type,
5136	size, NULL__null, &block, &pmask);
5137	maskindex = gfc_create_var_np (gfc_array_index_type, "mi");
5138
5139	/* Record them in the info structure. */
5140	info->maskindex = maskindex;
5141	info->mask = mask;
5142	}
5143	else
5144	{
5145	/* No mask was specified. */
5146	maskindex = NULL_TREE(tree) __null;
5147	mask = pmask = NULL_TREE(tree) __null;
5148	}
5149
5150	/* Link the current forall level to nested_forall_info. */
5151	info->prev_nest = nested_forall_info;
5152	nested_forall_info = info;
5153
5154	/* Copy the mask into a temporary variable if required.
5155	For now we assume a mask temporary is needed. */
5156	if (need_mask)
5157	{
5158	/* As the mask array can be very big, prefer compact boolean types. */
5159	tree mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
5160
5161	gfc_add_modify (&block, maskindex, gfc_index_zero_nodegfc_rank_cst[0]);
5162
5163	/* Start of mask assignment loop body. */
5164	gfc_start_block (&body);
5165
5166	/* Evaluate the mask expression. */
5167	gfc_init_se (&se, NULL__null);
5168	gfc_conv_expr_val (&se, code->expr1);
5169	gfc_add_block_to_block (&body, &se.pre);
5170
5171	/* Store the mask. */
5172	se.expr = convert (mask_type, se.expr);
5173
5174	tmp = gfc_build_array_ref (mask, maskindex, NULL__null);
5175	gfc_add_modify (&body, tmp, se.expr);
5176
5177	/* Advance to the next mask element. */
5178	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
5179	maskindex, gfc_index_one_nodegfc_rank_cst[1]);
5180	gfc_add_modify (&body, maskindex, tmp);
5181
5182	/* Generate the loops. */
5183	tmp = gfc_finish_block (&body);
5184	tmp = gfc_trans_nested_forall_loop (info, tmp, 0);
5185	gfc_add_expr_to_block (&block, tmp);
5186	}
5187
5188	if (code->op == EXEC_DO_CONCURRENT)
5189	{
5190	gfc_init_block (&body);
5191	cycle_label = gfc_build_label_decl (NULL_TREE(tree) __null);
5192	code->cycle_label = cycle_label;
5193	tmp = gfc_trans_code (code->block->next);
5194	gfc_add_expr_to_block (&body, tmp);
5195
5196	if (TREE_USED (cycle_label)((cycle_label)->base.used_flag))
5197	{
5198	tmp = build1_v (LABEL_EXPR, cycle_label)fold_build1_loc (input_location, LABEL_EXPR, global_trees[TI_VOID_TYPE ], cycle_label);
5199	gfc_add_expr_to_block (&body, tmp);
5200	}
5201
5202	tmp = gfc_finish_block (&body);
5203	nested_forall_info->do_concurrent = true;
5204	tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
5205	gfc_add_expr_to_block (&block, tmp);
5206	goto done;
5207	}
5208
5209	c = code->block->next;
5210
5211	/* TODO: loop merging in FORALL statements. */
5212	/* Now that we've got a copy of the mask, generate the assignment loops. */
5213	while (c)
5214	{
5215	switch (c->op)
5216	{
5217	case EXEC_ASSIGN:
5218	/* A scalar or array assignment. DO the simple check for
5219	lhs to rhs dependencies. These make a temporary for the
5220	rhs and form a second forall block to copy to variable. */
5221	need_temp = check_forall_dependencies(c, &pre, &post);
5222
5223	/* Temporaries due to array assignment data dependencies introduce
5224	no end of problems. */
5225	if (need_temp \|\| flag_test_forall_tempglobal_options.x_flag_test_forall_temp)
5226	gfc_trans_assign_need_temp (c->expr1, c->expr2, NULL__null, false,
5227	nested_forall_info, &block);
5228	else
5229	{
5230	/* Use the normal assignment copying routines. */
5231	assign = gfc_trans_assignment (c->expr1, c->expr2, false, true);
5232
5233	/* Generate body and loops. */
5234	tmp = gfc_trans_nested_forall_loop (nested_forall_info,
5235	assign, 1);
5236	gfc_add_expr_to_block (&block, tmp);
5237	}
5238
5239	/* Cleanup any temporary symtrees that have been made to deal
5240	with dependencies. */
5241	if (new_symtree)
5242	cleanup_forall_symtrees (c);
5243
5244	break;
5245
5246	case EXEC_WHERE:
5247	/* Translate WHERE or WHERE construct nested in FORALL. */
5248	gfc_trans_where_2 (c, NULL__null, false, nested_forall_info, &block);
5249	break;
5250
5251	/* Pointer assignment inside FORALL. */
5252	case EXEC_POINTER_ASSIGN:
5253	need_temp = gfc_check_dependency (c->expr1, c->expr2, 0);
5254	/* Avoid cases where a temporary would never be needed and where
5255	the temp code is guaranteed to fail. */
5256	if (need_temp
5257	\|\| (flag_test_forall_tempglobal_options.x_flag_test_forall_temp
5258	&& c->expr2->expr_type != EXPR_CONSTANT
5259	&& c->expr2->expr_type != EXPR_NULL))
5260	gfc_trans_pointer_assign_need_temp (c->expr1, c->expr2,
5261	nested_forall_info, &block);
5262	else
5263	{
5264	/* Use the normal assignment copying routines. */
5265	assign = gfc_trans_pointer_assignment (c->expr1, c->expr2);
5266
5267	/* Generate body and loops. */
5268	tmp = gfc_trans_nested_forall_loop (nested_forall_info,
5269	assign, 1);
5270	gfc_add_expr_to_block (&block, tmp);
5271	}
5272	break;
5273
5274	case EXEC_FORALL:
5275	tmp = gfc_trans_forall_1 (c, nested_forall_info);
5276	gfc_add_expr_to_block (&block, tmp);
5277	break;
5278
5279	/* Explicit subroutine calls are prevented by the frontend but interface
5280	assignments can legitimately produce them. */
5281	case EXEC_ASSIGN_CALL:
5282	assign = gfc_trans_call (c, true, NULL_TREE(tree) __null, NULL_TREE(tree) __null, false);
5283	tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1);
5284	gfc_add_expr_to_block (&block, tmp);
5285	break;
5286
5287	default:
5288	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5288, __FUNCTION__));
5289	}
5290
5291	c = c->next;
5292	}
5293
5294	done:
5295	/* Restore the original index variables. */
5296	for (fa = code->ext.forall_iterator, n = 0; fa; fa = fa->next, n++)
5297	gfc_restore_sym (fa->var->symtree->n.sym, &saved_vars[n]);
5298
5299	/* Free the space for var, start, end, step, varexpr. */
5300	free (var);
5301	free (start);
5302	free (end);
5303	free (step);
5304	free (varexpr);
5305	free (saved_vars);
5306
5307	for (this_forall = info->this_loop; this_forall;)
5308	{
5309	iter_info *next = this_forall->next;
5310	free (this_forall);
5311	this_forall = next;
5312	}
5313
5314	/* Free the space for this forall_info. */
5315	free (info);
5316
5317	if (pmask)
5318	{
5319	/* Free the temporary for the mask. */
5320	tmp = gfc_call_free (pmask);
5321	gfc_add_expr_to_block (&block, tmp);
5322	}
5323	if (maskindex)
5324	pushdecl (maskindex);
5325
5326	gfc_add_block_to_block (&pre, &block);
5327	gfc_add_block_to_block (&pre, &post);
5328
5329	return gfc_finish_block (&pre);
5330	}
5331
5332
5333	/* Translate the FORALL statement or construct. */
5334
5335	tree gfc_trans_forall (gfc_code * code)
5336	{
5337	return gfc_trans_forall_1 (code, NULL__null);
5338	}
5339
5340
5341	/* Translate the DO CONCURRENT construct. */
5342
5343	tree gfc_trans_do_concurrent (gfc_code * code)
5344	{
5345	return gfc_trans_forall_1 (code, NULL__null);
5346	}
5347
5348
5349	/* Evaluate the WHERE mask expression, copy its value to a temporary.
5350	If the WHERE construct is nested in FORALL, compute the overall temporary
5351	needed by the WHERE mask expression multiplied by the iterator number of
5352	the nested forall.
5353	ME is the WHERE mask expression.
5354	MASK is the current execution mask upon input, whose sense may or may
5355	not be inverted as specified by the INVERT argument.
5356	CMASK is the updated execution mask on output, or NULL if not required.
5357	PMASK is the pending execution mask on output, or NULL if not required.
5358	BLOCK is the block in which to place the condition evaluation loops. */
5359
5360	static void
5361	gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
5362	tree mask, bool invert, tree cmask, tree pmask,
5363	tree mask_type, stmtblock_t * block)
5364	{
5365	tree tmp, tmp1;
5366	gfc_ss lss, rss;
5367	gfc_loopinfo loop;
5368	stmtblock_t body, body1;
5369	tree count, cond, mtmp;
5370	gfc_se lse, rse;
5371
5372	gfc_init_loopinfo (&loop);
5373
5374	lss = gfc_walk_expr (me);
5375	rss = gfc_walk_expr (me);
5376
5377	/* Variable to index the temporary. */
5378	count = gfc_create_var (gfc_array_index_type, "count");
5379	/* Initialize count. */
5380	gfc_add_modify (block, count, gfc_index_zero_nodegfc_rank_cst[0]);
5381
5382	gfc_start_block (&body);
5383
5384	gfc_init_se (&rse, NULL__null);
5385	gfc_init_se (&lse, NULL__null);
5386
5387	if (lss == gfc_ss_terminator)
5388	{
5389	gfc_init_block (&body1);
5390	}
5391	else
5392	{
5393	/* Initialize the loop. */
5394	gfc_init_loopinfo (&loop);
5395
5396	/* We may need LSS to determine the shape of the expression. */
5397	gfc_add_ss_to_loop (&loop, lss);
5398	gfc_add_ss_to_loop (&loop, rss);
5399
5400	gfc_conv_ss_startstride (&loop);
5401	gfc_conv_loop_setup (&loop, &me->where);
5402
5403	gfc_mark_ss_chain_used (rss, 1);
5404	/* Start the loop body. */
5405	gfc_start_scalarized_body (&loop, &body1);
5406
5407	/* Translate the expression. */
5408	gfc_copy_loopinfo_to_se (&rse, &loop);
5409	rse.ss = rss;
5410	gfc_conv_expr (&rse, me);
5411	}
5412
5413	/* Variable to evaluate mask condition. */
5414	cond = gfc_create_var (mask_type, "cond");
5415	if (mask && (cmask \|\| pmask))
5416	mtmp = gfc_create_var (mask_type, "mask");
5417	else mtmp = NULL_TREE(tree) __null;
5418
5419	gfc_add_block_to_block (&body1, &lse.pre);
5420	gfc_add_block_to_block (&body1, &rse.pre);
5421
5422	gfc_add_modify (&body1, cond, fold_convert (mask_type, rse.expr)fold_convert_loc (((location_t) 0), mask_type, rse.expr));
5423
5424	if (mask && (cmask \|\| pmask))
5425	{
5426	tmp = gfc_build_array_ref (mask, count, NULL__null);
5427	if (invert)
5428	tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, tmp);
5429	gfc_add_modify (&body1, mtmp, tmp);
5430	}
5431
5432	if (cmask)
5433	{
5434	tmp1 = gfc_build_array_ref (cmask, count, NULL__null);
5435	tmp = cond;
5436	if (mask)
5437	tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type,
5438	mtmp, tmp);
5439	gfc_add_modify (&body1, tmp1, tmp);
5440	}
5441
5442	if (pmask)
5443	{
5444	tmp1 = gfc_build_array_ref (pmask, count, NULL__null);
5445	tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, cond);
5446	if (mask)
5447	tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type, mtmp,
5448	tmp);
5449	gfc_add_modify (&body1, tmp1, tmp);
5450	}
5451
5452	gfc_add_block_to_block (&body1, &lse.post);
5453	gfc_add_block_to_block (&body1, &rse.post);
5454
5455	if (lss == gfc_ss_terminator)
5456	{
5457	gfc_add_block_to_block (&body, &body1);
5458	}
5459	else
5460	{
5461	/* Increment count. */
5462	tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
5463	count, gfc_index_one_nodegfc_rank_cst[1]);
5464	gfc_add_modify (&body1, count, tmp1);
5465
5466	/* Generate the copying loops. */
5467	gfc_trans_scalarizing_loops (&loop, &body1);
5468
5469	gfc_add_block_to_block (&body, &loop.pre);
5470	gfc_add_block_to_block (&body, &loop.post);
5471
5472	gfc_cleanup_loop (&loop);
5473	/* TODO: Reuse lss and rss when copying temp->lhs. Need to be careful
5474	as tree nodes in SS may not be valid in different scope. */
5475	}
5476
5477	tmp1 = gfc_finish_block (&body);
5478	/* If the WHERE construct is inside FORALL, fill the full temporary. */
5479	if (nested_forall_info != NULL__null)
5480	tmp1 = gfc_trans_nested_forall_loop (nested_forall_info, tmp1, 1);
5481
5482	gfc_add_expr_to_block (block, tmp1);
5483	}
5484
5485
5486	/* Translate an assignment statement in a WHERE statement or construct
5487	statement. The MASK expression is used to control which elements
5488	of EXPR1 shall be assigned. The sense of MASK is specified by
5489	INVERT. */
5490
5491	static tree
5492	gfc_trans_where_assign (gfc_expr expr1, gfc_expr expr2,
5493	tree mask, bool invert,
5494	tree count1, tree count2,
5495	gfc_code *cnext)
5496	{
5497	gfc_se lse;
5498	gfc_se rse;
5499	gfc_ss *lss;
5500	gfc_ss *lss_section;
5501	gfc_ss *rss;
5502
5503	gfc_loopinfo loop;
5504	tree tmp;
5505	stmtblock_t block;
5506	stmtblock_t body;
5507	tree index, maskexpr;
5508
5509	/* A defined assignment. */
5510	if (cnext && cnext->resolved_sym)
5511	return gfc_trans_call (cnext, true, mask, count1, invert);
5512
5513	#if 0
5514	/* TODO: handle this special case.
5515	Special case a single function returning an array. */
5516	if (expr2->expr_type == EXPR_FUNCTION && expr2->rank > 0)
5517	{
5518	tmp = gfc_trans_arrayfunc_assign (expr1, expr2);
5519	if (tmp)
5520	return tmp;
5521	}
5522	#endif
5523
5524	/* Assignment of the form lhs = rhs. */
5525	gfc_start_block (&block);
5526
5527	gfc_init_se (&lse, NULL__null);
5528	gfc_init_se (&rse, NULL__null);
5529
5530	/* Walk the lhs. */
5531	lss = gfc_walk_expr (expr1);
5532	rss = NULL__null;
5533
5534	/* In each where-assign-stmt, the mask-expr and the variable being
5535	defined shall be arrays of the same shape. */
5536	gcc_assert (lss != gfc_ss_terminator)((void)(!(lss != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5536, __FUNCTION__), 0 : 0));
5537
5538	/* The assignment needs scalarization. */
5539	lss_section = lss;
5540
5541	/* Find a non-scalar SS from the lhs. */
5542	while (lss_section != gfc_ss_terminator
5543	&& lss_section->info->type != GFC_SS_SECTION)
5544	lss_section = lss_section->next;
5545
5546	gcc_assert (lss_section != gfc_ss_terminator)((void)(!(lss_section != gfc_ss_terminator) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5546, __FUNCTION__), 0 : 0));
5547
5548	/* Initialize the scalarizer. */
5549	gfc_init_loopinfo (&loop);
5550
5551	/* Walk the rhs. */
5552	rss = gfc_walk_expr (expr2);
5553	if (rss == gfc_ss_terminator)
5554	{
5555	/* The rhs is scalar. Add a ss for the expression. */
5556	rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2);
5557	rss->info->where = 1;
5558	}
5559
5560	/* Associate the SS with the loop. */
5561	gfc_add_ss_to_loop (&loop, lss);
5562	gfc_add_ss_to_loop (&loop, rss);
5563
5564	/* Calculate the bounds of the scalarization. */
5565	gfc_conv_ss_startstride (&loop);
5566
5567	/* Resolve any data dependencies in the statement. */
5568	gfc_conv_resolve_dependencies (&loop, lss_section, rss);
5569
5570	/* Setup the scalarizing loops. */
5571	gfc_conv_loop_setup (&loop, &expr2->where);
5572
5573	/* Setup the gfc_se structures. */
5574	gfc_copy_loopinfo_to_se (&lse, &loop);
5575	gfc_copy_loopinfo_to_se (&rse, &loop);
5576
5577	rse.ss = rss;
5578	gfc_mark_ss_chain_used (rss, 1);
5579	if (loop.temp_ss == NULL__null)
5580	{
5581	lse.ss = lss;
5582	gfc_mark_ss_chain_used (lss, 1);
5583	}
5584	else
5585	{
5586	lse.ss = loop.temp_ss;
5587	gfc_mark_ss_chain_used (lss, 3);
5588	gfc_mark_ss_chain_used (loop.temp_ss, 3);
5589	}
5590
5591	/* Start the scalarized loop body. */
5592	gfc_start_scalarized_body (&loop, &body);
5593
5594	/* Translate the expression. */
5595	gfc_conv_expr (&rse, expr2);
5596	if (lss != gfc_ss_terminator && loop.temp_ss != NULL__null)
5597	gfc_conv_tmp_array_ref (&lse);
5598	else
5599	gfc_conv_expr (&lse, expr1);
5600
5601	/* Form the mask expression according to the mask. */
5602	index = count1;
5603	maskexpr = gfc_build_array_ref (mask, index, NULL__null);
5604	if (invert)
5605	maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
5606	TREE_TYPE (maskexpr)((contains_struct_check ((maskexpr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5606, __FUNCTION__))->typed.type), maskexpr);
5607
5608	/* Use the scalar assignment as is. */
5609	tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
5610	false, loop.temp_ss == NULL__null);
5611
5612	tmp = build3_v (COND_EXPR, maskexpr, tmp, build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], maskexpr, tmp, build_empty_stmt (input_location));
5613
5614	gfc_add_expr_to_block (&body, tmp);
5615
5616	if (lss == gfc_ss_terminator)
5617	{
5618	/* Increment count1. */
5619	tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
5620	count1, gfc_index_one_nodegfc_rank_cst[1]);
5621	gfc_add_modify (&body, count1, tmp);
5622
5623	/* Use the scalar assignment as is. */
5624	gfc_add_block_to_block (&block, &body);
5625	}
5626	else
5627	{
5628	gcc_assert (lse.ss == gfc_ss_terminator((void)(!(lse.ss == gfc_ss_terminator && rse.ss == gfc_ss_terminator ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5629, __FUNCTION__), 0 : 0))
5629	&& rse.ss == gfc_ss_terminator)((void)(!(lse.ss == gfc_ss_terminator && rse.ss == gfc_ss_terminator ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5629, __FUNCTION__), 0 : 0));
5630
5631	if (loop.temp_ss != NULL__null)
5632	{
5633	/* Increment count1 before finish the main body of a scalarized
5634	expression. */
5635	tmp = fold_build2_loc (input_location, PLUS_EXPR,
5636	gfc_array_index_type, count1, gfc_index_one_nodegfc_rank_cst[1]);
5637	gfc_add_modify (&body, count1, tmp);
5638	gfc_trans_scalarized_loop_boundary (&loop, &body);
5639
5640	/* We need to copy the temporary to the actual lhs. */
5641	gfc_init_se (&lse, NULL__null);
5642	gfc_init_se (&rse, NULL__null);
5643	gfc_copy_loopinfo_to_se (&lse, &loop);
5644	gfc_copy_loopinfo_to_se (&rse, &loop);
5645
5646	rse.ss = loop.temp_ss;
5647	lse.ss = lss;
5648
5649	gfc_conv_tmp_array_ref (&rse);
5650	gfc_conv_expr (&lse, expr1);
5651
5652	gcc_assert (lse.ss == gfc_ss_terminator((void)(!(lse.ss == gfc_ss_terminator && rse.ss == gfc_ss_terminator ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5653, __FUNCTION__), 0 : 0))
5653	&& rse.ss == gfc_ss_terminator)((void)(!(lse.ss == gfc_ss_terminator && rse.ss == gfc_ss_terminator ) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5653, __FUNCTION__), 0 : 0));
5654
5655	/* Form the mask expression according to the mask tree list. */
5656	index = count2;
5657	maskexpr = gfc_build_array_ref (mask, index, NULL__null);
5658	if (invert)
5659	maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
5660	TREE_TYPE (maskexpr)((contains_struct_check ((maskexpr), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5660, __FUNCTION__))->typed.type), maskexpr);
5661
5662	/* Use the scalar assignment as is. */
5663	tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, false, true);
5664	tmp = build3_v (COND_EXPR, maskexpr, tmp,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], maskexpr, tmp, build_empty_stmt (input_location))
5665	build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], maskexpr, tmp, build_empty_stmt (input_location));
5666	gfc_add_expr_to_block (&body, tmp);
5667
5668	/* Increment count2. */
5669	tmp = fold_build2_loc (input_location, PLUS_EXPR,
5670	gfc_array_index_type, count2,
5671	gfc_index_one_nodegfc_rank_cst[1]);
5672	gfc_add_modify (&body, count2, tmp);
5673	}
5674	else
5675	{
5676	/* Increment count1. */
5677	tmp = fold_build2_loc (input_location, PLUS_EXPR,
5678	gfc_array_index_type, count1,
5679	gfc_index_one_nodegfc_rank_cst[1]);
5680	gfc_add_modify (&body, count1, tmp);
5681	}
5682
5683	/* Generate the copying loops. */
5684	gfc_trans_scalarizing_loops (&loop, &body);
5685
5686	/* Wrap the whole thing up. */
5687	gfc_add_block_to_block (&block, &loop.pre);
5688	gfc_add_block_to_block (&block, &loop.post);
5689	gfc_cleanup_loop (&loop);
5690	}
5691
5692	return gfc_finish_block (&block);
5693	}
5694
5695
5696	/* Translate the WHERE construct or statement.
5697	This function can be called iteratively to translate the nested WHERE
5698	construct or statement.
5699	MASK is the control mask. */
5700
5701	static void
5702	gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
5703	forall_info * nested_forall_info, stmtblock_t * block)
5704	{
5705	stmtblock_t inner_size_body;
5706	tree inner_size, size;
5707	gfc_ss lss, rss;
5708	tree mask_type;
5709	gfc_expr *expr1;
5710	gfc_expr *expr2;
5711	gfc_code *cblock;
5712	gfc_code *cnext;
5713	tree tmp;
5714	tree cond;
5715	tree count1, count2;
5716	bool need_cmask;
5717	bool need_pmask;
5718	int need_temp;
5719	tree pcmask = NULL_TREE(tree) __null;
5720	tree ppmask = NULL_TREE(tree) __null;
5721	tree cmask = NULL_TREE(tree) __null;
5722	tree pmask = NULL_TREE(tree) __null;
5723	gfc_actual_arglist *arg;
5724
5725	/* the WHERE statement or the WHERE construct statement. */
5726	cblock = code->block;
5727
5728	/* As the mask array can be very big, prefer compact boolean types. */
5729	mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
5730
5731	/* Determine which temporary masks are needed. */
5732	if (!cblock->block)
5733	{
5734	/* One clause: No ELSEWHEREs. */
5735	need_cmask = (cblock->next != 0);
5736	need_pmask = false;
5737	}
5738	else if (cblock->block->block)
5739	{
5740	/* Three or more clauses: Conditional ELSEWHEREs. */
5741	need_cmask = true;
5742	need_pmask = true;
5743	}
5744	else if (cblock->next)
5745	{
5746	/* Two clauses, the first non-empty. */
5747	need_cmask = true;
5748	need_pmask = (mask != NULL_TREE(tree) __null
5749	&& cblock->block->next != 0);
5750	}
5751	else if (!cblock->block->next)
5752	{
5753	/* Two clauses, both empty. */
5754	need_cmask = false;
5755	need_pmask = false;
5756	}
5757	/* Two clauses, the first empty, the second non-empty. */
5758	else if (mask)
5759	{
5760	need_cmask = (cblock->block->expr1 != 0);
5761	need_pmask = true;
5762	}
5763	else
5764	{
5765	need_cmask = true;
5766	need_pmask = false;
5767	}
5768
5769	if (need_cmask \|\| need_pmask)
5770	{
5771	/* Calculate the size of temporary needed by the mask-expr. */
5772	gfc_init_block (&inner_size_body);
5773	inner_size = compute_inner_temp_size (cblock->expr1, cblock->expr1,
5774	&inner_size_body, &lss, &rss);
5775
5776	gfc_free_ss_chain (lss);
5777	gfc_free_ss_chain (rss);
5778
5779	/* Calculate the total size of temporary needed. */
5780	size = compute_overall_iter_number (nested_forall_info, inner_size,
5781	&inner_size_body, block);
5782
5783	/* Check whether the size is negative. */
5784	cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, size,
5785	gfc_index_zero_nodegfc_rank_cst[0]);
5786	size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
5787	cond, gfc_index_zero_nodegfc_rank_cst[0], size);
5788	size = gfc_evaluate_now (size, block);
5789
5790	/* Allocate temporary for WHERE mask if needed. */
5791	if (need_cmask)
5792	cmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
5793	&pcmask);
5794
5795	/* Allocate temporary for !mask if needed. */
5796	if (need_pmask)
5797	pmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
5798	&ppmask);
5799	}
5800
5801	while (cblock)
5802	{
5803	/* Each time around this loop, the where clause is conditional
5804	on the value of mask and invert, which are updated at the
5805	bottom of the loop. */
5806
5807	/* Has mask-expr. */
5808	if (cblock->expr1)
5809	{
5810	/* Ensure that the WHERE mask will be evaluated exactly once.
5811	If there are no statements in this WHERE/ELSEWHERE clause,
5812	then we don't need to update the control mask (cmask).
5813	If this is the last clause of the WHERE construct, then
5814	we don't need to update the pending control mask (pmask). */
5815	if (mask)
5816	gfc_evaluate_where_mask (cblock->expr1, nested_forall_info,
5817	mask, invert,
5818	cblock->next ? cmask : NULL_TREE(tree) __null,
5819	cblock->block ? pmask : NULL_TREE(tree) __null,
5820	mask_type, block);
5821	else
5822	gfc_evaluate_where_mask (cblock->expr1, nested_forall_info,
5823	NULL_TREE(tree) __null, false,
5824	(cblock->next \|\| cblock->block)
5825	? cmask : NULL_TREE(tree) __null,
5826	NULL_TREE(tree) __null, mask_type, block);
5827
5828	invert = false;
5829	}
5830	/* It's a final elsewhere-stmt. No mask-expr is present. */
5831	else
5832	cmask = mask;
5833
5834	/* The body of this where clause are controlled by cmask with
5835	sense specified by invert. */
5836
5837	/* Get the assignment statement of a WHERE statement, or the first
5838	statement in where-body-construct of a WHERE construct. */
5839	cnext = cblock->next;
5840	while (cnext)
5841	{
5842	switch (cnext->op)
5843	{
5844	/* WHERE assignment statement. */
5845	case EXEC_ASSIGN_CALL:
5846
5847	arg = cnext->ext.actual;
5848	expr1 = expr2 = NULL__null;
5849	for (; arg; arg = arg->next)
5850	{
5851	if (!arg->expr)
5852	continue;
5853	if (expr1 == NULL__null)
5854	expr1 = arg->expr;
5855	else
5856	expr2 = arg->expr;
5857	}
5858	goto evaluate;
5859
5860	case EXEC_ASSIGN:
5861	expr1 = cnext->expr1;
5862	expr2 = cnext->expr2;
5863	evaluate:
5864	if (nested_forall_info != NULL__null)
5865	{
5866	need_temp = gfc_check_dependency (expr1, expr2, 0);
5867	if ((need_temp \|\| flag_test_forall_tempglobal_options.x_flag_test_forall_temp)
5868	&& cnext->op != EXEC_ASSIGN_CALL)
5869	gfc_trans_assign_need_temp (expr1, expr2,
5870	cmask, invert,
5871	nested_forall_info, block);
5872	else
5873	{
5874	/* Variables to control maskexpr. */
5875	count1 = gfc_create_var (gfc_array_index_type, "count1");
5876	count2 = gfc_create_var (gfc_array_index_type, "count2");
5877	gfc_add_modify (block, count1, gfc_index_zero_nodegfc_rank_cst[0]);
5878	gfc_add_modify (block, count2, gfc_index_zero_nodegfc_rank_cst[0]);
5879
5880	tmp = gfc_trans_where_assign (expr1, expr2,
5881	cmask, invert,
5882	count1, count2,
5883	cnext);
5884
5885	tmp = gfc_trans_nested_forall_loop (nested_forall_info,
5886	tmp, 1);
5887	gfc_add_expr_to_block (block, tmp);
5888	}
5889	}
5890	else
5891	{
5892	/* Variables to control maskexpr. */
5893	count1 = gfc_create_var (gfc_array_index_type, "count1");
5894	count2 = gfc_create_var (gfc_array_index_type, "count2");
5895	gfc_add_modify (block, count1, gfc_index_zero_nodegfc_rank_cst[0]);
5896	gfc_add_modify (block, count2, gfc_index_zero_nodegfc_rank_cst[0]);
5897
5898	tmp = gfc_trans_where_assign (expr1, expr2,
5899	cmask, invert,
5900	count1, count2,
5901	cnext);
5902	gfc_add_expr_to_block (block, tmp);
5903
5904	}
5905	break;
5906
5907	/* WHERE or WHERE construct is part of a where-body-construct. */
5908	case EXEC_WHERE:
5909	gfc_trans_where_2 (cnext, cmask, invert,
5910	nested_forall_info, block);
5911	break;
5912
5913	default:
5914	gcc_unreachable ()(fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-stmt.cc" , 5914, __FUNCTION__));
5915	}
5916
5917	/* The next statement within the same where-body-construct. */
5918	cnext = cnext->next;
5919	}
5920	/* The next masked-elsewhere-stmt, elsewhere-stmt, or end-where-stmt. */
5921	cblock = cblock->block;
5922	if (mask == NULL_TREE(tree) __null)
5923	{
5924	/* If we're the initial WHERE, we can simply invert the sense
5925	of the current mask to obtain the "mask" for the remaining
5926	ELSEWHEREs. */
5927	invert = true;
5928	mask = cmask;
5929	}
5930	else
5931	{
5932	/* Otherwise, for nested WHERE's we need to use the pending mask. */
5933	invert = false;
5934	mask = pmask;
5935	}
5936	}
5937
5938	/* If we allocated a pending mask array, deallocate it now. */
5939	if (ppmask)
5940	{
5941	tmp = gfc_call_free (ppmask);
5942	gfc_add_expr_to_block (block, tmp);
5943	}
5944
5945	/* If we allocated a current mask array, deallocate it now. */
5946	if (pcmask)
5947	{
5948	tmp = gfc_call_free (pcmask);
5949	gfc_add_expr_to_block (block, tmp);
5950	}
5951	}
5952
5953	/* Translate a simple WHERE construct or statement without dependencies.
5954	CBLOCK is the "then" clause of the WHERE statement, where CBLOCK->EXPR
5955	is the mask condition, and EBLOCK if non-NULL is the "else" clause.
5956	Currently both CBLOCK and EBLOCK are restricted to single assignments. */
5957
5958	static tree
5959	gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
5960	{
5961	stmtblock_t block, body;
5962	gfc_expr cond, tdst, tsrc, edst, *esrc;
5963	tree tmp, cexpr, tstmt, estmt;
5964	gfc_ss css, tdss, *tsss;
5965	gfc_se cse, tdse, tsse, edse, esse;
5966	gfc_loopinfo loop;
5967	gfc_ss *edss = 0;
5968	gfc_ss *esss = 0;
5969	bool maybe_workshare = false;
5970
5971	/* Allow the scalarizer to workshare simple where loops. */
5972	if ((ompws_flags & (OMPWS_WORKSHARE_FLAG1 \| OMPWS_SCALARIZER_BODY8))
5973	== OMPWS_WORKSHARE_FLAG1)
5974	{
5975	maybe_workshare = true;
5976	ompws_flags \|= OMPWS_SCALARIZER_WS4 \| OMPWS_SCALARIZER_BODY8;
5977	}
5978
5979	cond = cblock->expr1;
5980	tdst = cblock->next->expr1;
5981	tsrc = cblock->next->expr2;
5982	edst = eblock ? eblock->next->expr1 : NULL__null;
5983	esrc = eblock ? eblock->next->expr2 : NULL__null;
5984
5985	gfc_start_block (&block);
5986	gfc_init_loopinfo (&loop);
5987
5988	/* Handle the condition. */
5989	gfc_init_se (&cse, NULL__null);
5990	css = gfc_walk_expr (cond);
5991	gfc_add_ss_to_loop (&loop, css);
5992
5993	/* Handle the then-clause. */
5994	gfc_init_se (&tdse, NULL__null);
5995	gfc_init_se (&tsse, NULL__null);
5996	tdss = gfc_walk_expr (tdst);
5997	tsss = gfc_walk_expr (tsrc);
5998	if (tsss == gfc_ss_terminator)
5999	{
6000	tsss = gfc_get_scalar_ss (gfc_ss_terminator, tsrc);
6001	tsss->info->where = 1;
6002	}
6003	gfc_add_ss_to_loop (&loop, tdss);
6004	gfc_add_ss_to_loop (&loop, tsss);
6005
6006	if (eblock)
6007	{
6008	/* Handle the else clause. */
6009	gfc_init_se (&edse, NULL__null);
6010	gfc_init_se (&esse, NULL__null);
6011	edss = gfc_walk_expr (edst);
6012	esss = gfc_walk_expr (esrc);
6013	if (esss == gfc_ss_terminator)
6014	{
6015	esss = gfc_get_scalar_ss (gfc_ss_terminator, esrc);
6016	esss->info->where = 1;
6017	}
6018	gfc_add_ss_to_loop (&loop, edss);
6019	gfc_add_ss_to_loop (&loop, esss);
6020	}
6021
6022	gfc_conv_ss_startstride (&loop);
6023	gfc_conv_loop_setup (&loop, &tdst->where);
6024
6025	gfc_mark_ss_chain_used (css, 1);
6026	gfc_mark_ss_chain_used (tdss, 1);
6027	gfc_mark_ss_chain_used (tsss, 1);
6028	if (eblock)
6029	{
6030	gfc_mark_ss_chain_used (edss, 1);
6031	gfc_mark_ss_chain_used (esss, 1);
6032	}
6033
6034	gfc_start_scalarized_body (&loop, &body);
6035
6036	gfc_copy_loopinfo_to_se (&cse, &loop);
6037	gfc_copy_loopinfo_to_se (&tdse, &loop);
6038	gfc_copy_loopinfo_to_se (&tsse, &loop);
6039	cse.ss = css;
6040	tdse.ss = tdss;
6041	tsse.ss = tsss;
6042	if (eblock)
6043	{
6044	gfc_copy_loopinfo_to_se (&edse, &loop);
6045	gfc_copy_loopinfo_to_se (&esse, &loop);
6046	edse.ss = edss;
6047	esse.ss = esss;
6048	}
6049
6050	gfc_conv_expr (&cse, cond);
6051	gfc_add_block_to_block (&body, &cse.pre);
6052	cexpr = cse.expr;
6053
6054	gfc_conv_expr (&tsse, tsrc);
6055	if (tdss != gfc_ss_terminator && loop.temp_ss != NULL__null)
6056	gfc_conv_tmp_array_ref (&tdse);
6057	else
6058	gfc_conv_expr (&tdse, tdst);
6059
6060	if (eblock)
6061	{
6062	gfc_conv_expr (&esse, esrc);
6063	if (edss != gfc_ss_terminator && loop.temp_ss != NULL__null)
6064	gfc_conv_tmp_array_ref (&edse);
6065	else
6066	gfc_conv_expr (&edse, edst);
6067	}
6068
6069	tstmt = gfc_trans_scalar_assign (&tdse, &tsse, tdst->ts, false, true);
6070	estmt = eblock ? gfc_trans_scalar_assign (&edse, &esse, edst->ts,
6071	false, true)
6072	: build_empty_stmt (input_location);
6073	tmp = build3_v (COND_EXPR, cexpr, tstmt, estmt)fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE ], cexpr, tstmt, estmt);
6074	gfc_add_expr_to_block (&body, tmp);
6075	gfc_add_block_to_block (&body, &cse.post);
6076
6077	if (maybe_workshare)
6078	ompws_flags &= ~OMPWS_SCALARIZER_BODY8;
6079	gfc_trans_scalarizing_loops (&loop, &body);
6080	gfc_add_block_to_block (&block, &loop.pre);
6081	gfc_add_block_to_block (&block, &loop.post);
6082	gfc_cleanup_loop (&loop);
6083
6084	return gfc_finish_block (&block);
6085	}
6086
6087	/* As the WHERE or WHERE construct statement can be nested, we call
6088	gfc_trans_where_2 to do the translation, and pass the initial
6089	NULL values for both the control mask and the pending control mask. */
6090
6091	tree
6092	gfc_trans_where (gfc_code * code)
6093	{
6094	stmtblock_t block;
6095	gfc_code *cblock;
6096	gfc_code *eblock;
6097
6098	cblock = code->block;
6099	if (cblock->next
6100	&& cblock->next->op == EXEC_ASSIGN
6101	&& !cblock->next->next)
6102	{
6103	eblock = cblock->block;
6104	if (!eblock)
6105	{
6106	/* A simple "WHERE (cond) x = y" statement or block is
6107	dependence free if cond is not dependent upon writing x,
6108	and the source y is unaffected by the destination x. */
6109	if (!gfc_check_dependency (cblock->next->expr1,
6110	cblock->expr1, 0)
6111	&& !gfc_check_dependency (cblock->next->expr1,
6112	cblock->next->expr2, 0))
6113	return gfc_trans_where_3 (cblock, NULL__null);
6114	}
6115	else if (!eblock->expr1
6116	&& !eblock->block
6117	&& eblock->next
6118	&& eblock->next->op == EXEC_ASSIGN
6119	&& !eblock->next->next)
6120	{
6121	/* A simple "WHERE (cond) x1 = y1 ELSEWHERE x2 = y2 ENDWHERE"
6122	block is dependence free if cond is not dependent on writes
6123	to x1 and x2, y1 is not dependent on writes to x2, and y2
6124	is not dependent on writes to x1, and both y's are not
6125	dependent upon their own x's. In addition to this, the
6126	final two dependency checks below exclude all but the same
6127	array reference if the where and elswhere destinations
6128	are the same. In short, this is VERY conservative and this
6129	is needed because the two loops, required by the standard
6130	are coalesced in gfc_trans_where_3. */
6131	if (!gfc_check_dependency (cblock->next->expr1,