Bug Summary

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

Annotated Source Code

Press '?' to see keyboard shortcuts

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

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

<
1/* Backend function setup
2 Copyright (C) 2002-2021 Free Software Foundation, Inc.
3 Contributed by Paul Brook
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21/* trans-decl.c -- Handling of backend function and variable decls, etc */
22
23#include "config.h"
24#include "system.h"
25#include "coretypes.h"
26#include "target.h"
27#include "function.h"
28#include "tree.h"
29#include "gfortran.h"
30#include "gimple-expr.h" /* For create_tmp_var_raw. */
31#include "trans.h"
32#include "stringpool.h"
33#include "cgraph.h"
34#include "fold-const.h"
35#include "stor-layout.h"
36#include "varasm.h"
37#include "attribs.h"
38#include "dumpfile.h"
39#include "toplev.h" /* For announce_function. */
40#include "debug.h"
41#include "constructor.h"
42#include "trans-types.h"
43#include "trans-array.h"
44#include "trans-const.h"
45#include "intrinsic.h" /* For gfc_resolve_index_func. */
46/* Only for gfc_trans_code. Shouldn't need to include this. */
47#include "trans-stmt.h"
48#include "gomp-constants.h"
49#include "gimplify.h"
50#include "omp-general.h"
51#include "attr-fnspec.h"
52
53#define MAX_LABEL_VALUE99999 99999
54
55
56/* Holds the result of the function if no result variable specified. */
57
58static GTY(()) tree current_fake_result_decl;
59static GTY(()) tree parent_fake_result_decl;
60
61
62/* Holds the variable DECLs for the current function. */
63
64static GTY(()) tree saved_function_decls;
65static GTY(()) tree saved_parent_function_decls;
66
67/* Holds the variable DECLs that are locals. */
68
69static GTY(()) tree saved_local_decls;
70
71/* The namespace of the module we're currently generating. Only used while
72 outputting decls for module variables. Do not rely on this being set. */
73
74static gfc_namespace *module_namespace;
75
76/* The currently processed procedure symbol. */
77static gfc_symbol* current_procedure_symbol = NULL__null;
78
79/* The currently processed module. */
80static struct module_htab_entry *cur_module;
81
82/* With -fcoarray=lib: For generating the registering call
83 of static coarrays. */
84static bool has_coarray_vars;
85static stmtblock_t caf_init_block;
86
87
88/* List of static constructor functions. */
89
90tree gfc_static_ctors;
91
92
93/* Whether we've seen a symbol from an IEEE module in the namespace. */
94static int seen_ieee_symbol;
95
96/* Function declarations for builtin library functions. */
97
98tree gfor_fndecl_pause_numeric;
99tree gfor_fndecl_pause_string;
100tree gfor_fndecl_stop_numeric;
101tree gfor_fndecl_stop_string;
102tree gfor_fndecl_error_stop_numeric;
103tree gfor_fndecl_error_stop_string;
104tree gfor_fndecl_runtime_error;
105tree gfor_fndecl_runtime_error_at;
106tree gfor_fndecl_runtime_warning_at;
107tree gfor_fndecl_os_error_at;
108tree gfor_fndecl_generate_error;
109tree gfor_fndecl_set_args;
110tree gfor_fndecl_set_fpe;
111tree gfor_fndecl_set_options;
112tree gfor_fndecl_set_convert;
113tree gfor_fndecl_set_record_marker;
114tree gfor_fndecl_set_max_subrecord_length;
115tree gfor_fndecl_ctime;
116tree gfor_fndecl_fdate;
117tree gfor_fndecl_ttynam;
118tree gfor_fndecl_in_pack;
119tree gfor_fndecl_in_unpack;
120tree gfor_fndecl_cfi_to_gfc;
121tree gfor_fndecl_gfc_to_cfi;
122tree gfor_fndecl_associated;
123tree gfor_fndecl_system_clock4;
124tree gfor_fndecl_system_clock8;
125tree gfor_fndecl_ieee_procedure_entry;
126tree gfor_fndecl_ieee_procedure_exit;
127
128/* Coarray run-time library function decls. */
129tree gfor_fndecl_caf_init;
130tree gfor_fndecl_caf_finalize;
131tree gfor_fndecl_caf_this_image;
132tree gfor_fndecl_caf_num_images;
133tree gfor_fndecl_caf_register;
134tree gfor_fndecl_caf_deregister;
135tree gfor_fndecl_caf_get;
136tree gfor_fndecl_caf_send;
137tree gfor_fndecl_caf_sendget;
138tree gfor_fndecl_caf_get_by_ref;
139tree gfor_fndecl_caf_send_by_ref;
140tree gfor_fndecl_caf_sendget_by_ref;
141tree gfor_fndecl_caf_sync_all;
142tree gfor_fndecl_caf_sync_memory;
143tree gfor_fndecl_caf_sync_images;
144tree gfor_fndecl_caf_stop_str;
145tree gfor_fndecl_caf_stop_numeric;
146tree gfor_fndecl_caf_error_stop;
147tree gfor_fndecl_caf_error_stop_str;
148tree gfor_fndecl_caf_atomic_def;
149tree gfor_fndecl_caf_atomic_ref;
150tree gfor_fndecl_caf_atomic_cas;
151tree gfor_fndecl_caf_atomic_op;
152tree gfor_fndecl_caf_lock;
153tree gfor_fndecl_caf_unlock;
154tree gfor_fndecl_caf_event_post;
155tree gfor_fndecl_caf_event_wait;
156tree gfor_fndecl_caf_event_query;
157tree gfor_fndecl_caf_fail_image;
158tree gfor_fndecl_caf_failed_images;
159tree gfor_fndecl_caf_image_status;
160tree gfor_fndecl_caf_stopped_images;
161tree gfor_fndecl_caf_form_team;
162tree gfor_fndecl_caf_change_team;
163tree gfor_fndecl_caf_end_team;
164tree gfor_fndecl_caf_sync_team;
165tree gfor_fndecl_caf_get_team;
166tree gfor_fndecl_caf_team_number;
167tree gfor_fndecl_co_broadcast;
168tree gfor_fndecl_co_max;
169tree gfor_fndecl_co_min;
170tree gfor_fndecl_co_reduce;
171tree gfor_fndecl_co_sum;
172tree gfor_fndecl_caf_is_present;
173
174
175/* Math functions. Many other math functions are handled in
176 trans-intrinsic.c. */
177
178gfc_powdecl_list gfor_fndecl_math_powi[4][3];
179tree gfor_fndecl_math_ishftc4;
180tree gfor_fndecl_math_ishftc8;
181tree gfor_fndecl_math_ishftc16;
182
183
184/* String functions. */
185
186tree gfor_fndecl_compare_string;
187tree gfor_fndecl_concat_string;
188tree gfor_fndecl_string_len_trim;
189tree gfor_fndecl_string_index;
190tree gfor_fndecl_string_scan;
191tree gfor_fndecl_string_verify;
192tree gfor_fndecl_string_trim;
193tree gfor_fndecl_string_minmax;
194tree gfor_fndecl_adjustl;
195tree gfor_fndecl_adjustr;
196tree gfor_fndecl_select_string;
197tree gfor_fndecl_compare_string_char4;
198tree gfor_fndecl_concat_string_char4;
199tree gfor_fndecl_string_len_trim_char4;
200tree gfor_fndecl_string_index_char4;
201tree gfor_fndecl_string_scan_char4;
202tree gfor_fndecl_string_verify_char4;
203tree gfor_fndecl_string_trim_char4;
204tree gfor_fndecl_string_minmax_char4;
205tree gfor_fndecl_adjustl_char4;
206tree gfor_fndecl_adjustr_char4;
207tree gfor_fndecl_select_string_char4;
208
209
210/* Conversion between character kinds. */
211tree gfor_fndecl_convert_char1_to_char4;
212tree gfor_fndecl_convert_char4_to_char1;
213
214
215/* Other misc. runtime library functions. */
216tree gfor_fndecl_size0;
217tree gfor_fndecl_size1;
218tree gfor_fndecl_iargc;
219tree gfor_fndecl_kill;
220tree gfor_fndecl_kill_sub;
221tree gfor_fndecl_is_contiguous0;
222
223
224/* Intrinsic functions implemented in Fortran. */
225tree gfor_fndecl_sc_kind;
226tree gfor_fndecl_si_kind;
227tree gfor_fndecl_sr_kind;
228
229/* BLAS gemm functions. */
230tree gfor_fndecl_sgemm;
231tree gfor_fndecl_dgemm;
232tree gfor_fndecl_cgemm;
233tree gfor_fndecl_zgemm;
234
235/* RANDOM_INIT function. */
236tree gfor_fndecl_random_init;
237
238static void
239gfc_add_decl_to_parent_function (tree decl)
240{
241 gcc_assert (decl)((void)(!(decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 241, __FUNCTION__), 0 : 0))
;
242 DECL_CONTEXT (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 242, __FUNCTION__))->decl_minimal.context)
= DECL_CONTEXT (current_function_decl)((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 242, __FUNCTION__))->decl_minimal.context)
;
243 DECL_NONLOCAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 243, __FUNCTION__))->decl_common.nonlocal_flag)
= 1;
244 DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 244, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 244, __FUNCTION__))->common.chain))
= saved_parent_function_decls;
245 saved_parent_function_decls = decl;
246}
247
248void
249gfc_add_decl_to_function (tree decl)
250{
251 gcc_assert (decl)((void)(!(decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 251, __FUNCTION__), 0 : 0))
;
252 TREE_USED (decl)((decl)->base.used_flag) = 1;
253 DECL_CONTEXT (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 253, __FUNCTION__))->decl_minimal.context)
= current_function_decl;
254 DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 254, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 254, __FUNCTION__))->common.chain))
= saved_function_decls;
255 saved_function_decls = decl;
256}
257
258static void
259add_decl_as_local (tree decl)
260{
261 gcc_assert (decl)((void)(!(decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 261, __FUNCTION__), 0 : 0))
;
262 TREE_USED (decl)((decl)->base.used_flag) = 1;
263 DECL_CONTEXT (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 263, __FUNCTION__))->decl_minimal.context)
= current_function_decl;
264 DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 264, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 264, __FUNCTION__))->common.chain))
= saved_local_decls;
265 saved_local_decls = decl;
266}
267
268
269/* Build a backend label declaration. Set TREE_USED for named labels.
270 The context of the label is always the current_function_decl. All
271 labels are marked artificial. */
272
273tree
274gfc_build_label_decl (tree label_id)
275{
276 /* 2^32 temporaries should be enough. */
277 static unsigned int tmp_num = 1;
278 tree label_decl;
279 char *label_name;
280
281 if (label_id == NULL_TREE(tree) __null)
282 {
283 /* Build an internal label name. */
284 ASM_FORMAT_PRIVATE_NAME (label_name, "L", tmp_num++)do { const char *const name_ = ("L"); char *const output_ = (
label_name) = (char *) __builtin_alloca(strlen (name_) + 32);
sprintf (output_, "%s.%lu", name_, (unsigned long)(tmp_num++
)); } while (0)
;
285 label_id = get_identifier (label_name)(__builtin_constant_p (label_name) ? get_identifier_with_length
((label_name), strlen (label_name)) : get_identifier (label_name
))
;
286 }
287 else
288 label_name = NULL__null;
289
290 /* Build the LABEL_DECL node. Labels have no type. */
291 label_decl = build_decl (input_location,
292 LABEL_DECL, label_id, void_type_nodeglobal_trees[TI_VOID_TYPE]);
293 DECL_CONTEXT (label_decl)((contains_struct_check ((label_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 293, __FUNCTION__))->decl_minimal.context)
= current_function_decl;
294 SET_DECL_MODE (label_decl, VOIDmode)((contains_struct_check ((label_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 294, __FUNCTION__))->decl_common.mode = (((void) 0, E_VOIDmode
)))
;
295
296 /* We always define the label as used, even if the original source
297 file never references the label. We don't want all kinds of
298 spurious warnings for old-style Fortran code with too many
299 labels. */
300 TREE_USED (label_decl)((label_decl)->base.used_flag) = 1;
301
302 DECL_ARTIFICIAL (label_decl)((contains_struct_check ((label_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 302, __FUNCTION__))->decl_common.artificial_flag)
= 1;
303 return label_decl;
304}
305
306
307/* Set the backend source location of a decl. */
308
309void
310gfc_set_decl_location (tree decl, locus * loc)
311{
312 DECL_SOURCE_LOCATION (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 312, __FUNCTION__))->decl_minimal.locus)
= gfc_get_location (loc);
313}
314
315
316/* Return the backend label declaration for a given label structure,
317 or create it if it doesn't exist yet. */
318
319tree
320gfc_get_label_decl (gfc_st_label * lp)
321{
322 if (lp->backend_decl)
323 return lp->backend_decl;
324 else
325 {
326 char label_name[GFC_MAX_SYMBOL_LEN63 + 1];
327 tree label_decl;
328
329 /* Validate the label declaration from the front end. */
330 gcc_assert (lp != NULL && lp->value <= MAX_LABEL_VALUE)((void)(!(lp != __null && lp->value <= 99999) ?
fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 330, __FUNCTION__), 0 : 0))
;
331
332 /* Build a mangled name for the label. */
333 sprintf (label_name, "__label_%.6d", lp->value);
334
335 /* Build the LABEL_DECL node. */
336 label_decl = gfc_build_label_decl (get_identifier (label_name)(__builtin_constant_p (label_name) ? get_identifier_with_length
((label_name), strlen (label_name)) : get_identifier (label_name
))
);
337
338 /* Tell the debugger where the label came from. */
339 if (lp->value <= MAX_LABEL_VALUE99999) /* An internal label. */
340 gfc_set_decl_location (label_decl, &lp->where);
341 else
342 DECL_ARTIFICIAL (label_decl)((contains_struct_check ((label_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 342, __FUNCTION__))->decl_common.artificial_flag)
= 1;
343
344 /* Store the label in the label list and return the LABEL_DECL. */
345 lp->backend_decl = label_decl;
346 return label_decl;
347 }
348}
349
350/* Return the name of an identifier. */
351
352static const char *
353sym_identifier (gfc_symbol *sym)
354{
355 if (sym->attr.is_main_program && strcmp (sym->name, "main") == 0)
356 return "MAIN__";
357 else
358 return sym->name;
359}
360
361/* Convert a gfc_symbol to an identifier of the same name. */
362
363static tree
364gfc_sym_identifier (gfc_symbol * sym)
365{
366 return get_identifier (sym_identifier (sym))(__builtin_constant_p (sym_identifier (sym)) ? get_identifier_with_length
((sym_identifier (sym)), strlen (sym_identifier (sym))) : get_identifier
(sym_identifier (sym)))
;
367}
368
369/* Construct mangled name from symbol name. */
370
371static const char *
372mangled_identifier (gfc_symbol *sym)
373{
374 gfc_symbol *proc = sym->ns->proc_name;
375 static char name[3*GFC_MAX_MANGLED_SYMBOL_LEN(63*3+5) + 14];
376 /* Prevent the mangling of identifiers that have an assigned
377 binding label (mainly those that are bind(c)). */
378
379 if (sym->attr.is_bind_c == 1 && sym->binding_label)
380 return sym->binding_label;
381
382 if (!sym->fn_result_spec
383 || (sym->module && !(proc && proc->attr.flavor == FL_PROCEDURE)))
384 {
385 if (sym->module == NULL__null)
386 return sym_identifier (sym);
387 else
388 snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
389 }
390 else
391 {
392 /* This is an entity that is actually local to a module procedure
393 that appears in the result specification expression. Since
394 sym->module will be a zero length string, we use ns->proc_name
395 to provide the module name instead. */
396 if (proc && proc->module)
397 snprintf (name, sizeof name, "__%s_MOD__%s_PROC_%s",
398 proc->module, proc->name, sym->name);
399 else
400 snprintf (name, sizeof name, "__%s_PROC_%s",
401 proc->name, sym->name);
402 }
403
404 return name;
405}
406
407/* Get mangled identifier, adding the symbol to the global table if
408 it is not yet already there. */
409
410static tree
411gfc_sym_mangled_identifier (gfc_symbol * sym)
412{
413 tree result;
414 gfc_gsymbol *gsym;
415 const char *name;
416
417 name = mangled_identifier (sym);
418 result = get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
;
419
420 gsym = gfc_find_gsymbol (gfc_gsym_root, name);
421 if (gsym == NULL__null)
422 {
423 gsym = gfc_get_gsymbol (name, false);
424 gsym->ns = sym->ns;
425 gsym->sym_name = sym->name;
426 }
427
428 return result;
429}
430
431/* Construct mangled function name from symbol name. */
432
433static tree
434gfc_sym_mangled_function_id (gfc_symbol * sym)
435{
436 int has_underscore;
437 char name[GFC_MAX_MANGLED_SYMBOL_LEN(63*3+5) + 1];
438
439 /* It may be possible to simply use the binding label if it's
440 provided, and remove the other checks. Then we could use it
441 for other things if we wished. */
442 if ((sym->attr.is_bind_c == 1 || sym->attr.is_iso_c == 1) &&
443 sym->binding_label)
444 /* use the binding label rather than the mangled name */
445 return get_identifier (sym->binding_label)(__builtin_constant_p (sym->binding_label) ? get_identifier_with_length
((sym->binding_label), strlen (sym->binding_label)) : get_identifier
(sym->binding_label))
;
446
447 if ((sym->module == NULL__null || sym->attr.proc == PROC_EXTERNAL
448 || (sym->module != NULL__null && (sym->attr.external
449 || sym->attr.if_source == IFSRC_IFBODY)))
450 && !sym->attr.module_procedure)
451 {
452 /* Main program is mangled into MAIN__. */
453 if (sym->attr.is_main_program)
454 return get_identifier ("MAIN__")(__builtin_constant_p ("MAIN__") ? get_identifier_with_length
(("MAIN__"), strlen ("MAIN__")) : get_identifier ("MAIN__"))
;
455
456 /* Intrinsic procedures are never mangled. */
457 if (sym->attr.proc == PROC_INTRINSIC)
458 return get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name))
;
459
460 if (flag_underscoringglobal_options.x_flag_underscoring)
461 {
462 has_underscore = strchr (sym->name, '_') != 0;
463 if (flag_second_underscoreglobal_options.x_flag_second_underscore && has_underscore)
464 snprintf (name, sizeof name, "%s__", sym->name);
465 else
466 snprintf (name, sizeof name, "%s_", sym->name);
467 return get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
;
468 }
469 else
470 return get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name))
;
471 }
472 else
473 {
474 snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
475 return get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
;
476 }
477}
478
479
480void
481gfc_set_decl_assembler_name (tree decl, tree name)
482{
483 tree target_mangled = targetm.mangle_decl_assembler_name (decl, name);
484 SET_DECL_ASSEMBLER_NAME (decl, target_mangled)overwrite_decl_assembler_name (decl, target_mangled);
485}
486
487
488/* Returns true if a variable of specified size should go on the stack. */
489
490int
491gfc_can_put_var_on_stack (tree size)
492{
493 unsigned HOST_WIDE_INTlong low;
494
495 if (!INTEGER_CST_P (size)(((enum tree_code) (size)->base.code) == INTEGER_CST))
496 return 0;
497
498 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size < 0)
499 return 1;
500
501 if (!tree_fits_uhwi_p (size))
502 return 0;
503
504 low = TREE_INT_CST_LOW (size)((unsigned long) (*tree_int_cst_elt_check ((size), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 504, __FUNCTION__)))
;
505 if (low > (unsigned HOST_WIDE_INTlong) flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size)
506 return 0;
507
508/* TODO: Set a per-function stack size limit. */
509
510 return 1;
511}
512
513
514/* gfc_finish_cray_pointee sets DECL_VALUE_EXPR for a Cray pointee to
515 an expression involving its corresponding pointer. There are
516 2 cases; one for variable size arrays, and one for everything else,
517 because variable-sized arrays require one fewer level of
518 indirection. */
519
520static void
521gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
522{
523 tree ptr_decl = gfc_get_symbol_decl (sym->cp_pointer);
524 tree value;
525
526 /* Parameters need to be dereferenced. */
527 if (sym->cp_pointer->attr.dummy)
528 ptr_decl = build_fold_indirect_ref_loc (input_location,
529 ptr_decl);
530
531 /* Check to see if we're dealing with a variable-sized array. */
532 if (sym->attr.dimension
533 && TREE_CODE (TREE_TYPE (decl))((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 533, __FUNCTION__))->typed.type))->base.code)
== POINTER_TYPE)
534 {
535 /* These decls will be dereferenced later, so we don't dereference
536 them here. */
537 value = convert (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 537, __FUNCTION__))->typed.type)
, ptr_decl);
538 }
539 else
540 {
541 ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 541, __FUNCTION__))->typed.type)
),
542 ptr_decl);
543 value = build_fold_indirect_ref_loc (input_location,
544 ptr_decl);
545 }
546
547 SET_DECL_VALUE_EXPR (decl, value)(decl_value_expr_insert ((contains_struct_check ((decl), (TS_DECL_WRTL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 547, __FUNCTION__)), value))
;
548 DECL_HAS_VALUE_EXPR_P (decl)((tree_check3 ((decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 548, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL)))
->decl_common.decl_flag_2)
= 1;
549 GFC_DECL_CRAY_POINTEE (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 549, __FUNCTION__))->decl_common.lang_flag_4)
= 1;
550}
551
552
553/* Finish processing of a declaration without an initial value. */
554
555static void
556gfc_finish_decl (tree decl)
557{
558 gcc_assert (TREE_CODE (decl) == PARM_DECL((void)(!(((enum tree_code) (decl)->base.code) == PARM_DECL
|| ((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 559, __FUNCTION__))->decl_common.initial) == (tree) __null
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 559, __FUNCTION__), 0 : 0))
559 || DECL_INITIAL (decl) == NULL_TREE)((void)(!(((enum tree_code) (decl)->base.code) == PARM_DECL
|| ((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 559, __FUNCTION__))->decl_common.initial) == (tree) __null
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 559, __FUNCTION__), 0 : 0))
;
560
561 if (!VAR_P (decl)(((enum tree_code) (decl)->base.code) == VAR_DECL))
562 return;
563
564 if (DECL_SIZE (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 564, __FUNCTION__))->decl_common.size)
== NULL_TREE(tree) __null
565 && TYPE_SIZE (TREE_TYPE (decl))((tree_class_check ((((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 565, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 565, __FUNCTION__))->type_common.size)
!= NULL_TREE(tree) __null)
566 layout_decl (decl, 0);
567
568 /* A few consistency checks. */
569 /* A static variable with an incomplete type is an error if it is
570 initialized. Also if it is not file scope. Otherwise, let it
571 through, but if it is not `extern' then it may cause an error
572 message later. */
573 /* An automatic variable with an incomplete type is an error. */
574
575 /* We should know the storage size. */
576 gcc_assert (DECL_SIZE (decl) != NULL_TREE((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 576, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__), 0 : 0))
577 || (TREE_STATIC (decl)((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 576, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__), 0 : 0))
578 ? (!DECL_INITIAL (decl) || !DECL_CONTEXT (decl))((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 576, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__), 0 : 0))
579 : DECL_EXTERNAL (decl)))((void)(!(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 576, __FUNCTION__))->decl_common.size) != (tree) __null ||
(((decl)->base.static_flag) ? (!((contains_struct_check (
(decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_common.initial) || !((contains_struct_check
((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 578, __FUNCTION__))->decl_minimal.context)) : ((contains_struct_check
((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__))->decl_common.decl_flag_1))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 579, __FUNCTION__), 0 : 0))
;
580
581 /* The storage size should be constant. */
582 gcc_assert ((!DECL_EXTERNAL (decl) && !TREE_STATIC (decl))((void)(!((!((contains_struct_check ((decl), (TS_DECL_COMMON)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 582, __FUNCTION__))->decl_common.decl_flag_1) &&
!((decl)->base.static_flag)) || !((contains_struct_check (
(decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 583, __FUNCTION__))->decl_common.size) || ((enum tree_code
) (((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 584, __FUNCTION__))->decl_common.size))->base.code) ==
INTEGER_CST) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 584, __FUNCTION__), 0 : 0))
583 || !DECL_SIZE (decl)((void)(!((!((contains_struct_check ((decl), (TS_DECL_COMMON)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 582, __FUNCTION__))->decl_common.decl_flag_1) &&
!((decl)->base.static_flag)) || !((contains_struct_check (
(decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 583, __FUNCTION__))->decl_common.size) || ((enum tree_code
) (((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 584, __FUNCTION__))->decl_common.size))->base.code) ==
INTEGER_CST) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 584, __FUNCTION__), 0 : 0))
584 || TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)((void)(!((!((contains_struct_check ((decl), (TS_DECL_COMMON)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 582, __FUNCTION__))->decl_common.decl_flag_1) &&
!((decl)->base.static_flag)) || !((contains_struct_check (
(decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 583, __FUNCTION__))->decl_common.size) || ((enum tree_code
) (((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 584, __FUNCTION__))->decl_common.size))->base.code) ==
INTEGER_CST) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 584, __FUNCTION__), 0 : 0))
;
585}
586
587
588/* Handle setting of GFC_DECL_SCALAR* on DECL. */
589
590void
591gfc_finish_decl_attrs (tree decl, symbol_attribute *attr)
592{
593 if (!attr->dimension && !attr->codimension)
594 {
595 /* Handle scalar allocatable variables. */
596 if (attr->allocatable)
597 {
598 gfc_allocate_lang_decl (decl);
599 GFC_DECL_SCALAR_ALLOCATABLE (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 599, __FUNCTION__))->decl_common.lang_specific)->scalar_allocatable
)
= 1;
600 }
601 /* Handle scalar pointer variables. */
602 if (attr->pointer)
603 {
604 gfc_allocate_lang_decl (decl);
605 GFC_DECL_SCALAR_POINTER (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 605, __FUNCTION__))->decl_common.lang_specific)->scalar_pointer
)
= 1;
606 }
607 }
608}
609
610
611/* Apply symbol attributes to a variable, and add it to the function scope. */
612
613static void
614gfc_finish_var_decl (tree decl, gfc_symbol * sym)
615{
616 tree new_type;
617
618 /* Set DECL_VALUE_EXPR for Cray Pointees. */
619 if (sym->attr.cray_pointee)
620 gfc_finish_cray_pointee (decl, sym);
621
622 /* TREE_ADDRESSABLE means the address of this variable is actually needed.
623 This is the equivalent of the TARGET variables.
624 We also need to set this if the variable is passed by reference in a
625 CALL statement. */
626 if (sym->attr.target)
627 TREE_ADDRESSABLE (decl)((decl)->base.addressable_flag) = 1;
628
629 /* If it wasn't used we wouldn't be getting it. */
630 TREE_USED (decl)((decl)->base.used_flag) = 1;
631
632 if (sym->attr.flavor == FL_PARAMETER
633 && (sym->attr.dimension || sym->ts.type == BT_DERIVED))
634 TREE_READONLY (decl)((non_type_check ((decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 634, __FUNCTION__))->base.readonly_flag)
= 1;
635
636 /* Chain this decl to the pending declarations. Don't do pushdecl()
637 because this would add them to the current scope rather than the
638 function scope. */
639 if (current_function_decl != NULL_TREE(tree) __null)
640 {
641 if (sym->ns->proc_name
642 && (sym->ns->proc_name->backend_decl == current_function_decl
643 || sym->result == sym))
644 gfc_add_decl_to_function (decl);
645 else if (sym->ns->proc_name
646 && sym->ns->proc_name->attr.flavor == FL_LABEL)
647 /* This is a BLOCK construct. */
648 add_decl_as_local (decl);
649 else
650 gfc_add_decl_to_parent_function (decl);
651 }
652
653 if (sym->attr.cray_pointee)
654 return;
655
656 if(sym->attr.is_bind_c == 1 && sym->binding_label)
657 {
658 /* We need to put variables that are bind(c) into the common
659 segment of the object file, because this is what C would do.
660 gfortran would typically put them in either the BSS or
661 initialized data segments, and only mark them as common if
662 they were part of common blocks. However, if they are not put
663 into common space, then C cannot initialize global Fortran
664 variables that it interoperates with and the draft says that
665 either Fortran or C should be able to initialize it (but not
666 both, of course.) (J3/04-007, section 15.3). */
667 TREE_PUBLIC(decl)((decl)->base.public_flag) = 1;
668 DECL_COMMON(decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 668, __FUNCTION__))->decl_with_vis.common_flag)
= 1;
669 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
670 {
671 DECL_VISIBILITY (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 671, __FUNCTION__))->decl_with_vis.visibility)
= VISIBILITY_HIDDEN;
672 DECL_VISIBILITY_SPECIFIED (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 672, __FUNCTION__))->decl_with_vis.visibility_specified)
= true;
673 }
674 }
675
676 /* If a variable is USE associated, it's always external. */
677 if (sym->attr.use_assoc || sym->attr.used_in_submodule)
678 {
679 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 679, __FUNCTION__))->decl_common.decl_flag_1)
= 1;
680 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
681 }
682 else if (sym->fn_result_spec && !sym->ns->proc_name->module)
683 {
684
685 if (sym->ns->proc_name->attr.if_source != IFSRC_DECL)
686 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 686, __FUNCTION__))->decl_common.decl_flag_1)
= 1;
687 else
688 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
689
690 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
691 }
692 else if (sym->module && !sym->attr.result && !sym->attr.dummy)
693 {
694 /* TODO: Don't set sym->module for result or dummy variables. */
695 gcc_assert (current_function_decl == NULL_TREE || sym->result == sym)((void)(!(current_function_decl == (tree) __null || sym->result
== sym) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 695, __FUNCTION__), 0 : 0))
;
696
697 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
698 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
699 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
700 {
701 DECL_VISIBILITY (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 701, __FUNCTION__))->decl_with_vis.visibility)
= VISIBILITY_HIDDEN;
702 DECL_VISIBILITY_SPECIFIED (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 702, __FUNCTION__))->decl_with_vis.visibility_specified)
= true;
703 }
704 }
705
706 /* Derived types are a bit peculiar because of the possibility of
707 a default initializer; this must be applied each time the variable
708 comes into scope it therefore need not be static. These variables
709 are SAVE_NONE but have an initializer. Otherwise explicitly
710 initialized variables are SAVE_IMPLICIT and explicitly saved are
711 SAVE_EXPLICIT. */
712 if (!sym->attr.use_assoc
713 && (sym->attr.save != SAVE_NONE || sym->attr.data
714 || (sym->value && sym->ns->proc_name->attr.is_main_program)
715 || (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
716 && sym->attr.codimension && !sym->attr.allocatable)))
717 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
718
719 /* If derived-type variables with DTIO procedures are not made static
720 some bits of code referencing them get optimized away.
721 TODO Understand why this is so and fix it. */
722 if (!sym->attr.use_assoc
723 && ((sym->ts.type == BT_DERIVED
724 && sym->ts.u.derived->attr.has_dtio_procs)
725 || (sym->ts.type == BT_CLASS
726 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived->attr.has_dtio_procs)))
727 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
728
729 /* Treat asynchronous variables the same as volatile, for now. */
730 if (sym->attr.volatile_ || sym->attr.asynchronous)
731 {
732 TREE_THIS_VOLATILE (decl)((decl)->base.volatile_flag) = 1;
733 TREE_SIDE_EFFECTS (decl)((non_type_check ((decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 733, __FUNCTION__))->base.side_effects_flag)
= 1;
734 new_type = build_qualified_type (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 734, __FUNCTION__))->typed.type)
, TYPE_QUAL_VOLATILE);
735 TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 735, __FUNCTION__))->typed.type)
= new_type;
736 }
737
738 /* Keep variables larger than max-stack-var-size off stack. */
739 if (!(sym->ns->proc_name && sym->ns->proc_name->attr.recursive)
740 && !sym->attr.automatic
741 && INTEGER_CST_P (DECL_SIZE_UNIT (decl))(((enum tree_code) (((contains_struct_check ((decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 741, __FUNCTION__))->decl_common.size_unit))->base.code
) == INTEGER_CST)
742 && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 742, __FUNCTION__))->decl_common.size_unit)
)
743 /* Put variable length auto array pointers always into stack. */
744 && (TREE_CODE (TREE_TYPE (decl))((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 744, __FUNCTION__))->typed.type))->base.code)
!= POINTER_TYPE
745 || sym->attr.dimension == 0
746 || sym->as->type != AS_EXPLICIT
747 || sym->attr.pointer
748 || sym->attr.allocatable)
749 && !DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 749, __FUNCTION__))->decl_common.artificial_flag)
)
750 {
751 if (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size > 0)
752 gfc_warning (OPT_Wsurprising,
753 "Array %qs at %L is larger than limit set by"
754 " %<-fmax-stack-var-size=%>, moved from stack to static"
755 " storage. This makes the procedure unsafe when called"
756 " recursively, or concurrently from multiple threads."
757 " Consider using %<-frecursive%>, or increase the"
758 " %<-fmax-stack-var-size=%> limit, or change the code to"
759 " use an ALLOCATABLE array.",
760 sym->name, &sym->declared_at);
761
762 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
763
764 /* Because the size of this variable isn't known until now, we may have
765 greedily added an initializer to this variable (in build_init_assign)
766 even though the max-stack-var-size indicates the variable should be
767 static. Therefore we rip out the automatic initializer here and
768 replace it with a static one. */
769 gfc_symtree *st = gfc_find_symtree (sym->ns->sym_root, sym->name);
770 gfc_code *prev = NULL__null;
771 gfc_code *code = sym->ns->code;
772 while (code && code->op == EXEC_INIT_ASSIGN)
773 {
774 /* Look for an initializer meant for this symbol. */
775 if (code->expr1->symtree == st)
776 {
777 if (prev)
778 prev->next = code->next;
779 else
780 sym->ns->code = code->next;
781
782 break;
783 }
784
785 prev = code;
786 code = code->next;
787 }
788 if (code && code->op == EXEC_INIT_ASSIGN)
789 {
790 /* Keep the init expression for a static initializer. */
791 sym->value = code->expr2;
792 /* Cleanup the defunct code object, without freeing the init expr. */
793 code->expr2 = NULL__null;
794 gfc_free_statement (code);
795 free (code);
796 }
797 }
798
799 /* Handle threadprivate variables. */
800 if (sym->attr.threadprivate
801 && (TREE_STATIC (decl)((decl)->base.static_flag) || DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 801, __FUNCTION__))->decl_common.decl_flag_1)
))
802 set_decl_tls_model (decl, decl_default_tls_model (decl));
803
804 gfc_finish_decl_attrs (decl, &sym->attr);
805}
806
807
808/* Allocate the lang-specific part of a decl. */
809
810void
811gfc_allocate_lang_decl (tree decl)
812{
813 if (DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 813, __FUNCTION__))->decl_common.lang_specific)
== NULL__null)
814 DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 814, __FUNCTION__))->decl_common.lang_specific)
= ggc_cleared_alloc<struct lang_decl> ();
815}
816
817/* Remember a symbol to generate initialization/cleanup code at function
818 entry/exit. */
819
820static void
821gfc_defer_symbol_init (gfc_symbol * sym)
822{
823 gfc_symbol *p;
824 gfc_symbol *last;
825 gfc_symbol *head;
826
827 /* Don't add a symbol twice. */
828 if (sym->tlink)
829 return;
830
831 last = head = sym->ns->proc_name;
832 p = last->tlink;
833
834 /* Make sure that setup code for dummy variables which are used in the
835 setup of other variables is generated first. */
836 if (sym->attr.dummy)
837 {
838 /* Find the first dummy arg seen after us, or the first non-dummy arg.
839 This is a circular list, so don't go past the head. */
840 while (p != head
841 && (!p->attr.dummy || p->dummy_order > sym->dummy_order))
842 {
843 last = p;
844 p = p->tlink;
845 }
846 }
847 /* Insert in between last and p. */
848 last->tlink = sym;
849 sym->tlink = p;
850}
851
852
853/* Used in gfc_get_symbol_decl and gfc_get_derived_type to obtain the
854 backend_decl for a module symbol, if it all ready exists. If the
855 module gsymbol does not exist, it is created. If the symbol does
856 not exist, it is added to the gsymbol namespace. Returns true if
857 an existing backend_decl is found. */
858
859bool
860gfc_get_module_backend_decl (gfc_symbol *sym)
861{
862 gfc_gsymbol *gsym;
863 gfc_symbol *s;
864 gfc_symtree *st;
865
866 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module);
867
868 if (!gsym || (gsym->ns && gsym->type == GSYM_MODULE))
869 {
870 st = NULL__null;
871 s = NULL__null;
872
873 /* Check for a symbol with the same name. */
874 if (gsym)
875 gfc_find_symbol (sym->name, gsym->ns, 0, &s);
876
877 if (!s)
878 {
879 if (!gsym)
880 {
881 gsym = gfc_get_gsymbol (sym->module, false);
882 gsym->type = GSYM_MODULE;
883 gsym->ns = gfc_get_namespace (NULL__null, 0);
884 }
885
886 st = gfc_new_symtree (&gsym->ns->sym_root, sym->name);
887 st->n.sym = sym;
888 sym->refs++;
889 }
890 else if (gfc_fl_struct (sym->attr.flavor)((sym->attr.flavor) == FL_DERIVED || (sym->attr.flavor)
== FL_UNION || (sym->attr.flavor) == FL_STRUCT)
)
891 {
892 if (s && s->attr.flavor == FL_PROCEDURE)
893 {
894 gfc_interface *intr;
895 gcc_assert (s->attr.generic)((void)(!(s->attr.generic) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 895, __FUNCTION__), 0 : 0))
;
896 for (intr = s->generic; intr; intr = intr->next)
897 if (gfc_fl_struct (intr->sym->attr.flavor)((intr->sym->attr.flavor) == FL_DERIVED || (intr->sym
->attr.flavor) == FL_UNION || (intr->sym->attr.flavor
) == FL_STRUCT)
)
898 {
899 s = intr->sym;
900 break;
901 }
902 }
903
904 /* Normally we can assume that s is a derived-type symbol since it
905 shares a name with the derived-type sym. However if sym is a
906 STRUCTURE, it may in fact share a name with any other basic type
907 variable. If s is in fact of derived type then we can continue
908 looking for a duplicate type declaration. */
909 if (sym->attr.flavor == FL_STRUCT && s->ts.type == BT_DERIVED)
910 {
911 s = s->ts.u.derived;
912 }
913
914 if (gfc_fl_struct (s->attr.flavor)((s->attr.flavor) == FL_DERIVED || (s->attr.flavor) == FL_UNION
|| (s->attr.flavor) == FL_STRUCT)
&& !s->backend_decl)
915 {
916 if (s->attr.flavor == FL_UNION)
917 s->backend_decl = gfc_get_union_type (s);
918 else
919 s->backend_decl = gfc_get_derived_type (s);
920 }
921 gfc_copy_dt_decls_ifequal (s, sym, true);
922 return true;
923 }
924 else if (s->backend_decl)
925 {
926 if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
927 gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived,
928 true);
929 else if (sym->ts.type == BT_CHARACTER)
930 sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;
931 sym->backend_decl = s->backend_decl;
932 return true;
933 }
934 }
935 return false;
936}
937
938
939/* Create an array index type variable with function scope. */
940
941static tree
942create_index_var (const char * pfx, int nest)
943{
944 tree decl;
945
946 decl = gfc_create_var_np (gfc_array_index_type, pfx);
947 if (nest)
948 gfc_add_decl_to_parent_function (decl);
949 else
950 gfc_add_decl_to_function (decl);
951 return decl;
952}
953
954
955/* Create variables to hold all the non-constant bits of info for a
956 descriptorless array. Remember these in the lang-specific part of the
957 type. */
958
959static void
960gfc_build_qualified_array (tree decl, gfc_symbol * sym)
961{
962 tree type;
963 int dim;
964 int nest;
965 gfc_namespace* procns;
966 symbol_attribute *array_attr;
967 gfc_array_spec *as;
968 bool is_classarray = IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer)
;
969
970 type = TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 970, __FUNCTION__))->typed.type)
;
971 array_attr = is_classarray ? &CLASS_DATA (sym)sym->ts.u.derived->components->attr : &sym->attr;
972 as = is_classarray ? CLASS_DATA (sym)sym->ts.u.derived->components->as : sym->as;
973
974 /* We just use the descriptor, if there is one. */
975 if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 975, __FUNCTION__))->type_common.lang_flag_1)
)
976 return;
977
978 gcc_assert (GFC_ARRAY_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 978, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 978, __FUNCTION__), 0 : 0))
;
979 procns = gfc_find_proc_namespace (sym->ns);
980 nest = (procns->proc_name->backend_decl != current_function_decl)
981 && !sym->attr.contained;
982
983 if (array_attr->codimension && flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
984 && as->type != AS_ASSUMED_SHAPE
985 && GFC_TYPE_ARRAY_CAF_TOKEN (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 985, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token)
== NULL_TREE(tree) __null)
986 {
987 tree token;
988 tree token_type = build_qualified_type (pvoid_type_node,
989 TYPE_QUAL_RESTRICT);
990
991 if (sym->module && (sym->attr.use_assoc
992 || sym->ns->proc_name->attr.flavor == FL_MODULE))
993 {
994 tree token_name
995 = get_identifier (gfc_get_string (GFC_PREFIX ("caf_token%s"),(__builtin_constant_p (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))) ? get_identifier_with_length ((gfc_get_string ("_F." "caf_token%s"
, ((const char *) (tree_check ((gfc_sym_mangled_identifier (sym
)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))), strlen (gfc_get_string ("_F." "caf_token%s", ((const char
*) (tree_check ((gfc_sym_mangled_identifier (sym)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)))) : get_identifier (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))))
996 IDENTIFIER_POINTER (gfc_sym_mangled_identifier (sym))))(__builtin_constant_p (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))) ? get_identifier_with_length ((gfc_get_string ("_F." "caf_token%s"
, ((const char *) (tree_check ((gfc_sym_mangled_identifier (sym
)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))), strlen (gfc_get_string ("_F." "caf_token%s", ((const char
*) (tree_check ((gfc_sym_mangled_identifier (sym)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)))) : get_identifier (gfc_get_string ("_F." "caf_token%s", (
(const char *) (tree_check ((gfc_sym_mangled_identifier (sym)
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 996, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
))))
;
997 token = build_decl (DECL_SOURCE_LOCATION (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 997, __FUNCTION__))->decl_minimal.locus)
, VAR_DECL, token_name,
998 token_type);
999 if (sym->attr.use_assoc)
1000 DECL_EXTERNAL (token)((contains_struct_check ((token), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1000, __FUNCTION__))->decl_common.decl_flag_1)
= 1;
1001 else
1002 TREE_STATIC (token)((token)->base.static_flag) = 1;
1003
1004 TREE_PUBLIC (token)((token)->base.public_flag) = 1;
1005
1006 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
1007 {
1008 DECL_VISIBILITY (token)((contains_struct_check ((token), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1008, __FUNCTION__))->decl_with_vis.visibility)
= VISIBILITY_HIDDEN;
1009 DECL_VISIBILITY_SPECIFIED (token)((contains_struct_check ((token), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1009, __FUNCTION__))->decl_with_vis.visibility_specified
)
= true;
1010 }
1011 }
1012 else
1013 {
1014 token = gfc_create_var_np (token_type, "caf_token");
1015 TREE_STATIC (token)((token)->base.static_flag) = 1;
1016 }
1017
1018 GFC_TYPE_ARRAY_CAF_TOKEN (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1018, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token)
= token;
1019 DECL_ARTIFICIAL (token)((contains_struct_check ((token), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1019, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1020 DECL_NONALIASED (token)((tree_check ((token), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1020, __FUNCTION__, (VAR_DECL)))->base.nothrow_flag)
= 1;
1021
1022 if (sym->module && !sym->attr.use_assoc)
1023 {
1024 pushdecl (token);
1025 DECL_CONTEXT (token)((contains_struct_check ((token), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1025, __FUNCTION__))->decl_minimal.context)
= sym->ns->proc_name->backend_decl;
1026 gfc_module_add_decl (cur_module, token);
1027 }
1028 else if (sym->attr.host_assoc
1029 && TREE_CODE (DECL_CONTEXT (current_function_decl))((enum tree_code) (((contains_struct_check ((current_function_decl
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1029, __FUNCTION__))->decl_minimal.context))->base.code
)
1030 != TRANSLATION_UNIT_DECL)
1031 gfc_add_decl_to_parent_function (token);
1032 else
1033 gfc_add_decl_to_function (token);
1034 }
1035
1036 for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1036, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
; dim++)
1037 {
1038 if (GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1038, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim])
== NULL_TREE(tree) __null)
1039 {
1040 GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1040, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim])
= create_index_var ("lbound", nest);
1041 TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim))(((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1041, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]))->base.nowarning_flag)
= 1;
1042 }
1043 /* Don't try to use the unknown bound for assumed shape arrays. */
1044 if (GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1044, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim])
== NULL_TREE(tree) __null
1045 && (as->type != AS_ASSUMED_SIZE
1046 || dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1046, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
- 1))
1047 {
1048 GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1048, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim])
= create_index_var ("ubound", nest);
1049 TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim))(((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1049, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]))->base.nowarning_flag)
= 1;
1050 }
1051
1052 if (GFC_TYPE_ARRAY_STRIDE (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1052, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[dim])
== NULL_TREE(tree) __null)
1053 {
1054 GFC_TYPE_ARRAY_STRIDE (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1054, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[dim])
= create_index_var ("stride", nest);
1055 TREE_NO_WARNING (GFC_TYPE_ARRAY_STRIDE (type, dim))(((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1055, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[dim]))->base.nowarning_flag)
= 1;
1056 }
1057 }
1058 for (dim = GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1058, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
;
1059 dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1059, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
+ GFC_TYPE_ARRAY_CORANK (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1059, __FUNCTION__))->type_with_lang_specific.lang_specific
)->corank)
; dim++)
1060 {
1061 if (GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1061, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim])
== NULL_TREE(tree) __null)
1062 {
1063 GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1063, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim])
= create_index_var ("lbound", nest);
1064 TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim))(((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1064, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]))->base.nowarning_flag)
= 1;
1065 }
1066 /* Don't try to use the unknown ubound for the last coarray dimension. */
1067 if (GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1067, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim])
== NULL_TREE(tree) __null
1068 && dim < GFC_TYPE_ARRAY_RANK (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1068, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
+ GFC_TYPE_ARRAY_CORANK (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1068, __FUNCTION__))->type_with_lang_specific.lang_specific
)->corank)
- 1)
1069 {
1070 GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1070, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim])
= create_index_var ("ubound", nest);
1071 TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim))(((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1071, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim]))->base.nowarning_flag)
= 1;
1072 }
1073 }
1074 if (GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1074, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
== NULL_TREE(tree) __null)
1075 {
1076 GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1076, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
= gfc_create_var_np (gfc_array_index_type,
1077 "offset");
1078 TREE_NO_WARNING (GFC_TYPE_ARRAY_OFFSET (type))(((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1078, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset))->base.nowarning_flag)
= 1;
1079
1080 if (nest)
1081 gfc_add_decl_to_parent_function (GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1081, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
);
1082 else
1083 gfc_add_decl_to_function (GFC_TYPE_ARRAY_OFFSET (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1083, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
);
1084 }
1085
1086 if (GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1086, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size)
== NULL_TREE(tree) __null
1087 && as->type != AS_ASSUMED_SIZE)
1088 {
1089 GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1089, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size)
= create_index_var ("size", nest);
1090 TREE_NO_WARNING (GFC_TYPE_ARRAY_SIZE (type))(((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1090, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size))->base.nowarning_flag)
= 1;
1091 }
1092
1093 if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE)
)
1094 {
1095 gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (type)))((void)(!(((tree_class_check ((((contains_struct_check ((type
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1095, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1095, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1095, __FUNCTION__), 0 : 0))
;
1096 gcc_assert (TYPE_LANG_SPECIFIC (type)((void)(!(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1096, __FUNCTION__))->type_with_lang_specific.lang_specific
) == ((tree_class_check ((((contains_struct_check ((type), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1097, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1097, __FUNCTION__))->type_with_lang_specific.lang_specific
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1097, __FUNCTION__), 0 : 0))
1097 == TYPE_LANG_SPECIFIC (TREE_TYPE (type)))((void)(!(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1096, __FUNCTION__))->type_with_lang_specific.lang_specific
) == ((tree_class_check ((((contains_struct_check ((type), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1097, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1097, __FUNCTION__))->type_with_lang_specific.lang_specific
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1097, __FUNCTION__), 0 : 0))
;
1098 type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1098, __FUNCTION__))->typed.type)
;
1099 }
1100
1101 if (! COMPLETE_TYPE_P (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1101, __FUNCTION__))->type_common.size) != (tree) __null
)
&& GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1101, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size)
)
1102 {
1103 tree size, range;
1104
1105 size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
1106 GFC_TYPE_ARRAY_SIZE (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1106, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size)
, gfc_index_one_nodegfc_rank_cst[1]);
1107 range = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
1108 size);
1109 TYPE_DOMAIN (type)((tree_check ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1109, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
)
= range;
1110 layout_type (type);
1111 }
1112
1113 if (TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1113, __FUNCTION__))->type_common.name)
!= NULL_TREE(tree) __null && as->rank > 0
1114 && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1114, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[as->rank - 1])
!= NULL_TREE(tree) __null
1115 && VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1))(((enum tree_code) ((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1115, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[as->rank - 1]))->base.code) == VAR_DECL)
)
1116 {
1117 tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type))((tree_check ((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1117, __FUNCTION__))->type_common.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1117, __FUNCTION__, (TYPE_DECL)))->decl_non_common.result
)
;
1118
1119 for (dim = 0; dim < as->rank - 1; dim++)
1120 {
1121 gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE)((void)(!(((enum tree_code) (gtype)->base.code) == ARRAY_TYPE
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1121, __FUNCTION__), 0 : 0))
;
1122 gtype = TREE_TYPE (gtype)((contains_struct_check ((gtype), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1122, __FUNCTION__))->typed.type)
;
1123 }
1124 gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE)((void)(!(((enum tree_code) (gtype)->base.code) == ARRAY_TYPE
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1124, __FUNCTION__), 0 : 0))
;
1125 if (TYPE_MAX_VALUE (TYPE_DOMAIN (gtype))((tree_check5 ((((tree_check ((gtype), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1125, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1125, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
== NULL__null)
1126 TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1126, __FUNCTION__))->type_common.name)
= NULL_TREE(tree) __null;
1127 }
1128
1129 if (TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1129, __FUNCTION__))->type_common.name)
== NULL_TREE(tree) __null)
1130 {
1131 tree gtype = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1131, __FUNCTION__))->typed.type)
, rtype, type_decl;
1132
1133 for (dim = as->rank - 1; dim >= 0; dim--)
1134 {
1135 tree lbound, ubound;
1136 lbound = GFC_TYPE_ARRAY_LBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1136, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim])
;
1137 ubound = GFC_TYPE_ARRAY_UBOUND (type, dim)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1137, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[dim])
;
1138 rtype = build_range_type (gfc_array_index_type, lbound, ubound);
1139 gtype = build_array_type (gtype, rtype);
1140 /* Ensure the bound variables aren't optimized out at -O0.
1141 For -O1 and above they often will be optimized out, but
1142 can be tracked by VTA. Also set DECL_NAMELESS, so that
1143 the artificial lbound.N or ubound.N DECL_NAME doesn't
1144 end up in debug info. */
1145 if (lbound
1146 && VAR_P (lbound)(((enum tree_code) (lbound)->base.code) == VAR_DECL)
1147 && DECL_ARTIFICIAL (lbound)((contains_struct_check ((lbound), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1147, __FUNCTION__))->decl_common.artificial_flag)
1148 && DECL_IGNORED_P (lbound)((contains_struct_check ((lbound), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1148, __FUNCTION__))->decl_common.ignored_flag)
)
1149 {
1150 if (DECL_NAME (lbound)((contains_struct_check ((lbound), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1150, __FUNCTION__))->decl_minimal.name)
1151 && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound))((const char *) (tree_check ((((contains_struct_check ((lbound
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1151, __FUNCTION__))->decl_minimal.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1151, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
,
1152 "lbound") != 0)
1153 DECL_NAMELESS (lbound)((contains_struct_check ((lbound), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1153, __FUNCTION__))->base.u.bits.nameless_flag)
= 1;
1154 DECL_IGNORED_P (lbound)((contains_struct_check ((lbound), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1154, __FUNCTION__))->decl_common.ignored_flag)
= 0;
1155 }
1156 if (ubound
1157 && VAR_P (ubound)(((enum tree_code) (ubound)->base.code) == VAR_DECL)
1158 && DECL_ARTIFICIAL (ubound)((contains_struct_check ((ubound), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1158, __FUNCTION__))->decl_common.artificial_flag)
1159 && DECL_IGNORED_P (ubound)((contains_struct_check ((ubound), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1159, __FUNCTION__))->decl_common.ignored_flag)
)
1160 {
1161 if (DECL_NAME (ubound)((contains_struct_check ((ubound), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1161, __FUNCTION__))->decl_minimal.name)
1162 && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound))((const char *) (tree_check ((((contains_struct_check ((ubound
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1162, __FUNCTION__))->decl_minimal.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1162, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
,
1163 "ubound") != 0)
1164 DECL_NAMELESS (ubound)((contains_struct_check ((ubound), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1164, __FUNCTION__))->base.u.bits.nameless_flag)
= 1;
1165 DECL_IGNORED_P (ubound)((contains_struct_check ((ubound), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1165, __FUNCTION__))->decl_common.ignored_flag)
= 0;
1166 }
1167 }
1168 TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1168, __FUNCTION__))->type_common.name)
= type_decl = build_decl (input_location,
1169 TYPE_DECL, NULL__null, gtype);
1170 DECL_ORIGINAL_TYPE (type_decl)((tree_check ((type_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1170, __FUNCTION__, (TYPE_DECL)))->decl_non_common.result
)
= gtype;
1171 }
1172}
1173
1174
1175/* For some dummy arguments we don't use the actual argument directly.
1176 Instead we create a local decl and use that. This allows us to perform
1177 initialization, and construct full type information. */
1178
1179static tree
1180gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
1181{
1182 tree decl;
1183 tree type;
1184 gfc_array_spec *as;
1185 symbol_attribute *array_attr;
1186 char *name;
1187 gfc_packed packed;
1188 int n;
1189 bool known_size;
1190 bool is_classarray = IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer)
;
1191
1192 /* Use the array as and attr. */
1193 as = is_classarray ? CLASS_DATA (sym)sym->ts.u.derived->components->as : sym->as;
1194 array_attr = is_classarray ? &CLASS_DATA (sym)sym->ts.u.derived->components->attr : &sym->attr;
1195
1196 /* The dummy is returned for pointer, allocatable or assumed rank arrays.
1197 For class arrays the information if sym is an allocatable or pointer
1198 object needs to be checked explicitly (IS_CLASS_ARRAY can be false for
1199 too many reasons to be of use here). */
1200 if ((sym->ts.type != BT_CLASS && sym->attr.pointer)
1201 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer)
1202 || array_attr->allocatable
1203 || (as && as->type == AS_ASSUMED_RANK))
1204 return dummy;
1205
1206 /* Add to list of variables if not a fake result variable.
1207 These symbols are set on the symbol only, not on the class component. */
1208 if (sym->attr.result || sym->attr.dummy)
1209 gfc_defer_symbol_init (sym);
1210
1211 /* For a class array the array descriptor is in the _data component, while
1212 for a regular array the TREE_TYPE of the dummy is a pointer to the
1213 descriptor. */
1214 type = TREE_TYPE (is_classarray ? gfc_class_data_get (dummy)((contains_struct_check ((is_classarray ? gfc_class_data_get (
dummy) : ((contains_struct_check ((dummy), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1215, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1215, __FUNCTION__))->typed.type)
1215 : TREE_TYPE (dummy))((contains_struct_check ((is_classarray ? gfc_class_data_get (
dummy) : ((contains_struct_check ((dummy), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1215, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1215, __FUNCTION__))->typed.type)
;
1216 /* type now is the array descriptor w/o any indirection. */
1217 gcc_assert (TREE_CODE (dummy) == PARM_DECL((void)(!(((enum tree_code) (dummy)->base.code) == PARM_DECL
&& (((enum tree_code) (((contains_struct_check ((dummy
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1218, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((dummy), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1218, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1218, __FUNCTION__), 0 : 0))
1218 && POINTER_TYPE_P (TREE_TYPE (dummy)))((void)(!(((enum tree_code) (dummy)->base.code) == PARM_DECL
&& (((enum tree_code) (((contains_struct_check ((dummy
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1218, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((dummy), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1218, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1218, __FUNCTION__), 0 : 0))
;
1219
1220 /* Do we know the element size? */
1221 known_size = sym->ts.type != BT_CHARACTER
1222 || INTEGER_CST_P (sym->ts.u.cl->backend_decl)(((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == INTEGER_CST)
;
1223
1224 if (known_size && !GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1224, __FUNCTION__))->type_common.lang_flag_1)
)
1225 {
1226 /* For descriptorless arrays with known element size the actual
1227 argument is sufficient. */
1228 gfc_build_qualified_array (dummy, sym);
1229 return dummy;
1230 }
1231
1232 if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1232, __FUNCTION__))->type_common.lang_flag_1)
)
1233 {
1234 /* Create a descriptorless array pointer. */
1235 packed = PACKED_NO;
1236
1237 /* Even when -frepack-arrays is used, symbols with TARGET attribute
1238 are not repacked. */
1239 if (!flag_repack_arraysglobal_options.x_flag_repack_arrays || sym->attr.target)
1240 {
1241 if (as->type == AS_ASSUMED_SIZE)
1242 packed = PACKED_FULL;
1243 }
1244 else
1245 {
1246 if (as->type == AS_EXPLICIT)
1247 {
1248 packed = PACKED_FULL;
1249 for (n = 0; n < as->rank; n++)
1250 {
1251 if (!(as->upper[n]
1252 && as->lower[n]
1253 && as->upper[n]->expr_type == EXPR_CONSTANT
1254 && as->lower[n]->expr_type == EXPR_CONSTANT))
1255 {
1256 packed = PACKED_PARTIAL;
1257 break;
1258 }
1259 }
1260 }
1261 else
1262 packed = PACKED_PARTIAL;
1263 }
1264
1265 /* For classarrays the element type is required, but
1266 gfc_typenode_for_spec () returns the array descriptor. */
1267 type = is_classarray ? gfc_get_element_type (type)
1268 : gfc_typenode_for_spec (&sym->ts);
1269 type = gfc_get_nodesc_array_type (type, as, packed,
1270 !sym->attr.target);
1271 }
1272 else
1273 {
1274 /* We now have an expression for the element size, so create a fully
1275 qualified type. Reset sym->backend decl or this will just return the
1276 old type. */
1277 DECL_ARTIFICIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1277, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1278 sym->backend_decl = NULL_TREE(tree) __null;
1279 type = gfc_sym_type (sym);
1280 packed = PACKED_FULL;
1281 }
1282
1283 ASM_FORMAT_PRIVATE_NAME (name, IDENTIFIER_POINTER (DECL_NAME (dummy)), 0)do { const char *const name_ = (((const char *) (tree_check (
(((contains_struct_check ((dummy), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1283, __FUNCTION__))->decl_minimal.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1283, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)); char *const output_ = (name) = (char *) __builtin_alloca(
strlen (name_) + 32); sprintf (output_, "%s.%lu", name_, (unsigned
long)(0)); } while (0)
;
1284 decl = build_decl (input_location,
1285 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
, type);
1286
1287 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1287, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1288 DECL_NAMELESS (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1288, __FUNCTION__))->base.u.bits.nameless_flag)
= 1;
1289 TREE_PUBLIC (decl)((decl)->base.public_flag) = 0;
1290 TREE_STATIC (decl)((decl)->base.static_flag) = 0;
1291 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1291, __FUNCTION__))->decl_common.decl_flag_1)
= 0;
1292
1293 /* Avoid uninitialized warnings for optional dummy arguments. */
1294 if (sym->attr.optional)
1295 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1296
1297 /* We should never get deferred shape arrays here. We used to because of
1298 frontend bugs. */
1299 gcc_assert (as->type != AS_DEFERRED)((void)(!(as->type != AS_DEFERRED) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1299, __FUNCTION__), 0 : 0))
;
1300
1301 if (packed == PACKED_PARTIAL)
1302 GFC_DECL_PARTIAL_PACKED_ARRAY (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1302, __FUNCTION__))->decl_common.lang_flag_1)
= 1;
1303 else if (packed == PACKED_FULL)
1304 GFC_DECL_PACKED_ARRAY (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1304, __FUNCTION__))->decl_common.lang_flag_0)
= 1;
1305
1306 gfc_build_qualified_array (decl, sym);
1307
1308 if (DECL_LANG_SPECIFIC (dummy)((contains_struct_check ((dummy), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1308, __FUNCTION__))->decl_common.lang_specific)
)
1309 DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1309, __FUNCTION__))->decl_common.lang_specific)
= DECL_LANG_SPECIFIC (dummy)((contains_struct_check ((dummy), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1309, __FUNCTION__))->decl_common.lang_specific)
;
1310 else
1311 gfc_allocate_lang_decl (decl);
1312
1313 GFC_DECL_SAVED_DESCRIPTOR (decl)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1313, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
= dummy;
1314
1315 if (sym->ns->proc_name->backend_decl == current_function_decl
1316 || sym->attr.contained)
1317 gfc_add_decl_to_function (decl);
1318 else
1319 gfc_add_decl_to_parent_function (decl);
1320
1321 return decl;
1322}
1323
1324/* Return a constant or a variable to use as a string length. Does not
1325 add the decl to the current scope. */
1326
1327static tree
1328gfc_create_string_length (gfc_symbol * sym)
1329{
1330 gcc_assert (sym->ts.u.cl)((void)(!(sym->ts.u.cl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1330, __FUNCTION__), 0 : 0))
;
1331 gfc_conv_const_charlen (sym->ts.u.cl);
1332
1333 if (sym->ts.u.cl->backend_decl == NULL_TREE(tree) __null)
1334 {
1335 tree length;
1336 const char *name;
1337
1338 /* The string length variable shall be in static memory if it is either
1339 explicitly SAVED, a module variable or with -fno-automatic. Only
1340 relevant is "len=:" - otherwise, it is either a constant length or
1341 it is an automatic variable. */
1342 bool static_length = sym->attr.save
1343 || sym->ns->proc_name->attr.flavor == FL_MODULE
1344 || (flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == 0
1345 && sym->ts.deferred && !sym->attr.dummy
1346 && !sym->attr.result && !sym->attr.function);
1347
1348 /* Also prefix the mangled name. We need to call GFC_PREFIX for static
1349 variables as some systems do not support the "." in the assembler name.
1350 For nonstatic variables, the "." does not appear in assembler. */
1351 if (static_length)
1352 {
1353 if (sym->module)
1354 name = gfc_get_string (GFC_PREFIX ("%s_MOD_%s")"_F." "%s_MOD_%s", sym->module,
1355 sym->name);
1356 else
1357 name = gfc_get_string (GFC_PREFIX ("%s")"_F." "%s", sym->name);
1358 }
1359 else if (sym->module)
1360 name = gfc_get_string (".__%s_MOD_%s", sym->module, sym->name);
1361 else
1362 name = gfc_get_string (".%s", sym->name);
1363
1364 length = build_decl (input_location,
1365 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
,
1366 gfc_charlen_type_node);
1367 DECL_ARTIFICIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1367, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1368 TREE_USED (length)((length)->base.used_flag) = 1;
1369 if (sym->ns->proc_name->tlink != NULL__null)
1370 gfc_defer_symbol_init (sym);
1371
1372 sym->ts.u.cl->backend_decl = length;
1373
1374 if (static_length)
1375 TREE_STATIC (length)((length)->base.static_flag) = 1;
1376
1377 if (sym->ns->proc_name->attr.flavor == FL_MODULE
1378 && (sym->attr.access != ACCESS_PRIVATE || sym->attr.public_used))
1379 TREE_PUBLIC (length)((length)->base.public_flag) = 1;
1380 }
1381
1382 gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE)((void)(!(sym->ts.u.cl->backend_decl != (tree) __null) ?
fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1382, __FUNCTION__), 0 : 0))
;
1383 return sym->ts.u.cl->backend_decl;
1384}
1385
1386/* If a variable is assigned a label, we add another two auxiliary
1387 variables. */
1388
1389static void
1390gfc_add_assign_aux_vars (gfc_symbol * sym)
1391{
1392 tree addr;
1393 tree length;
1394 tree decl;
1395
1396 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1396, __FUNCTION__), 0 : 0))
;
1397
1398 decl = sym->backend_decl;
1399 gfc_allocate_lang_decl (decl);
1400 GFC_DECL_ASSIGN (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1400, __FUNCTION__))->decl_common.lang_flag_2)
= 1;
1401 length = build_decl (input_location,
1402 VAR_DECL, create_tmp_var_name (sym->name),
1403 gfc_charlen_type_node);
1404 addr = build_decl (input_location,
1405 VAR_DECL, create_tmp_var_name (sym->name),
1406 pvoid_type_node);
1407 gfc_finish_var_decl (length, sym);
1408 gfc_finish_var_decl (addr, sym);
1409 /* STRING_LENGTH is also used as flag. Less than -1 means that
1410 ASSIGN_ADDR cannot be used. Equal -1 means that ASSIGN_ADDR is the
1411 target label's address. Otherwise, value is the length of a format string
1412 and ASSIGN_ADDR is its address. */
1413 if (TREE_STATIC (length)((length)->base.static_flag))
1414 DECL_INITIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1414, __FUNCTION__))->decl_common.initial)
= build_int_cst (gfc_charlen_type_node, -2);
1415 else
1416 gfc_defer_symbol_init (sym);
1417
1418 GFC_DECL_STRING_LEN (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1418, __FUNCTION__))->decl_common.lang_specific)->stringlen
= length;
1419 GFC_DECL_ASSIGN_ADDR (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1419, __FUNCTION__))->decl_common.lang_specific)->addr
= addr;
1420}
1421
1422
1423static tree
1424add_attributes_to_decl (symbol_attribute sym_attr, tree list)
1425{
1426 unsigned id;
1427 tree attr;
1428
1429 for (id = 0; id < EXT_ATTR_NUM; id++)
1430 if (sym_attr.ext_attr & (1 << id) && ext_attr_list[id].middle_end_name)
1431 {
1432 attr = build_tree_list (
1433 get_identifier (ext_attr_list[id].middle_end_name)(__builtin_constant_p (ext_attr_list[id].middle_end_name) ? get_identifier_with_length
((ext_attr_list[id].middle_end_name), strlen (ext_attr_list[
id].middle_end_name)) : get_identifier (ext_attr_list[id].middle_end_name
))
,
1434 NULL_TREE(tree) __null);
1435 list = chainon (list, attr);
1436 }
1437
1438 tree clauses = NULL_TREE(tree) __null;
1439
1440 if (sym_attr.oacc_routine_lop != OACC_ROUTINE_LOP_NONE)
1441 {
1442 omp_clause_code code;
1443 switch (sym_attr.oacc_routine_lop)
1444 {
1445 case OACC_ROUTINE_LOP_GANG:
1446 code = OMP_CLAUSE_GANG;
1447 break;
1448 case OACC_ROUTINE_LOP_WORKER:
1449 code = OMP_CLAUSE_WORKER;
1450 break;
1451 case OACC_ROUTINE_LOP_VECTOR:
1452 code = OMP_CLAUSE_VECTOR;
1453 break;
1454 case OACC_ROUTINE_LOP_SEQ:
1455 code = OMP_CLAUSE_SEQ;
1456 break;
1457 case OACC_ROUTINE_LOP_NONE:
1458 case OACC_ROUTINE_LOP_ERROR:
1459 default:
1460 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1460, __FUNCTION__))
;
1461 }
1462 tree c = build_omp_clause (UNKNOWN_LOCATION((location_t) 0), code);
1463 OMP_CLAUSE_CHAIN (c)((contains_struct_check (((tree_check ((c), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1463, __FUNCTION__, (OMP_CLAUSE)))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1463, __FUNCTION__))->common.chain)
= clauses;
1464 clauses = c;
1465
1466 tree dims = oacc_build_routine_dims (clauses);
1467 list = oacc_replace_fn_attrib_attr (list, dims);
1468 }
1469 if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET)
1470 {
1471 tree c = build_omp_clause (UNKNOWN_LOCATION((location_t) 0), OMP_CLAUSE_DEVICE_TYPE);
1472 switch (sym_attr.omp_device_type)
1473 {
1474 case OMP_DEVICE_TYPE_HOST:
1475 OMP_CLAUSE_DEVICE_TYPE_KIND (c)((omp_clause_subcode_check ((c), (OMP_CLAUSE_DEVICE_TYPE), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1475, __FUNCTION__))->omp_clause.subcode.device_type_kind
)
= OMP_CLAUSE_DEVICE_TYPE_HOST;
1476 break;
1477 case OMP_DEVICE_TYPE_NOHOST:
1478 OMP_CLAUSE_DEVICE_TYPE_KIND (c)((omp_clause_subcode_check ((c), (OMP_CLAUSE_DEVICE_TYPE), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1478, __FUNCTION__))->omp_clause.subcode.device_type_kind
)
= OMP_CLAUSE_DEVICE_TYPE_NOHOST;
1479 break;
1480 case OMP_DEVICE_TYPE_ANY:
1481 OMP_CLAUSE_DEVICE_TYPE_KIND (c)((omp_clause_subcode_check ((c), (OMP_CLAUSE_DEVICE_TYPE), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1481, __FUNCTION__))->omp_clause.subcode.device_type_kind
)
= OMP_CLAUSE_DEVICE_TYPE_ANY;
1482 break;
1483 default:
1484 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1484, __FUNCTION__))
;
1485 }
1486 OMP_CLAUSE_CHAIN (c)((contains_struct_check (((tree_check ((c), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1486, __FUNCTION__, (OMP_CLAUSE)))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1486, __FUNCTION__))->common.chain)
= clauses;
1487 clauses = c;
1488 }
1489
1490 if (sym_attr.omp_declare_target_link
1491 || sym_attr.oacc_declare_link)
1492 list = tree_cons (get_identifier ("omp declare target link")(__builtin_constant_p ("omp declare target link") ? get_identifier_with_length
(("omp declare target link"), strlen ("omp declare target link"
)) : get_identifier ("omp declare target link"))
,
1493 clauses, list);
1494 else if (sym_attr.omp_declare_target
1495 || sym_attr.oacc_declare_create
1496 || sym_attr.oacc_declare_copyin
1497 || sym_attr.oacc_declare_deviceptr
1498 || sym_attr.oacc_declare_device_resident)
1499 list = tree_cons (get_identifier ("omp declare target")(__builtin_constant_p ("omp declare target") ? get_identifier_with_length
(("omp declare target"), strlen ("omp declare target")) : get_identifier
("omp declare target"))
,
1500 clauses, list);
1501
1502 return list;
1503}
1504
1505
1506static void build_function_decl (gfc_symbol * sym, bool global);
1507
1508
1509/* Return the decl for a gfc_symbol, create it if it doesn't already
1510 exist. */
1511
1512tree
1513gfc_get_symbol_decl (gfc_symbol * sym)
1514{
1515 tree decl;
1516 tree length = NULL_TREE(tree) __null;
1517 tree attributes;
1518 int byref;
1519 bool intrinsic_array_parameter = false;
1520 bool fun_or_res;
1521
1522 gcc_assert (sym->attr.referenced((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1528, __FUNCTION__), 0 : 0))
1523 || sym->attr.flavor == FL_PROCEDURE((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1528, __FUNCTION__), 0 : 0))
1524 || sym->attr.use_assoc((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1528, __FUNCTION__), 0 : 0))
1525 || sym->attr.used_in_submodule((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1528, __FUNCTION__), 0 : 0))
1526 || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1528, __FUNCTION__), 0 : 0))
1527 || (sym->module && sym->attr.if_source != IFSRC_DECL((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1528, __FUNCTION__), 0 : 0))
1528 && sym->backend_decl))((void)(!(sym->attr.referenced || sym->attr.flavor == FL_PROCEDURE
|| sym->attr.use_assoc || sym->attr.used_in_submodule ||
sym->ns->proc_name->attr.if_source == IFSRC_IFBODY ||
(sym->module && sym->attr.if_source != IFSRC_DECL
&& sym->backend_decl)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1528, __FUNCTION__), 0 : 0))
;
1529
1530 if (sym->ns && sym->ns->proc_name && sym->ns->proc_name->attr.function)
1531 byref = gfc_return_by_reference (sym->ns->proc_name);
1532 else
1533 byref = 0;
1534
1535 /* Make sure that the vtab for the declared type is completed. */
1536 if (sym->ts.type == BT_CLASS)
1537 {
1538 gfc_component *c = CLASS_DATA (sym)sym->ts.u.derived->components;
1539 if (!c->ts.u.derived->backend_decl)
1540 {
1541 gfc_find_derived_vtab (c->ts.u.derived);
1542 gfc_get_derived_type (sym->ts.u.derived);
1543 }
1544 }
1545
1546 /* PDT parameterized array components and string_lengths must have the
1547 'len' parameters substituted for the expressions appearing in the
1548 declaration of the entity and memory allocated/deallocated. */
1549 if ((sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
1550 && sym->param_list != NULL__null
1551 && !(sym->attr.host_assoc || sym->attr.use_assoc || sym->attr.dummy))
1552 gfc_defer_symbol_init (sym);
1553
1554 /* Dummy PDT 'len' parameters should be checked when they are explicit. */
1555 if ((sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
1556 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS(1<<0))
1557 && sym->param_list != NULL__null
1558 && sym->attr.dummy)
1559 gfc_defer_symbol_init (sym);
1560
1561 /* All deferred character length procedures need to retain the backend
1562 decl, which is a pointer to the character length in the caller's
1563 namespace and to declare a local character length. */
1564 if (!byref && sym->attr.function
1565 && sym->ts.type == BT_CHARACTER
1566 && sym->ts.deferred
1567 && sym->ts.u.cl->passed_length == NULL__null
1568 && sym->ts.u.cl->backend_decl
1569 && TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code)
== PARM_DECL)
1570 {
1571 sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
1572 gcc_assert (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length)))((void)(!((((enum tree_code) (((contains_struct_check ((sym->
ts.u.cl->passed_length), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1572, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((sym->ts.u
.cl->passed_length), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1572, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1572, __FUNCTION__), 0 : 0))
;
1573 sym->ts.u.cl->backend_decl = build_fold_indirect_ref (sym->ts.u.cl->backend_decl)build_fold_indirect_ref_loc (((location_t) 0), sym->ts.u.cl
->backend_decl)
;
1574 }
1575
1576 if (is_CFI_desc (sym, NULL__null))
1577 gfc_defer_symbol_init (sym);
1578
1579 fun_or_res = byref && (sym->attr.result
1580 || (sym->attr.function && sym->ts.deferred));
1581 if ((sym->attr.dummy && ! sym->attr.function) || fun_or_res)
1582 {
1583 /* Return via extra parameter. */
1584 if (sym->attr.result && byref
1585 && !sym->backend_decl)
1586 {
1587 sym->backend_decl =
1588 DECL_ARGUMENTS (sym->ns->proc_name->backend_decl)((tree_check ((sym->ns->proc_name->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1588, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
)
;
1589 /* For entry master function skip over the __entry
1590 argument. */
1591 if (sym->ns->proc_name->attr.entry_master)
1592 sym->backend_decl = DECL_CHAIN (sym->backend_decl)(((contains_struct_check (((contains_struct_check ((sym->backend_decl
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1592, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1592, __FUNCTION__))->common.chain))
;
1593 }
1594
1595 /* Dummy variables should already have been created. */
1596 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1596, __FUNCTION__), 0 : 0))
;
1597
1598 /* However, the string length of deferred arrays must be set. */
1599 if (sym->ts.type == BT_CHARACTER
1600 && sym->ts.deferred
1601 && sym->attr.dimension
1602 && sym->attr.allocatable)
1603 gfc_defer_symbol_init (sym);
1604
1605 if (sym->attr.pointer && sym->attr.dimension && sym->ts.type != BT_CLASS)
1606 GFC_DECL_PTR_ARRAY_P (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1606, __FUNCTION__))->decl_common.lang_flag_6)
= 1;
1607
1608 /* Create a character length variable. */
1609 if (sym->ts.type == BT_CHARACTER)
1610 {
1611 /* For a deferred dummy, make a new string length variable. */
1612 if (sym->ts.deferred
1613 &&
1614 (sym->ts.u.cl->passed_length == sym->ts.u.cl->backend_decl))
1615 sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
1616
1617 if (sym->ts.deferred && byref)
1618 {
1619 /* The string length of a deferred char array is stored in the
1620 parameter at sym->ts.u.cl->backend_decl as a reference and
1621 marked as a result. Exempt this variable from generating a
1622 temporary for it. */
1623 if (sym->attr.result)
1624 {
1625 /* We need to insert a indirect ref for param decls. */
1626 if (sym->ts.u.cl->backend_decl
1627 && TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code)
== PARM_DECL)
1628 {
1629 sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
1630 sym->ts.u.cl->backend_decl =
1631 build_fold_indirect_ref (sym->ts.u.cl->backend_decl)build_fold_indirect_ref_loc (((location_t) 0), sym->ts.u.cl
->backend_decl)
;
1632 }
1633 }
1634 /* For all other parameters make sure, that they are copied so
1635 that the value and any modifications are local to the routine
1636 by generating a temporary variable. */
1637 else if (sym->attr.function
1638 && sym->ts.u.cl->passed_length == NULL__null
1639 && sym->ts.u.cl->backend_decl)
1640 {
1641 sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
1642 if (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length))(((enum tree_code) (((contains_struct_check ((sym->ts.u.cl
->passed_length), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1642, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((sym->ts.u
.cl->passed_length), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1642, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)
)
1643 sym->ts.u.cl->backend_decl
1644 = build_fold_indirect_ref (sym->ts.u.cl->backend_decl)build_fold_indirect_ref_loc (((location_t) 0), sym->ts.u.cl
->backend_decl)
;
1645 else
1646 sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
1647 }
1648 }
1649
1650 if (sym->ts.u.cl->backend_decl == NULL_TREE(tree) __null)
1651 length = gfc_create_string_length (sym);
1652 else
1653 length = sym->ts.u.cl->backend_decl;
1654 if (VAR_P (length)(((enum tree_code) (length)->base.code) == VAR_DECL) && DECL_FILE_SCOPE_P (length)(! (((contains_struct_check ((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1654, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1654, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL)
)
1655 {
1656 /* Add the string length to the same context as the symbol. */
1657 if (DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1657, __FUNCTION__))->decl_minimal.context)
== NULL_TREE(tree) __null)
1658 {
1659 if (sym->backend_decl == current_function_decl
1660 || (DECL_CONTEXT (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1660, __FUNCTION__))->decl_minimal.context)
1661 == current_function_decl))
1662 gfc_add_decl_to_function (length);
1663 else
1664 gfc_add_decl_to_parent_function (length);
1665 }
1666
1667 gcc_assert (sym->backend_decl == current_function_decl((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1668, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1669, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__), 0 : 0))
1668 ? DECL_CONTEXT (length) == current_function_decl((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1668, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1669, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__), 0 : 0))
1669 : (DECL_CONTEXT (sym->backend_decl)((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1668, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1669, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__), 0 : 0))
1670 == DECL_CONTEXT (length)))((void)(!(sym->backend_decl == current_function_decl ? ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1668, __FUNCTION__))->decl_minimal.context) == current_function_decl
: (((contains_struct_check ((sym->backend_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1669, __FUNCTION__))->decl_minimal.context) == ((contains_struct_check
((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__))->decl_minimal.context))) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1670, __FUNCTION__), 0 : 0))
;
1671
1672 gfc_defer_symbol_init (sym);
1673 }
1674 }
1675
1676 /* Use a copy of the descriptor for dummy arrays. */
1677 if ((sym->attr.dimension || sym->attr.codimension)
1678 && !TREE_USED (sym->backend_decl)((sym->backend_decl)->base.used_flag))
1679 {
1680 decl = gfc_build_dummy_array_decl (sym, sym->backend_decl);
1681 /* Prevent the dummy from being detected as unused if it is copied. */
1682 if (sym->backend_decl != NULL__null && decl != sym->backend_decl)
1683 DECL_ARTIFICIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1683, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1684 sym->backend_decl = decl;
1685 }
1686
1687 /* Returning the descriptor for dummy class arrays is hazardous, because
1688 some caller is expecting an expression to apply the component refs to.
1689 Therefore the descriptor is only created and stored in
1690 sym->backend_decl's GFC_DECL_SAVED_DESCRIPTOR. The caller is then
1691 responsible to extract it from there, when the descriptor is
1692 desired. */
1693 if (IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer)
1694 && (!DECL_LANG_SPECIFIC (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1694, __FUNCTION__))->decl_common.lang_specific)
1695 || !GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl)(((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1695, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
))
1696 {
1697 decl = gfc_build_dummy_array_decl (sym, sym->backend_decl);
1698 /* Prevent the dummy from being detected as unused if it is copied. */
1699 if (sym->backend_decl != NULL__null && decl != sym->backend_decl)
1700 DECL_ARTIFICIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1700, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1701 sym->backend_decl = decl;
1702 }
1703
1704 TREE_USED (sym->backend_decl)((sym->backend_decl)->base.used_flag) = 1;
1705 if (sym->attr.assign && GFC_DECL_ASSIGN (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1705, __FUNCTION__))->decl_common.lang_flag_2)
== 0)
1706 gfc_add_assign_aux_vars (sym);
1707
1708 if (sym->ts.type == BT_CLASS && sym->backend_decl)
1709 GFC_DECL_CLASS(sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1709, __FUNCTION__))->decl_common.lang_flag_8)
= 1;
1710
1711 return sym->backend_decl;
1712 }
1713
1714 if (sym->result == sym && sym->attr.assign
1715 && GFC_DECL_ASSIGN (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1715, __FUNCTION__))->decl_common.lang_flag_2)
== 0)
1716 gfc_add_assign_aux_vars (sym);
1717
1718 if (sym->backend_decl)
1719 return sym->backend_decl;
1720
1721 /* Special case for array-valued named constants from intrinsic
1722 procedures; those are inlined. */
1723 if (sym->attr.use_assoc && sym->attr.flavor == FL_PARAMETER
1724 && (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
1725 || sym->from_intmod == INTMOD_ISO_C_BINDING))
1726 intrinsic_array_parameter = true;
1727
1728 /* If use associated compilation, use the module
1729 declaration. */
1730 if ((sym->attr.flavor == FL_VARIABLE
1731 || sym->attr.flavor == FL_PARAMETER)
1732 && (sym->attr.use_assoc || sym->attr.used_in_submodule)
1733 && !intrinsic_array_parameter
1734 && sym->module
1735 && gfc_get_module_backend_decl (sym))
1736 {
1737 if (sym->ts.type == BT_CLASS && sym->backend_decl)
1738 GFC_DECL_CLASS(sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1738, __FUNCTION__))->decl_common.lang_flag_8)
= 1;
1739 return sym->backend_decl;
1740 }
1741
1742 if (sym->attr.flavor == FL_PROCEDURE)
1743 {
1744 /* Catch functions. Only used for actual parameters,
1745 procedure pointers and procptr initialization targets. */
1746 if (sym->attr.use_assoc
1747 || sym->attr.used_in_submodule
1748 || sym->attr.intrinsic
1749 || sym->attr.if_source != IFSRC_DECL)
1750 {
1751 decl = gfc_get_extern_function_decl (sym);
1752 }
1753 else
1754 {
1755 if (!sym->backend_decl)
1756 build_function_decl (sym, false);
1757 decl = sym->backend_decl;
1758 }
1759 return decl;
1760 }
1761
1762 if (sym->attr.intrinsic)
1763 gfc_internal_error ("intrinsic variable which isn't a procedure");
1764
1765 /* Create string length decl first so that they can be used in the
1766 type declaration. For associate names, the target character
1767 length is used. Set 'length' to a constant so that if the
1768 string length is a variable, it is not finished a second time. */
1769 if (sym->ts.type == BT_CHARACTER)
1770 {
1771 if (sym->attr.associate_var
1772 && sym->ts.deferred
1773 && sym->assoc && sym->assoc->target
1774 && ((sym->assoc->target->expr_type == EXPR_VARIABLE
1775 && sym->assoc->target->symtree->n.sym->ts.type != BT_CHARACTER)
1776 || sym->assoc->target->expr_type != EXPR_VARIABLE))
1777 sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
1778
1779 if (sym->attr.associate_var
1780 && sym->ts.u.cl->backend_decl
1781 && (VAR_P (sym->ts.u.cl->backend_decl)(((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == VAR_DECL)
1782 || TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code)
== PARM_DECL))
1783 length = gfc_index_zero_nodegfc_rank_cst[0];
1784 else
1785 length = gfc_create_string_length (sym);
1786 }
1787
1788 /* Create the decl for the variable. */
1789 decl = build_decl (gfc_get_location (&sym->declared_at),
1790 VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
1791
1792 /* Add attributes to variables. Functions are handled elsewhere. */
1793 attributes = add_attributes_to_decl (sym->attr, NULL_TREE(tree) __null);
1794 decl_attributes (&decl, attributes, 0);
1795
1796 /* Symbols from modules should have their assembler names mangled.
1797 This is done here rather than in gfc_finish_var_decl because it
1798 is different for string length variables. */
1799 if (sym->module || sym->fn_result_spec)
1800 {
1801 gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
1802 if (sym->attr.use_assoc && !intrinsic_array_parameter)
1803 DECL_IGNORED_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1803, __FUNCTION__))->decl_common.ignored_flag)
= 1;
1804 }
1805
1806 if (sym->attr.select_type_temporary)
1807 {
1808 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1808, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1809 DECL_IGNORED_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1809, __FUNCTION__))->decl_common.ignored_flag)
= 1;
1810 }
1811
1812 if (sym->attr.dimension || sym->attr.codimension)
1813 {
1814 /* Create variables to hold the non-constant bits of array info. */
1815 gfc_build_qualified_array (decl, sym);
1816
1817 if (sym->attr.contiguous
1818 || ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer))
1819 GFC_DECL_PACKED_ARRAY (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1819, __FUNCTION__))->decl_common.lang_flag_0)
= 1;
1820 }
1821
1822 /* Remember this variable for allocation/cleanup. */
1823 if (sym->attr.dimension || sym->attr.allocatable || sym->attr.codimension
1824 || (sym->ts.type == BT_CLASS &&
1825 (CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
1826 || CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable))
1827 || (sym->ts.type == BT_DERIVED
1828 && (sym->ts.u.derived->attr.alloc_comp
1829 || (!sym->attr.pointer && !sym->attr.artificial && !sym->attr.save
1830 && !sym->ns->proc_name->attr.is_main_program
1831 && gfc_is_finalizable (sym->ts.u.derived, NULL__null))))
1832 /* This applies a derived type default initializer. */
1833 || (sym->ts.type == BT_DERIVED
1834 && sym->attr.save == SAVE_NONE
1835 && !sym->attr.data
1836 && !sym->attr.allocatable
1837 && (sym->value && !sym->ns->proc_name->attr.is_main_program)
1838 && !(sym->attr.use_assoc && !intrinsic_array_parameter)))
1839 gfc_defer_symbol_init (sym);
1840
1841 if (sym->ts.type == BT_CHARACTER
1842 && sym->attr.allocatable
1843 && !sym->attr.dimension
1844 && sym->ts.u.cl && sym->ts.u.cl->length
1845 && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE)
1846 gfc_defer_symbol_init (sym);
1847
1848 /* Associate names can use the hidden string length variable
1849 of their associated target. */
1850 if (sym->ts.type == BT_CHARACTER
1851 && TREE_CODE (length)((enum tree_code) (length)->base.code) != INTEGER_CST
1852 && TREE_CODE (sym->ts.u.cl->backend_decl)((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code)
!= INDIRECT_REF)
1853 {
1854 length = fold_convert (gfc_charlen_type_node, length)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, length
)
;
1855 gfc_finish_var_decl (length, sym);
1856 if (!sym->attr.associate_var
1857 && TREE_CODE (length)((enum tree_code) (length)->base.code) == VAR_DECL
1858 && sym->value && sym->value->expr_type != EXPR_NULL
1859 && sym->value->ts.u.cl->length)
1860 {
1861 gfc_expr *len = sym->value->ts.u.cl->length;
1862 DECL_INITIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1862, __FUNCTION__))->decl_common.initial)
= gfc_conv_initializer (len, &len->ts,
1863 TREE_TYPE (length)((contains_struct_check ((length), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1863, __FUNCTION__))->typed.type)
,
1864 false, false, false);
1865 DECL_INITIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1865, __FUNCTION__))->decl_common.initial)
= fold_convert (gfc_charlen_type_node,fold_convert_loc (((location_t) 0), gfc_charlen_type_node, ((
contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1866, __FUNCTION__))->decl_common.initial))
1866 DECL_INITIAL (length))fold_convert_loc (((location_t) 0), gfc_charlen_type_node, ((
contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1866, __FUNCTION__))->decl_common.initial))
;
1867 }
1868 else
1869 gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL)((void)(!(!sym->value || sym->value->expr_type == EXPR_NULL
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1869, __FUNCTION__), 0 : 0))
;
1870 }
1871
1872 gfc_finish_var_decl (decl, sym);
1873
1874 if (sym->ts.type == BT_CHARACTER)
1875 /* Character variables need special handling. */
1876 gfc_allocate_lang_decl (decl);
1877
1878 if (sym->assoc && sym->attr.subref_array_pointer)
1879 sym->attr.pointer = 1;
1880
1881 if (sym->attr.pointer && sym->attr.dimension
1882 && !sym->ts.deferred
1883 && !(sym->attr.select_type_temporary
1884 && !sym->attr.subref_array_pointer))
1885 GFC_DECL_PTR_ARRAY_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1885, __FUNCTION__))->decl_common.lang_flag_6)
= 1;
1886
1887 if (sym->ts.type == BT_CLASS)
1888 GFC_DECL_CLASS(decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1888, __FUNCTION__))->decl_common.lang_flag_8)
= 1;
1889
1890 sym->backend_decl = decl;
1891
1892 if (sym->attr.assign)
1893 gfc_add_assign_aux_vars (sym);
1894
1895 if (intrinsic_array_parameter)
1896 {
1897 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
1898 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1898, __FUNCTION__))->decl_common.decl_flag_1)
= 0;
1899 }
1900
1901 if (TREE_STATIC (decl)((decl)->base.static_flag)
1902 && !(sym->attr.use_assoc && !intrinsic_array_parameter)
1903 && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
1904 || !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1904, __FUNCTION__))->decl_common.size_unit)
)
1905 || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
1906 && (flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB
1907 || !sym->attr.codimension || sym->attr.allocatable)
1908 && !(sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_type)
1909 && !(sym->ts.type == BT_CLASS
1910 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived->attr.pdt_type))
1911 {
1912 /* Add static initializer. For procedures, it is only needed if
1913 SAVE is specified otherwise they need to be reinitialized
1914 every time the procedure is entered. The TREE_STATIC is
1915 in this case due to -fmax-stack-var-size=. */
1916
1917 DECL_INITIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1917, __FUNCTION__))->decl_common.initial)
= gfc_conv_initializer (sym->value, &sym->ts,
1918 TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1918, __FUNCTION__))->typed.type)
, sym->attr.dimension
1919 || (sym->attr.codimension
1920 && sym->attr.allocatable),
1921 sym->attr.pointer || sym->attr.allocatable
1922 || sym->ts.type == BT_CLASS,
1923 sym->attr.proc_pointer);
1924 }
1925
1926 if (!TREE_STATIC (decl)((decl)->base.static_flag)
1927 && POINTER_TYPE_P (TREE_TYPE (decl))(((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1927, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1927, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)
1928 && !sym->attr.pointer
1929 && !sym->attr.allocatable
1930 && !sym->attr.proc_pointer
1931 && !sym->attr.select_type_temporary)
1932 DECL_BY_REFERENCE (decl)((tree_check3 ((decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1932, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL))
)->decl_common.decl_by_reference_flag)
= 1;
1933
1934 if (sym->attr.associate_var)
1935 GFC_DECL_ASSOCIATE_VAR_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1935, __FUNCTION__))->decl_common.lang_flag_7)
= 1;
1936
1937 /* We only longer mark __def_init as read-only if it actually has an
1938 initializer, it does not needlessly take up space in the
1939 read-only section and can go into the BSS instead, see PR 84487.
1940 Marking this as artificial means that OpenMP will treat this as
1941 predetermined shared. */
1942
1943 bool def_init = gfc_str_startswith (sym->name, "__def_init")(strncmp ((sym->name), ("__def_init"), strlen ("__def_init"
)) == 0)
;
1944
1945 if (sym->attr.vtab || def_init)
1946 {
1947 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1947, __FUNCTION__))->decl_common.artificial_flag)
= 1;
1948 if (def_init && sym->value)
1949 TREE_READONLY (decl)((non_type_check ((decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 1949, __FUNCTION__))->base.readonly_flag)
= 1;
1950 }
1951
1952 return decl;
1953}
1954
1955
1956/* Substitute a temporary variable in place of the real one. */
1957
1958void
1959gfc_shadow_sym (gfc_symbol * sym, tree decl, gfc_saved_var * save)
1960{
1961 save->attr = sym->attr;
1962 save->decl = sym->backend_decl;
1963
1964 gfc_clear_attr (&sym->attr);
1965 sym->attr.referenced = 1;
1966 sym->attr.flavor = FL_VARIABLE;
1967
1968 sym->backend_decl = decl;
1969}
1970
1971
1972/* Restore the original variable. */
1973
1974void
1975gfc_restore_sym (gfc_symbol * sym, gfc_saved_var * save)
1976{
1977 sym->attr = save->attr;
1978 sym->backend_decl = save->decl;
1979}
1980
1981
1982/* Declare a procedure pointer. */
1983
1984static tree
1985get_proc_pointer_decl (gfc_symbol *sym)
1986{
1987 tree decl;
1988 tree attributes;
1989
1990 if (sym->module || sym->fn_result_spec)
1991 {
1992 const char *name;
1993 gfc_gsymbol *gsym;
1994
1995 name = mangled_identifier (sym);
1996 gsym = gfc_find_gsymbol (gfc_gsym_root, name);
1997 if (gsym != NULL__null)
1998 {
1999 gfc_symbol *s;
2000 gfc_find_symbol (sym->name, gsym->ns, 0, &s);
2001 if (s && s->backend_decl)
2002 return s->backend_decl;
2003 }
2004 }
2005
2006 decl = sym->backend_decl;
2007 if (decl)
2008 return decl;
2009
2010 decl = build_decl (input_location,
2011 VAR_DECL, get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name))
,
2012 build_pointer_type (gfc_get_function_type (sym)));
2013
2014 if (sym->module)
2015 {
2016 /* Apply name mangling. */
2017 gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
2018 if (sym->attr.use_assoc)
2019 DECL_IGNORED_P (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2019, __FUNCTION__))->decl_common.ignored_flag)
= 1;
2020 }
2021
2022 if ((sym->ns->proc_name
2023 && sym->ns->proc_name->backend_decl == current_function_decl)
2024 || sym->attr.contained)
2025 gfc_add_decl_to_function (decl);
2026 else if (sym->ns->proc_name->attr.flavor != FL_MODULE)
2027 gfc_add_decl_to_parent_function (decl);
2028
2029 sym->backend_decl = decl;
2030
2031 /* If a variable is USE associated, it's always external. */
2032 if (sym->attr.use_assoc)
2033 {
2034 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2034, __FUNCTION__))->decl_common.decl_flag_1)
= 1;
2035 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
2036 }
2037 else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE)
2038 {
2039 /* This is the declaration of a module variable. */
2040 TREE_PUBLIC (decl)((decl)->base.public_flag) = 1;
2041 if (sym->attr.access == ACCESS_PRIVATE && !sym->attr.public_used)
2042 {
2043 DECL_VISIBILITY (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2043, __FUNCTION__))->decl_with_vis.visibility)
= VISIBILITY_HIDDEN;
2044 DECL_VISIBILITY_SPECIFIED (decl)((contains_struct_check ((decl), (TS_DECL_WITH_VIS), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2044, __FUNCTION__))->decl_with_vis.visibility_specified
)
= true;
2045 }
2046 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
2047 }
2048
2049 if (!sym->attr.use_assoc
2050 && (sym->attr.save != SAVE_NONE || sym->attr.data
2051 || (sym->value && sym->ns->proc_name->attr.is_main_program)))
2052 TREE_STATIC (decl)((decl)->base.static_flag) = 1;
2053
2054 if (TREE_STATIC (decl)((decl)->base.static_flag) && sym->value)
2055 {
2056 /* Add static initializer. */
2057 DECL_INITIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2057, __FUNCTION__))->decl_common.initial)
= gfc_conv_initializer (sym->value, &sym->ts,
2058 TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2058, __FUNCTION__))->typed.type)
,
2059 sym->attr.dimension,
2060 false, true);
2061 }
2062
2063 /* Handle threadprivate procedure pointers. */
2064 if (sym->attr.threadprivate
2065 && (TREE_STATIC (decl)((decl)->base.static_flag) || DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2065, __FUNCTION__))->decl_common.decl_flag_1)
))
2066 set_decl_tls_model (decl, decl_default_tls_model (decl));
2067
2068 attributes = add_attributes_to_decl (sym->attr, NULL_TREE(tree) __null);
2069 decl_attributes (&decl, attributes, 0);
2070
2071 return decl;
2072}
2073
2074
2075/* Get a basic decl for an external function. */
2076
2077tree
2078gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args,
2079 const char *fnspec)
2080{
2081 tree type;
2082 tree fndecl;
2083 tree attributes;
2084 gfc_expr e;
2085 gfc_intrinsic_sym *isym;
2086 gfc_expr argexpr;
2087 char s[GFC_MAX_SYMBOL_LEN63 + 23]; /* "_gfortran_f2c_specific" and '\0'. */
2088 tree name;
2089 tree mangled_name;
2090 gfc_gsymbol *gsym;
2091
2092 if (sym->backend_decl)
2093 return sym->backend_decl;
2094
2095 /* We should never be creating external decls for alternate entry points.
2096 The procedure may be an alternate entry point, but we don't want/need
2097 to know that. */
2098 gcc_assert (!(sym->attr.entry || sym->attr.entry_master))((void)(!(!(sym->attr.entry || sym->attr.entry_master))
? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2098, __FUNCTION__), 0 : 0))
;
2099
2100 if (sym->attr.proc_pointer)
2101 return get_proc_pointer_decl (sym);
2102
2103 /* See if this is an external procedure from the same file. If so,
2104 return the backend_decl. If we are looking at a BIND(C)
2105 procedure and the symbol is not BIND(C), or vice versa, we
2106 haven't found the right procedure. */
2107
2108 if (sym->binding_label)
2109 {
2110 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label);
2111 if (gsym && !gsym->bind_c)
2112 gsym = NULL__null;
2113 }
2114 else if (sym->module == NULL__null)
2115 {
2116 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name);
2117 if (gsym && gsym->bind_c)
2118 gsym = NULL__null;
2119 }
2120 else
2121 {
2122 /* Procedure from a different module. */
2123 gsym = NULL__null;
2124 }
2125
2126 if (gsym && !gsym->defined)
2127 gsym = NULL__null;
2128
2129 /* This can happen because of C binding. */
2130 if (gsym && gsym->ns && gsym->ns->proc_name
2131 && gsym->ns->proc_name->attr.flavor == FL_MODULE)
2132 goto module_sym;
2133
2134 if ((!sym->attr.use_assoc || sym->attr.if_source != IFSRC_DECL)
2135 && !sym->backend_decl
2136 && gsym && gsym->ns
2137 && ((gsym->type == GSYM_SUBROUTINE) || (gsym->type == GSYM_FUNCTION))
2138 && (gsym->ns->proc_name->backend_decl || !sym->attr.intrinsic))
2139 {
2140 if (!gsym->ns->proc_name->backend_decl)
2141 {
2142 /* By construction, the external function cannot be
2143 a contained procedure. */
2144 locus old_loc;
2145
2146 gfc_save_backend_locus (&old_loc);
2147 push_cfun (NULL__null);
2148
2149 gfc_create_function_decl (gsym->ns, true);
2150
2151 pop_cfun ();
2152 gfc_restore_backend_locus (&old_loc);
2153 }
2154
2155 /* If the namespace has entries, the proc_name is the
2156 entry master. Find the entry and use its backend_decl.
2157 otherwise, use the proc_name backend_decl. */
2158 if (gsym->ns->entries)
2159 {
2160 gfc_entry_list *entry = gsym->ns->entries;
2161
2162 for (; entry; entry = entry->next)
2163 {
2164 if (strcmp (gsym->name, entry->sym->name) == 0)
2165 {
2166 sym->backend_decl = entry->sym->backend_decl;
2167 break;
2168 }
2169 }
2170 }
2171 else
2172 sym->backend_decl = gsym->ns->proc_name->backend_decl;
2173
2174 if (sym->backend_decl)
2175 {
2176 /* Avoid problems of double deallocation of the backend declaration
2177 later in gfc_trans_use_stmts; cf. PR 45087. */
2178 if (sym->attr.if_source != IFSRC_DECL && sym->attr.use_assoc)
2179 sym->attr.use_assoc = 0;
2180
2181 return sym->backend_decl;
2182 }
2183 }
2184
2185 /* See if this is a module procedure from the same file. If so,
2186 return the backend_decl. */
2187 if (sym->module)
2188 gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module);
2189
2190module_sym:
2191 if (gsym && gsym->ns
2192 && (gsym->type == GSYM_MODULE
2193 || (gsym->ns->proc_name && gsym->ns->proc_name->attr.flavor == FL_MODULE)))
2194 {
2195 gfc_symbol *s;
2196
2197 s = NULL__null;
2198 if (gsym->type == GSYM_MODULE)
2199 gfc_find_symbol (sym->name, gsym->ns, 0, &s);
2200 else
2201 gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &s);
2202
2203 if (s && s->backend_decl)
2204 {
2205 if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
2206 gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived,
2207 true);
2208 else if (sym->ts.type == BT_CHARACTER)
2209 sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;
2210 sym->backend_decl = s->backend_decl;
2211 return sym->backend_decl;
2212 }
2213 }
2214
2215 if (sym->attr.intrinsic)
2216 {
2217 /* Call the resolution function to get the actual name. This is
2218 a nasty hack which relies on the resolution functions only looking
2219 at the first argument. We pass NULL for the second argument
2220 otherwise things like AINT get confused. */
2221 isym = gfc_find_function (sym->name);
2222 gcc_assert (isym->resolve.f0 != NULL)((void)(!(isym->resolve.f0 != __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2222, __FUNCTION__), 0 : 0))
;
2223
2224 memset (&e, 0, sizeof (e));
2225 e.expr_type = EXPR_FUNCTION;
2226
2227 memset (&argexpr, 0, sizeof (argexpr));
2228 gcc_assert (isym->formal)((void)(!(isym->formal) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2228, __FUNCTION__), 0 : 0))
;
2229 argexpr.ts = isym->formal->ts;
2230
2231 if (isym->formal->next == NULL__null)
2232 isym->resolve.f1 (&e, &argexpr);
2233 else
2234 {
2235 if (isym->formal->next->next == NULL__null)
2236 isym->resolve.f2 (&e, &argexpr, NULL__null);
2237 else
2238 {
2239 if (isym->formal->next->next->next == NULL__null)
2240 isym->resolve.f3 (&e, &argexpr, NULL__null, NULL__null);
2241 else
2242 {
2243 /* All specific intrinsics take less than 5 arguments. */
2244 gcc_assert (isym->formal->next->next->next->next == NULL)((void)(!(isym->formal->next->next->next->next
== __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2244, __FUNCTION__), 0 : 0))
;
2245 if (isym->resolve.f1m == gfc_resolve_index_func)
2246 {
2247 /* gfc_resolve_index_func is special because it takes a
2248 gfc_actual_arglist instead of individual arguments. */
2249 gfc_actual_arglist *a, *n;
2250 int i;
2251 a = gfc_get_actual_arglist()((gfc_actual_arglist *) xcalloc (1, sizeof (gfc_actual_arglist
)))
;
2252 n = a;
2253
2254 for (i = 0; i < 4; i++)
2255 {
2256 n->next = gfc_get_actual_arglist()((gfc_actual_arglist *) xcalloc (1, sizeof (gfc_actual_arglist
)))
;
2257 n = n->next;
2258 }
2259
2260 a->expr = &argexpr;
2261 isym->resolve.f1m (&e, a);
2262 a->expr = NULL__null;
2263 gfc_free_actual_arglist (a);
2264 }
2265 else
2266 isym->resolve.f4 (&e, &argexpr, NULL__null, NULL__null, NULL__null);
2267 }
2268 }
2269 }
2270
2271 if (flag_f2cglobal_options.x_flag_f2c
2272 && ((e.ts.type == BT_REAL && e.ts.kind == gfc_default_real_kind)
2273 || e.ts.type == BT_COMPLEX))
2274 {
2275 /* Specific which needs a different implementation if f2c
2276 calling conventions are used. */
2277 sprintf (s, "_gfortran_f2c_specific%s", e.value.function.name);
2278 }
2279 else
2280 sprintf (s, "_gfortran_specific%s", e.value.function.name);
2281
2282 name = get_identifier (s)(__builtin_constant_p (s) ? get_identifier_with_length ((s), strlen
(s)) : get_identifier (s))
;
2283 mangled_name = name;
2284 }
2285 else
2286 {
2287 name = gfc_sym_identifier (sym);
2288 mangled_name = gfc_sym_mangled_function_id (sym);
2289 }
2290
2291 type = gfc_get_function_type (sym, actual_args, fnspec);
2292
2293 fndecl = build_decl (input_location,
2294 FUNCTION_DECL, name, type);
2295
2296 /* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes;
2297 TREE_PUBLIC specifies whether a function is globally addressable (i.e.
2298 the opposite of declaring a function as static in C). */
2299 DECL_EXTERNAL (fndecl)((contains_struct_check ((fndecl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2299, __FUNCTION__))->decl_common.decl_flag_1)
= 1;
2300 TREE_PUBLIC (fndecl)((fndecl)->base.public_flag) = 1;
2301
2302 attributes = add_attributes_to_decl (sym->attr, NULL_TREE(tree) __null);
2303 decl_attributes (&fndecl, attributes, 0);
2304
2305 gfc_set_decl_assembler_name (fndecl, mangled_name);
2306
2307 /* Set the context of this decl. */
2308 if (0 && sym->ns && sym->ns->proc_name)
2309 {
2310 /* TODO: Add external decls to the appropriate scope. */
2311 DECL_CONTEXT (fndecl)((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2311, __FUNCTION__))->decl_minimal.context)
= sym->ns->proc_name->backend_decl;
2312 }
2313 else
2314 {
2315 /* Global declaration, e.g. intrinsic subroutine. */
2316 DECL_CONTEXT (fndecl)((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2316, __FUNCTION__))->decl_minimal.context)
= NULL_TREE(tree) __null;
2317 }
2318
2319 /* Set attributes for PURE functions. A call to PURE function in the
2320 Fortran 95 sense is both pure and without side effects in the C
2321 sense. */
2322 if (sym->attr.pure || sym->attr.implicit_pure)
2323 {
2324 if (sym->attr.function && !gfc_return_by_reference (sym))
2325 DECL_PURE_P (fndecl)((tree_check ((fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2325, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
2326 /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT)
2327 parameters and don't use alternate returns (is this
2328 allowed?). In that case, calls to them are meaningless, and
2329 can be optimized away. See also in build_function_decl(). */
2330 TREE_SIDE_EFFECTS (fndecl)((non_type_check ((fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2330, __FUNCTION__))->base.side_effects_flag)
= 0;
2331 }
2332
2333 /* Mark non-returning functions. */
2334 if (sym->attr.noreturn)
2335 TREE_THIS_VOLATILE(fndecl)((fndecl)->base.volatile_flag) = 1;
2336
2337 sym->backend_decl = fndecl;
2338
2339 if (DECL_CONTEXT (fndecl)((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2339, __FUNCTION__))->decl_minimal.context)
== NULL_TREE(tree) __null)
2340 pushdecl_top_level (fndecl);
2341
2342 if (sym->formal_ns
2343 && sym->formal_ns->proc_name == sym
2344 && sym->formal_ns->omp_declare_simd)
2345 gfc_trans_omp_declare_simd (sym->formal_ns);
2346
2347 return fndecl;
2348}
2349
2350
2351/* Create a declaration for a procedure. For external functions (in the C
2352 sense) use gfc_get_extern_function_decl. HAS_ENTRIES is true if this is
2353 a master function with alternate entry points. */
2354
2355static void
2356build_function_decl (gfc_symbol * sym, bool global)
2357{
2358 tree fndecl, type, attributes;
2359 symbol_attribute attr;
2360 tree result_decl;
2361 gfc_formal_arglist *f;
2362
2363 bool module_procedure = sym->attr.module_procedure
2364 && sym->ns
2365 && sym->ns->proc_name
2366 && sym->ns->proc_name->attr.flavor == FL_MODULE;
2367
2368 gcc_assert (!sym->attr.external || module_procedure)((void)(!(!sym->attr.external || module_procedure) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2368, __FUNCTION__), 0 : 0))
;
2369
2370 if (sym->backend_decl)
2371 return;
2372
2373 /* Set the line and filename. sym->declared_at seems to point to the
2374 last statement for subroutines, but it'll do for now. */
2375 gfc_set_backend_locus (&sym->declared_at);
2376
2377 /* Allow only one nesting level. Allow public declarations. */
2378 gcc_assert (current_function_decl == NULL_TREE((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2380, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2381, __FUNCTION__), 0 : 0))
2379 || DECL_FILE_SCOPE_P (current_function_decl)((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2380, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2381, __FUNCTION__), 0 : 0))
2380 || (TREE_CODE (DECL_CONTEXT (current_function_decl))((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2380, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2381, __FUNCTION__), 0 : 0))
2381 == NAMESPACE_DECL))((void)(!(current_function_decl == (tree) __null || (! (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2379, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL) || (((enum tree_code) (((contains_struct_check
((current_function_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2380, __FUNCTION__))->decl_minimal.context))->base.code
) == NAMESPACE_DECL)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2381, __FUNCTION__), 0 : 0))
;
2382
2383 type = gfc_get_function_type (sym);
2384 fndecl = build_decl (input_location,
2385 FUNCTION_DECL, gfc_sym_identifier (sym), type);
2386
2387 attr = sym->attr;
2388
2389 /* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes;
2390 TREE_PUBLIC specifies whether a function is globally addressable (i.e.
2391 the opposite of declaring a function as static in C). */
2392 DECL_EXTERNAL (fndecl)((contains_struct_check ((fndecl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2392, __FUNCTION__))->decl_common.decl_flag_1)
= 0;
2393
2394 if (sym->attr.access == ACCESS_UNKNOWN && sym->module
2395 && (sym->ns->default_access == ACCESS_PRIVATE
2396 || (sym->ns->default_access == ACCESS_UNKNOWN
2397 && flag_module_privateglobal_options.x_flag_module_private)))
2398 sym->attr.access = ACCESS_PRIVATE;
2399
2400 if (!current_function_decl
2401 && !sym->attr.entry_master && !sym->attr.is_main_program
2402 && (sym->attr.access != ACCESS_PRIVATE || sym->binding_label
2403 || sym->attr.public_used))
2404 TREE_PUBLIC (fndecl)((fndecl)->base.public_flag) = 1;
2405
2406 if (sym->attr.referenced || sym->attr.entry_master)
2407 TREE_USED (fndecl)((fndecl)->base.used_flag) = 1;
2408
2409 attributes = add_attributes_to_decl (attr, NULL_TREE(tree) __null);
2410 decl_attributes (&fndecl, attributes, 0);
2411
2412 /* Figure out the return type of the declared function, and build a
2413 RESULT_DECL for it. If this is a subroutine with alternate
2414 returns, build a RESULT_DECL for it. */
2415 result_decl = NULL_TREE(tree) __null;
2416 /* TODO: Shouldn't this just be TREE_TYPE (TREE_TYPE (fndecl)). */
2417 if (attr.function)
2418 {
2419 if (gfc_return_by_reference (sym))
2420 type = void_type_nodeglobal_trees[TI_VOID_TYPE];
2421 else
2422 {
2423 if (sym->result != sym)
2424 result_decl = gfc_sym_identifier (sym->result);
2425
2426 type = TREE_TYPE (TREE_TYPE (fndecl))((contains_struct_check ((((contains_struct_check ((fndecl), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2426, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2426, __FUNCTION__))->typed.type)
;
2427 }
2428 }
2429 else
2430 {
2431 /* Look for alternate return placeholders. */
2432 int has_alternate_returns = 0;
2433 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2434 {
2435 if (f->sym == NULL__null)
2436 {
2437 has_alternate_returns = 1;
2438 break;
2439 }
2440 }
2441
2442 if (has_alternate_returns)
2443 type = integer_type_nodeinteger_types[itk_int];
2444 else
2445 type = void_type_nodeglobal_trees[TI_VOID_TYPE];
2446 }
2447
2448 result_decl = build_decl (input_location,
2449 RESULT_DECL, result_decl, type);
2450 DECL_ARTIFICIAL (result_decl)((contains_struct_check ((result_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2450, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2451 DECL_IGNORED_P (result_decl)((contains_struct_check ((result_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2451, __FUNCTION__))->decl_common.ignored_flag)
= 1;
2452 DECL_CONTEXT (result_decl)((contains_struct_check ((result_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2452, __FUNCTION__))->decl_minimal.context)
= fndecl;
2453 DECL_RESULT (fndecl)((tree_check ((fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2453, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)
= result_decl;
2454
2455 /* Don't call layout_decl for a RESULT_DECL.
2456 layout_decl (result_decl, 0); */
2457
2458 /* TREE_STATIC means the function body is defined here. */
2459 TREE_STATIC (fndecl)((fndecl)->base.static_flag) = 1;
2460
2461 /* Set attributes for PURE functions. A call to a PURE function in the
2462 Fortran 95 sense is both pure and without side effects in the C
2463 sense. */
2464 if (attr.pure || attr.implicit_pure)
2465 {
2466 /* TODO: check if a pure SUBROUTINE has no INTENT(OUT) arguments
2467 including an alternate return. In that case it can also be
2468 marked as PURE. See also in gfc_get_extern_function_decl(). */
2469 if (attr.function && !gfc_return_by_reference (sym))
2470 DECL_PURE_P (fndecl)((tree_check ((fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2470, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
2471 TREE_SIDE_EFFECTS (fndecl)((non_type_check ((fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2471, __FUNCTION__))->base.side_effects_flag)
= 0;
2472 }
2473
2474
2475 /* Layout the function declaration and put it in the binding level
2476 of the current function. */
2477
2478 if (global)
2479 pushdecl_top_level (fndecl);
2480 else
2481 pushdecl (fndecl);
2482
2483 /* Perform name mangling if this is a top level or module procedure. */
2484 if (current_function_decl == NULL_TREE(tree) __null)
2485 gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym));
2486
2487 sym->backend_decl = fndecl;
2488}
2489
2490
2491/* Create the DECL_ARGUMENTS for a procedure. */
2492
2493static void
2494create_function_arglist (gfc_symbol * sym)
2495{
2496 tree fndecl;
2497 gfc_formal_arglist *f;
2498 tree typelist, hidden_typelist;
2499 tree arglist, hidden_arglist;
2500 tree type;
2501 tree parm;
2502
2503 fndecl = sym->backend_decl;
2504
2505 /* Build formal argument list. Make sure that their TREE_CONTEXT is
2506 the new FUNCTION_DECL node. */
2507 arglist = NULL_TREE(tree) __null;
2508 hidden_arglist = NULL_TREE(tree) __null;
2509 typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl))((tree_check2 ((((contains_struct_check ((fndecl), (TS_TYPED)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2509, __FUNCTION__))->typed.type)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2509, __FUNCTION__, (FUNCTION_TYPE), (METHOD_TYPE)))->type_non_common
.values)
;
2510
2511 if (sym->attr.entry_master)
2512 {
2513 type = TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2513, __FUNCTION__, (TREE_LIST)))->list.value)
;
2514 parm = build_decl (input_location,
2515 PARM_DECL, get_identifier ("__entry")(__builtin_constant_p ("__entry") ? get_identifier_with_length
(("__entry"), strlen ("__entry")) : get_identifier ("__entry"
))
, type);
2516
2517 DECL_CONTEXT (parm)((contains_struct_check ((parm), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2517, __FUNCTION__))->decl_minimal.context)
= fndecl;
2518 DECL_ARG_TYPE (parm)((tree_check ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2518, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= type;
2519 TREE_READONLY (parm)((non_type_check ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2519, __FUNCTION__))->base.readonly_flag)
= 1;
2520 gfc_finish_decl (parm);
2521 DECL_ARTIFICIAL (parm)((contains_struct_check ((parm), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2521, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2522
2523 arglist = chainon (arglist, parm);
2524 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2524, __FUNCTION__))->common.chain)
;
2525 }
2526
2527 if (gfc_return_by_reference (sym))
2528 {
2529 tree type = TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2529, __FUNCTION__, (TREE_LIST)))->list.value)
, length = NULL__null;
2530
2531 if (sym->ts.type == BT_CHARACTER)
2532 {
2533 /* Length of character result. */
2534 tree len_type = TREE_VALUE (TREE_CHAIN (typelist))((tree_check ((((contains_struct_check ((typelist), (TS_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2534, __FUNCTION__))->common.chain)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2534, __FUNCTION__, (TREE_LIST)))->list.value)
;
2535
2536 length = build_decl (input_location,
2537 PARM_DECL,
2538 get_identifier (".__result")(__builtin_constant_p (".__result") ? get_identifier_with_length
((".__result"), strlen (".__result")) : get_identifier (".__result"
))
,
2539 len_type);
2540 if (POINTER_TYPE_P (len_type)(((enum tree_code) (len_type)->base.code) == POINTER_TYPE ||
((enum tree_code) (len_type)->base.code) == REFERENCE_TYPE
)
)
2541 {
2542 sym->ts.u.cl->passed_length = length;
2543 TREE_USED (length)((length)->base.used_flag) = 1;
2544 }
2545 else if (!sym->ts.u.cl->length)
2546 {
2547 sym->ts.u.cl->backend_decl = length;
2548 TREE_USED (length)((length)->base.used_flag) = 1;
2549 }
2550 gcc_assert (TREE_CODE (length) == PARM_DECL)((void)(!(((enum tree_code) (length)->base.code) == PARM_DECL
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2550, __FUNCTION__), 0 : 0))
;
2551 DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2551, __FUNCTION__))->decl_minimal.context)
= fndecl;
2552 DECL_ARG_TYPE (length)((tree_check ((length), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2552, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= len_type;
2553 TREE_READONLY (length)((non_type_check ((length), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2553, __FUNCTION__))->base.readonly_flag)
= 1;
2554 DECL_ARTIFICIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2554, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2555 gfc_finish_decl (length);
2556 if (sym->ts.u.cl->backend_decl == NULL__null
2557 || sym->ts.u.cl->backend_decl == length)
2558 {
2559 gfc_symbol *arg;
2560 tree backend_decl;
2561
2562 if (sym->ts.u.cl->backend_decl == NULL__null)
2563 {
2564 tree len = build_decl (input_location,
2565 VAR_DECL,
2566 get_identifier ("..__result")(__builtin_constant_p ("..__result") ? get_identifier_with_length
(("..__result"), strlen ("..__result")) : get_identifier ("..__result"
))
,
2567 gfc_charlen_type_node);
2568 DECL_ARTIFICIAL (len)((contains_struct_check ((len), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2568, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2569 TREE_USED (len)((len)->base.used_flag) = 1;
2570 sym->ts.u.cl->backend_decl = len;
2571 }
2572
2573 /* Make sure PARM_DECL type doesn't point to incomplete type. */
2574 arg = sym->result ? sym->result : sym;
2575 backend_decl = arg->backend_decl;
2576 /* Temporary clear it, so that gfc_sym_type creates complete
2577 type. */
2578 arg->backend_decl = NULL__null;
2579 type = gfc_sym_type (arg);
2580 arg->backend_decl = backend_decl;
2581 type = build_reference_type (type);
2582 }
2583 }
2584
2585 parm = build_decl (input_location,
2586 PARM_DECL, get_identifier ("__result")(__builtin_constant_p ("__result") ? get_identifier_with_length
(("__result"), strlen ("__result")) : get_identifier ("__result"
))
, type);
2587
2588 DECL_CONTEXT (parm)((contains_struct_check ((parm), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2588, __FUNCTION__))->decl_minimal.context)
= fndecl;
2589 DECL_ARG_TYPE (parm)((tree_check ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2589, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2589, __FUNCTION__, (TREE_LIST)))->list.value)
;
2590 TREE_READONLY (parm)((non_type_check ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2590, __FUNCTION__))->base.readonly_flag)
= 1;
2591 DECL_ARTIFICIAL (parm)((contains_struct_check ((parm), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2591, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2592 gfc_finish_decl (parm);
2593
2594 arglist = chainon (arglist, parm);
2595 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2595, __FUNCTION__))->common.chain)
;
2596
2597 if (sym->ts.type == BT_CHARACTER)
2598 {
2599 gfc_allocate_lang_decl (parm);
2600 arglist = chainon (arglist, length);
2601 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2601, __FUNCTION__))->common.chain)
;
2602 }
2603 }
2604
2605 hidden_typelist = typelist;
2606 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2607 if (f->sym != NULL__null) /* Ignore alternate returns. */
2608 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2608, __FUNCTION__))->common.chain)
;
2609
2610 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2611 {
2612 char name[GFC_MAX_SYMBOL_LEN63 + 2];
2613
2614 /* Ignore alternate returns. */
2615 if (f->sym == NULL__null)
2616 continue;
2617
2618 type = TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2618, __FUNCTION__, (TREE_LIST)))->list.value)
;
2619
2620 if (f->sym->ts.type == BT_CHARACTER
2621 && (!sym->attr.is_bind_c || sym->attr.entry_master))
2622 {
2623 tree len_type = TREE_VALUE (hidden_typelist)((tree_check ((hidden_typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2623, __FUNCTION__, (TREE_LIST)))->list.value)
;
2624 tree length = NULL_TREE(tree) __null;
2625 if (!f->sym->ts.deferred)
2626 gcc_assert (len_type == gfc_charlen_type_node)((void)(!(len_type == gfc_charlen_type_node) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2626, __FUNCTION__), 0 : 0))
;
2627 else
2628 gcc_assert (POINTER_TYPE_P (len_type))((void)(!((((enum tree_code) (len_type)->base.code) == POINTER_TYPE
|| ((enum tree_code) (len_type)->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2628, __FUNCTION__), 0 : 0))
;
2629
2630 strcpy (&name[1], f->sym->name);
2631 name[0] = '_';
2632 length = build_decl (input_location,
2633 PARM_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
, len_type);
2634
2635 hidden_arglist = chainon (hidden_arglist, length);
2636 DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2636, __FUNCTION__))->decl_minimal.context)
= fndecl;
2637 DECL_ARTIFICIAL (length)((contains_struct_check ((length), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2637, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2638 DECL_ARG_TYPE (length)((tree_check ((length), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2638, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= len_type;
2639 TREE_READONLY (length)((non_type_check ((length), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2639, __FUNCTION__))->base.readonly_flag)
= 1;
2640 gfc_finish_decl (length);
2641
2642 /* Marking the length DECL_HIDDEN_STRING_LENGTH will lead
2643 to tail calls being disabled. Only do that if we
2644 potentially have broken callers. */
2645 if (flag_tail_call_workaroundglobal_options.x_flag_tail_call_workaround
2646 && f->sym->ts.u.cl
2647 && f->sym->ts.u.cl->length
2648 && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
2649 && (flag_tail_call_workaroundglobal_options.x_flag_tail_call_workaround == 2
2650 || f->sym->ns->implicit_interface_calls))
2651 DECL_HIDDEN_STRING_LENGTH (length)((tree_check ((length), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2651, __FUNCTION__, (PARM_DECL)))->decl_common.decl_nonshareable_flag
)
= 1;
2652
2653 /* Remember the passed value. */
2654 if (!f->sym->ts.u.cl || f->sym->ts.u.cl->passed_length)
2655 {
2656 /* This can happen if the same type is used for multiple
2657 arguments. We need to copy cl as otherwise
2658 cl->passed_length gets overwritten. */
2659 f->sym->ts.u.cl = gfc_new_charlen (f->sym->ns, f->sym->ts.u.cl);
2660 }
2661 f->sym->ts.u.cl->passed_length = length;
2662
2663 /* Use the passed value for assumed length variables. */
2664 if (!f->sym->ts.u.cl->length)
2665 {
2666 TREE_USED (length)((length)->base.used_flag) = 1;
2667 gcc_assert (!f->sym->ts.u.cl->backend_decl)((void)(!(!f->sym->ts.u.cl->backend_decl) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2667, __FUNCTION__), 0 : 0))
;
2668 f->sym->ts.u.cl->backend_decl = length;
2669 }
2670
2671 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2671, __FUNCTION__))->common.chain)
;
2672
2673 if (f->sym->ts.u.cl->backend_decl == NULL__null
2674 || f->sym->ts.u.cl->backend_decl == length)
2675 {
2676 if (POINTER_TYPE_P (len_type)(((enum tree_code) (len_type)->base.code) == POINTER_TYPE ||
((enum tree_code) (len_type)->base.code) == REFERENCE_TYPE
)
)
2677 f->sym->ts.u.cl->backend_decl
2678 = build_fold_indirect_ref_loc (input_location, length);
2679 else if (f->sym->ts.u.cl->backend_decl == NULL__null)
2680 gfc_create_string_length (f->sym);
2681
2682 /* Make sure PARM_DECL type doesn't point to incomplete type. */
2683 if (f->sym->attr.flavor == FL_PROCEDURE)
2684 type = build_pointer_type (gfc_get_function_type (f->sym));
2685 else
2686 type = gfc_sym_type (f->sym);
2687 }
2688 }
2689 /* For noncharacter scalar intrinsic types, VALUE passes the value,
2690 hence, the optional status cannot be transferred via a NULL pointer.
2691 Thus, we will use a hidden argument in that case. */
2692 else if (f->sym->attr.optional && f->sym->attr.value
2693 && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
2694 && !gfc_bt_struct (f->sym->ts.type)((f->sym->ts.type) == BT_DERIVED || (f->sym->ts.type
) == BT_UNION)
)
2695 {
2696 tree tmp;
2697 strcpy (&name[1], f->sym->name);
2698 name[0] = '_';
2699 tmp = build_decl (input_location,
2700 PARM_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
,
2701 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
2702
2703 hidden_arglist = chainon (hidden_arglist, tmp);
2704 DECL_CONTEXT (tmp)((contains_struct_check ((tmp), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2704, __FUNCTION__))->decl_minimal.context)
= fndecl;
2705 DECL_ARTIFICIAL (tmp)((contains_struct_check ((tmp), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2705, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2706 DECL_ARG_TYPE (tmp)((tree_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2706, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE];
2707 TREE_READONLY (tmp)((non_type_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2707, __FUNCTION__))->base.readonly_flag)
= 1;
2708 gfc_finish_decl (tmp);
2709
2710 hidden_typelist = TREE_CHAIN (hidden_typelist)((contains_struct_check ((hidden_typelist), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2710, __FUNCTION__))->common.chain)
;
2711 }
2712
2713 /* For non-constant length array arguments, make sure they use
2714 a different type node from TYPE_ARG_TYPES type. */
2715 if (f->sym->attr.dimension
2716 && type == TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2716, __FUNCTION__, (TREE_LIST)))->list.value)
2717 && TREE_CODE (type)((enum tree_code) (type)->base.code) == POINTER_TYPE
2718 && GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2718, __FUNCTION__))->type_common.lang_flag_2)
2719 && f->sym->as->type != AS_ASSUMED_SIZE
2720 && ! COMPLETE_TYPE_P (TREE_TYPE (type))(((tree_class_check ((((contains_struct_check ((type), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2720, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2720, __FUNCTION__))->type_common.size) != (tree) __null
)
)
2721 {
2722 if (f->sym->attr.flavor == FL_PROCEDURE)
2723 type = build_pointer_type (gfc_get_function_type (f->sym));
2724 else
2725 type = gfc_sym_type (f->sym);
2726 }
2727
2728 if (f->sym->attr.proc_pointer)
2729 type = build_pointer_type (type);
2730
2731 if (f->sym->attr.volatile_)
2732 type = build_qualified_type (type, TYPE_QUAL_VOLATILE);
2733
2734 /* Build the argument declaration. */
2735 parm = build_decl (input_location,
2736 PARM_DECL, gfc_sym_identifier (f->sym), type);
2737
2738 if (f->sym->attr.volatile_)
2739 {
2740 TREE_THIS_VOLATILE (parm)((parm)->base.volatile_flag) = 1;
2741 TREE_SIDE_EFFECTS (parm)((non_type_check ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2741, __FUNCTION__))->base.side_effects_flag)
= 1;
2742 }
2743
2744 /* Fill in arg stuff. */
2745 DECL_CONTEXT (parm)((contains_struct_check ((parm), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2745, __FUNCTION__))->decl_minimal.context)
= fndecl;
2746 DECL_ARG_TYPE (parm)((tree_check ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2746, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2746, __FUNCTION__, (TREE_LIST)))->list.value)
;
2747 /* All implementation args except for VALUE are read-only. */
2748 if (!f->sym->attr.value)
2749 TREE_READONLY (parm)((non_type_check ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2749, __FUNCTION__))->base.readonly_flag)
= 1;
2750 if (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE)
2751 && (!f->sym->attr.proc_pointer
2752 && f->sym->attr.flavor != FL_PROCEDURE))
2753 DECL_BY_REFERENCE (parm)((tree_check3 ((parm), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2753, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL))
)->decl_common.decl_by_reference_flag)
= 1;
2754 if (f->sym->attr.optional)
2755 {
2756 gfc_allocate_lang_decl (parm);
2757 GFC_DECL_OPTIONAL_ARGUMENT (parm)(((contains_struct_check ((parm), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2757, __FUNCTION__))->decl_common.lang_specific)->optional_arg
)
= 1;
2758 }
2759
2760 gfc_finish_decl (parm);
2761 gfc_finish_decl_attrs (parm, &f->sym->attr);
2762
2763 f->sym->backend_decl = parm;
2764
2765 /* Coarrays which are descriptorless or assumed-shape pass with
2766 -fcoarray=lib the token and the offset as hidden arguments. */
2767 if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
2768 && ((f->sym->ts.type != BT_CLASS && f->sym->attr.codimension
2769 && !f->sym->attr.allocatable)
2770 || (f->sym->ts.type == BT_CLASS
2771 && CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.codimension
2772 && !CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.allocatable)))
2773 {
2774 tree caf_type;
2775 tree token;
2776 tree offset;
2777
2778 gcc_assert (f->sym->backend_decl != NULL_TREE((void)(!(f->sym->backend_decl != (tree) __null &&
!sym->attr.is_bind_c) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2779, __FUNCTION__), 0 : 0))
2779 && !sym->attr.is_bind_c)((void)(!(f->sym->backend_decl != (tree) __null &&
!sym->attr.is_bind_c) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2779, __FUNCTION__), 0 : 0))
;
2780 caf_type = f->sym->ts.type == BT_CLASS
2781 ? TREE_TYPE (CLASS_DATA (f->sym)->backend_decl)((contains_struct_check ((f->sym->ts.u.derived->components
->backend_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2781, __FUNCTION__))->typed.type)
2782 : TREE_TYPE (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2782, __FUNCTION__))->typed.type)
;
2783
2784 token = build_decl (input_location, PARM_DECL,
2785 create_tmp_var_name ("caf_token"),
2786 build_qualified_type (pvoid_type_node,
2787 TYPE_QUAL_RESTRICT));
2788 if ((f->sym->ts.type != BT_CLASS
2789 && f->sym->as->type != AS_DEFERRED)
2790 || (f->sym->ts.type == BT_CLASS
2791 && CLASS_DATA (f->sym)f->sym->ts.u.derived->components->as->type != AS_DEFERRED))
2792 {
2793 gcc_assert (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2793, __FUNCTION__))->decl_common.lang_specific) == __null
|| ((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2794, __FUNCTION__))->decl_common.lang_specific)->token
== (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2794, __FUNCTION__), 0 : 0))
2794 || GFC_DECL_TOKEN (f->sym->backend_decl) == NULL_TREE)((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2793, __FUNCTION__))->decl_common.lang_specific) == __null
|| ((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2794, __FUNCTION__))->decl_common.lang_specific)->token
== (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2794, __FUNCTION__), 0 : 0))
;
2795 if (DECL_LANG_SPECIFIC (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2795, __FUNCTION__))->decl_common.lang_specific)
== NULL__null)
2796 gfc_allocate_lang_decl (f->sym->backend_decl);
2797 GFC_DECL_TOKEN (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2797, __FUNCTION__))->decl_common.lang_specific)->token
= token;
2798 }
2799 else
2800 {
2801 gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE)((void)(!((((tree_class_check ((caf_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2801, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token) == (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2801, __FUNCTION__), 0 : 0))
;
2802 GFC_TYPE_ARRAY_CAF_TOKEN (caf_type)(((tree_class_check ((caf_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2802, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_token)
= token;
2803 }
2804
2805 DECL_CONTEXT (token)((contains_struct_check ((token), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2805, __FUNCTION__))->decl_minimal.context)
= fndecl;
2806 DECL_ARTIFICIAL (token)((contains_struct_check ((token), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2806, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2807 DECL_ARG_TYPE (token)((tree_check ((token), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2807, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2807, __FUNCTION__, (TREE_LIST)))->list.value)
;
2808 TREE_READONLY (token)((non_type_check ((token), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2808, __FUNCTION__))->base.readonly_flag)
= 1;
2809 hidden_arglist = chainon (hidden_arglist, token);
2810 gfc_finish_decl (token);
2811
2812 offset = build_decl (input_location, PARM_DECL,
2813 create_tmp_var_name ("caf_offset"),
2814 gfc_array_index_type);
2815
2816 if ((f->sym->ts.type != BT_CLASS
2817 && f->sym->as->type != AS_DEFERRED)
2818 || (f->sym->ts.type == BT_CLASS
2819 && CLASS_DATA (f->sym)f->sym->ts.u.derived->components->as->type != AS_DEFERRED))
2820 {
2821 gcc_assert (GFC_DECL_CAF_OFFSET (f->sym->backend_decl)((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2821, __FUNCTION__))->decl_common.lang_specific)->caf_offset
== (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2822, __FUNCTION__), 0 : 0))
2822 == NULL_TREE)((void)(!(((contains_struct_check ((f->sym->backend_decl
), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2821, __FUNCTION__))->decl_common.lang_specific)->caf_offset
== (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2822, __FUNCTION__), 0 : 0))
;
2823 GFC_DECL_CAF_OFFSET (f->sym->backend_decl)((contains_struct_check ((f->sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2823, __FUNCTION__))->decl_common.lang_specific)->caf_offset
= offset;
2824 }
2825 else
2826 {
2827 gcc_assert (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) == NULL_TREE)((void)(!((((tree_class_check ((caf_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2827, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_offset) == (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2827, __FUNCTION__), 0 : 0))
;
2828 GFC_TYPE_ARRAY_CAF_OFFSET (caf_type)(((tree_class_check ((caf_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2828, __FUNCTION__))->type_with_lang_specific.lang_specific
)->caf_offset)
= offset;
2829 }
2830 DECL_CONTEXT (offset)((contains_struct_check ((offset), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2830, __FUNCTION__))->decl_minimal.context)
= fndecl;
2831 DECL_ARTIFICIAL (offset)((contains_struct_check ((offset), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2831, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2832 DECL_ARG_TYPE (offset)((tree_check ((offset), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2832, __FUNCTION__, (PARM_DECL)))->decl_common.initial)
= TREE_VALUE (typelist)((tree_check ((typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2832, __FUNCTION__, (TREE_LIST)))->list.value)
;
2833 TREE_READONLY (offset)((non_type_check ((offset), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2833, __FUNCTION__))->base.readonly_flag)
= 1;
2834 hidden_arglist = chainon (hidden_arglist, offset);
2835 gfc_finish_decl (offset);
2836 }
2837
2838 arglist = chainon (arglist, parm);
2839 typelist = TREE_CHAIN (typelist)((contains_struct_check ((typelist), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2839, __FUNCTION__))->common.chain)
;
2840 }
2841
2842 /* Add the hidden string length parameters, unless the procedure
2843 is bind(C). */
2844 if (!sym->attr.is_bind_c)
2845 arglist = chainon (arglist, hidden_arglist);
2846
2847 gcc_assert (hidden_typelist == NULL_TREE((void)(!(hidden_typelist == (tree) __null || ((tree_check ((
hidden_typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2848, __FUNCTION__, (TREE_LIST)))->list.value) == global_trees
[TI_VOID_TYPE]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2848, __FUNCTION__), 0 : 0))
2848 || TREE_VALUE (hidden_typelist) == void_type_node)((void)(!(hidden_typelist == (tree) __null || ((tree_check ((
hidden_typelist), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2848, __FUNCTION__, (TREE_LIST)))->list.value) == global_trees
[TI_VOID_TYPE]) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2848, __FUNCTION__), 0 : 0))
;
2849 DECL_ARGUMENTS (fndecl)((tree_check ((fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2849, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
)
= arglist;
2850}
2851
2852/* Do the setup necessary before generating the body of a function. */
2853
2854static void
2855trans_function_start (gfc_symbol * sym)
2856{
2857 tree fndecl;
2858
2859 fndecl = sym->backend_decl;
2860
2861 /* Let GCC know the current scope is this function. */
2862 current_function_decl = fndecl;
2863
2864 /* Let the world know what we're about to do. */
2865 announce_function (fndecl);
2866
2867 if (DECL_FILE_SCOPE_P (fndecl)(! (((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2867, __FUNCTION__))->decl_minimal.context)) || ((enum tree_code
) (((contains_struct_check ((fndecl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2867, __FUNCTION__))->decl_minimal.context))->base.code
) == TRANSLATION_UNIT_DECL)
)
2868 {
2869 /* Create RTL for function declaration. */
2870 rest_of_decl_compilation (fndecl, 1, 0);
2871 }
2872
2873 /* Create RTL for function definition. */
2874 make_decl_rtl (fndecl);
2875
2876 allocate_struct_function (fndecl, false);
2877
2878 /* function.c requires a push at the start of the function. */
2879 pushlevel ();
2880}
2881
2882/* Create thunks for alternate entry points. */
2883
2884static void
2885build_entry_thunks (gfc_namespace * ns, bool global)
2886{
2887 gfc_formal_arglist *formal;
2888 gfc_formal_arglist *thunk_formal;
2889 gfc_entry_list *el;
2890 gfc_symbol *thunk_sym;
2891 stmtblock_t body;
2892 tree thunk_fndecl;
2893 tree tmp;
2894 locus old_loc;
2895
2896 /* This should always be a toplevel function. */
2897 gcc_assert (current_function_decl == NULL_TREE)((void)(!(current_function_decl == (tree) __null) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2897, __FUNCTION__), 0 : 0))
;
8
Assuming the condition is true
9
'?' condition is false
2898
2899 gfc_save_backend_locus (&old_loc);
2900 for (el = ns->entries; el; el = el->next)
10
Loop condition is true. Entering loop body
2901 {
2902 vec<tree, va_gc> *args = NULL__null;
11
'args' initialized to a null pointer value
2903 vec<tree, va_gc> *string_args = NULL__null;
2904
2905 thunk_sym = el->sym;
2906
2907 build_function_decl (thunk_sym, global);
2908 create_function_arglist (thunk_sym);
2909
2910 trans_function_start (thunk_sym);
2911
2912 thunk_fndecl = thunk_sym->backend_decl;
2913
2914 gfc_init_block (&body);
2915
2916 /* Pass extra parameter identifying this entry point. */
2917 tmp = build_int_cst (gfc_array_index_type, el->id);
2918 vec_safe_push (args, tmp);
12
Passing value via 1st parameter 'v'
13
Calling 'vec_safe_push<tree_node *, va_gc>'
2919
2920 if (thunk_sym->attr.function)
2921 {
2922 if (gfc_return_by_reference (ns->proc_name))
2923 {
2924 tree ref = DECL_ARGUMENTS (current_function_decl)((tree_check ((current_function_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2924, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
)
;
2925 vec_safe_push (args, ref);
2926 if (ns->proc_name->ts.type == BT_CHARACTER)
2927 vec_safe_push (args, DECL_CHAIN (ref)(((contains_struct_check (((contains_struct_check ((ref), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2927, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2927, __FUNCTION__))->common.chain))
);
2928 }
2929 }
2930
2931 for (formal = gfc_sym_get_dummy_args (ns->proc_name); formal;
2932 formal = formal->next)
2933 {
2934 /* Ignore alternate returns. */
2935 if (formal->sym == NULL__null)
2936 continue;
2937
2938 /* We don't have a clever way of identifying arguments, so resort to
2939 a brute-force search. */
2940 for (thunk_formal = gfc_sym_get_dummy_args (thunk_sym);
2941 thunk_formal;
2942 thunk_formal = thunk_formal->next)
2943 {
2944 if (thunk_formal->sym == formal->sym)
2945 break;
2946 }
2947
2948 if (thunk_formal)
2949 {
2950 /* Pass the argument. */
2951 DECL_ARTIFICIAL (thunk_formal->sym->backend_decl)((contains_struct_check ((thunk_formal->sym->backend_decl
), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2951, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2952 vec_safe_push (args, thunk_formal->sym->backend_decl);
2953 if (formal->sym->ts.type == BT_CHARACTER)
2954 {
2955 tmp = thunk_formal->sym->ts.u.cl->backend_decl;
2956 vec_safe_push (string_args, tmp);
2957 }
2958 }
2959 else
2960 {
2961 /* Pass NULL for a missing argument. */
2962 vec_safe_push (args, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
2963 if (formal->sym->ts.type == BT_CHARACTER)
2964 {
2965 tmp = build_int_cst (gfc_charlen_type_node, 0);
2966 vec_safe_push (string_args, tmp);
2967 }
2968 }
2969 }
2970
2971 /* Call the master function. */
2972 vec_safe_splice (args, string_args);
2973 tmp = ns->proc_name->backend_decl;
2974 tmp = build_call_expr_loc_vec (input_location, tmp, args);
2975 if (ns->proc_name->attr.mixed_entry_master)
2976 {
2977 tree union_decl, field;
2978 tree master_type = TREE_TYPE (ns->proc_name->backend_decl)((contains_struct_check ((ns->proc_name->backend_decl),
(TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2978, __FUNCTION__))->typed.type)
;
2979
2980 union_decl = build_decl (input_location,
2981 VAR_DECL, get_identifier ("__result")(__builtin_constant_p ("__result") ? get_identifier_with_length
(("__result"), strlen ("__result")) : get_identifier ("__result"
))
,
2982 TREE_TYPE (master_type)((contains_struct_check ((master_type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2982, __FUNCTION__))->typed.type)
);
2983 DECL_ARTIFICIAL (union_decl)((contains_struct_check ((union_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2983, __FUNCTION__))->decl_common.artificial_flag)
= 1;
2984 DECL_EXTERNAL (union_decl)((contains_struct_check ((union_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2984, __FUNCTION__))->decl_common.decl_flag_1)
= 0;
2985 TREE_PUBLIC (union_decl)((union_decl)->base.public_flag) = 0;
2986 TREE_USED (union_decl)((union_decl)->base.used_flag) = 1;
2987 layout_decl (union_decl, 0);
2988 pushdecl (union_decl);
2989
2990 DECL_CONTEXT (union_decl)((contains_struct_check ((union_decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2990, __FUNCTION__))->decl_minimal.context)
= current_function_decl;
2991 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
2992 TREE_TYPE (union_decl)((contains_struct_check ((union_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2992, __FUNCTION__))->typed.type)
, union_decl, tmp);
2993 gfc_add_expr_to_block (&body, tmp);
2994
2995 for (field = TYPE_FIELDS (TREE_TYPE (union_decl))((tree_check3 ((((contains_struct_check ((union_decl), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2995, __FUNCTION__))->typed.type)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2995, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
;
2996 field; field = DECL_CHAIN (field)(((contains_struct_check (((contains_struct_check ((field), (
TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2996, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2996, __FUNCTION__))->common.chain))
)
2997 if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field))((const char *) (tree_check ((((contains_struct_check ((field
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2997, __FUNCTION__))->decl_minimal.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 2997, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
,
2998 thunk_sym->result->name) == 0)
2999 break;
3000 gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3000, __FUNCTION__), 0 : 0))
;
3001 tmp = fold_build3_loc (input_location, COMPONENT_REF,
3002 TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3002, __FUNCTION__))->typed.type)
, union_decl, field,
3003 NULL_TREE(tree) __null);
3004 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
3005 TREE_TYPE (DECL_RESULT (current_function_decl))((contains_struct_check ((((tree_check ((current_function_decl
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3005, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3005, __FUNCTION__))->typed.type)
,
3006 DECL_RESULT (current_function_decl)((tree_check ((current_function_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3006, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)
, tmp);
3007 tmp = build1_v (RETURN_EXPR, tmp)fold_build1_loc (input_location, RETURN_EXPR, global_trees[TI_VOID_TYPE
], tmp)
;
3008 }
3009 else if (TREE_TYPE (DECL_RESULT (current_function_decl))((contains_struct_check ((((tree_check ((current_function_decl
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3009, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3009, __FUNCTION__))->typed.type)
3010 != void_type_nodeglobal_trees[TI_VOID_TYPE])
3011 {
3012 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
3013 TREE_TYPE (DECL_RESULT (current_function_decl))((contains_struct_check ((((tree_check ((current_function_decl
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3013, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3013, __FUNCTION__))->typed.type)
,
3014 DECL_RESULT (current_function_decl)((tree_check ((current_function_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3014, __FUNCTION__, (FUNCTION_DECL)))->decl_non_common.result
)
, tmp);
3015 tmp = build1_v (RETURN_EXPR, tmp)fold_build1_loc (input_location, RETURN_EXPR, global_trees[TI_VOID_TYPE
], tmp)
;
3016 }
3017 gfc_add_expr_to_block (&body, tmp);
3018
3019 /* Finish off this function and send it for code generation. */
3020 DECL_SAVED_TREE (thunk_fndecl)((tree_check ((thunk_fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3020, __FUNCTION__, (FUNCTION_DECL)))->function_decl.saved_tree
)
= gfc_finish_block (&body);
3021 tmp = getdecls ();
3022 poplevel (1, 1);
3023 BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl))((tree_check ((((contains_struct_check ((thunk_fndecl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3023, __FUNCTION__))->decl_common.initial)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3023, __FUNCTION__, (BLOCK)))->block.supercontext)
= thunk_fndecl;
3024 DECL_SAVED_TREE (thunk_fndecl)((tree_check ((thunk_fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3024, __FUNCTION__, (FUNCTION_DECL)))->function_decl.saved_tree
)
3025 = fold_build3_loc (DECL_SOURCE_LOCATION (thunk_fndecl)((contains_struct_check ((thunk_fndecl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3025, __FUNCTION__))->decl_minimal.locus)
, BIND_EXPR,
3026 void_type_nodeglobal_trees[TI_VOID_TYPE], tmp, DECL_SAVED_TREE (thunk_fndecl)((tree_check ((thunk_fndecl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3026, __FUNCTION__, (FUNCTION_DECL)))->function_decl.saved_tree
)
,
3027 DECL_INITIAL (thunk_fndecl)((contains_struct_check ((thunk_fndecl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3027, __FUNCTION__))->decl_common.initial)
);
3028
3029 /* Output the GENERIC tree. */
3030 dump_function (TDI_original, thunk_fndecl);
3031
3032 /* Store the end of the function, so that we get good line number
3033 info for the epilogue. */
3034 cfun(cfun + 0)->function_end_locus = input_location;
3035
3036 /* We're leaving the context of this function, so zap cfun.
3037 It's still in DECL_STRUCT_FUNCTION, and we'll restore it in
3038 tree_rest_of_compilation. */
3039 set_cfun (NULL__null);
3040
3041 current_function_decl = NULL_TREE(tree) __null;
3042
3043 cgraph_node::finalize_function (thunk_fndecl, true);
3044
3045 /* We share the symbols in the formal argument list with other entry
3046 points and the master function. Clear them so that they are
3047 recreated for each function. */
3048 for (formal = gfc_sym_get_dummy_args (thunk_sym); formal;
3049 formal = formal->next)
3050 if (formal->sym != NULL__null) /* Ignore alternate returns. */
3051 {
3052 formal->sym->backend_decl = NULL_TREE(tree) __null;
3053 if (formal->sym->ts.type == BT_CHARACTER)
3054 formal->sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
3055 }
3056
3057 if (thunk_sym->attr.function)
3058 {
3059 if (thunk_sym->ts.type == BT_CHARACTER)
3060 thunk_sym->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
3061 if (thunk_sym->result->ts.type == BT_CHARACTER)
3062 thunk_sym->result->ts.u.cl->backend_decl = NULL_TREE(tree) __null;
3063 }
3064 }
3065
3066 gfc_restore_backend_locus (&old_loc);
3067}
3068
3069
3070/* Create a decl for a function, and create any thunks for alternate entry
3071 points. If global is true, generate the function in the global binding
3072 level, otherwise in the current binding level (which can be global). */
3073
3074void
3075gfc_create_function_decl (gfc_namespace * ns, bool global)
3076{
3077 /* Create a declaration for the master function. */
3078 build_function_decl (ns->proc_name, global);
3079
3080 /* Compile the entry thunks. */
3081 if (ns->entries)
5
Assuming field 'entries' is non-null
6
Taking true branch
3082 build_entry_thunks (ns, global);
7
Calling 'build_entry_thunks'
3083
3084 /* Now create the read argument list. */
3085 create_function_arglist (ns->proc_name);
3086
3087 if (ns->omp_declare_simd)
3088 gfc_trans_omp_declare_simd (ns);
3089}
3090
3091/* Return the decl used to hold the function return value. If
3092 parent_flag is set, the context is the parent_scope. */
3093
3094tree
3095gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag)
3096{
3097 tree decl;
3098 tree length;
3099 tree this_fake_result_decl;
3100 tree this_function_decl;
3101
3102 char name[GFC_MAX_SYMBOL_LEN63 + 10];
3103
3104 if (parent_flag)
3105 {
3106 this_fake_result_decl = parent_fake_result_decl;
3107 this_function_decl = DECL_CONTEXT (current_function_decl)((contains_struct_check ((current_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3107, __FUNCTION__))->decl_minimal.context)
;
3108 }
3109 else
3110 {
3111 this_fake_result_decl = current_fake_result_decl;
3112 this_function_decl = current_function_decl;
3113 }
3114
3115 if (sym
3116 && sym->ns->proc_name->backend_decl == this_function_decl
3117 && sym->ns->proc_name->attr.entry_master
3118 && sym != sym->ns->proc_name)
3119 {
3120 tree t = NULL__null, var;
3121 if (this_fake_result_decl != NULL__null)
3122 for (t = TREE_CHAIN (this_fake_result_decl)((contains_struct_check ((this_fake_result_decl), (TS_COMMON)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3122, __FUNCTION__))->common.chain)
; t; t = TREE_CHAIN (t)((contains_struct_check ((t), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3122, __FUNCTION__))->common.chain)
)
3123 if (strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t))((const char *) (tree_check ((((tree_check ((t), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3123, __FUNCTION__, (TREE_LIST)))->list.purpose)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3123, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
, sym->name) == 0)
3124 break;
3125 if (t)
3126 return TREE_VALUE (t)((tree_check ((t), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3126, __FUNCTION__, (TREE_LIST)))->list.value)
;
3127 decl = gfc_get_fake_result_decl (sym->ns->proc_name, parent_flag);
3128
3129 if (parent_flag)
3130 this_fake_result_decl = parent_fake_result_decl;
3131 else
3132 this_fake_result_decl = current_fake_result_decl;
3133
3134 if (decl && sym->ns->proc_name->attr.mixed_entry_master)
3135 {
3136 tree field;
3137
3138 for (field = TYPE_FIELDS (TREE_TYPE (decl))((tree_check3 ((((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3138, __FUNCTION__))->typed.type)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3138, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
;
3139 field; field = DECL_CHAIN (field)(((contains_struct_check (((contains_struct_check ((field), (
TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3139, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3139, __FUNCTION__))->common.chain))
)
3140 if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field))((const char *) (tree_check ((((contains_struct_check ((field
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3140, __FUNCTION__))->decl_minimal.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3140, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
,
3141 sym->name) == 0)
3142 break;
3143
3144 gcc_assert (field != NULL_TREE)((void)(!(field != (tree) __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3144, __FUNCTION__), 0 : 0))
;
3145 decl = fold_build3_loc (input_location, COMPONENT_REF,
3146 TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3146, __FUNCTION__))->typed.type)
, decl, field, NULL_TREE(tree) __null);
3147 }
3148
3149 var = create_tmp_var_raw (TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3149, __FUNCTION__))->typed.type)
, sym->name);
3150 if (parent_flag)
3151 gfc_add_decl_to_parent_function (var);
3152 else
3153 gfc_add_decl_to_function (var);
3154
3155 SET_DECL_VALUE_EXPR (var, decl)(decl_value_expr_insert ((contains_struct_check ((var), (TS_DECL_WRTL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3155, __FUNCTION__)), decl))
;
3156 DECL_HAS_VALUE_EXPR_P (var)((tree_check3 ((var), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3156, __FUNCTION__, (VAR_DECL), (PARM_DECL), (RESULT_DECL))
) ->decl_common.decl_flag_2)
= 1;
3157 GFC_DECL_RESULT (var)((contains_struct_check ((var), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3157, __FUNCTION__))->decl_common.lang_flag_5)
= 1;
3158
3159 TREE_CHAIN (this_fake_result_decl)((contains_struct_check ((this_fake_result_decl), (TS_COMMON)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3159, __FUNCTION__))->common.chain)
3160 = tree_cons (get_identifier (sym->name)(__builtin_constant_p (sym->name) ? get_identifier_with_length
((sym->name), strlen (sym->name)) : get_identifier (sym
->name))
, var,
3161 TREE_CHAIN (this_fake_result_decl)((contains_struct_check ((this_fake_result_decl), (TS_COMMON)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3161, __FUNCTION__))->common.chain)
);
3162 return var;
3163 }
3164
3165 if (this_fake_result_decl != NULL_TREE(tree) __null)
3166 return TREE_VALUE (this_fake_result_decl)((tree_check ((this_fake_result_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3166, __FUNCTION__, (TREE_LIST)))->list.value)
;
3167
3168 /* Only when gfc_get_fake_result_decl is called by gfc_trans_return,
3169 sym is NULL. */
3170 if (!sym)
3171 return NULL_TREE(tree) __null;
3172
3173 if (sym->ts.type == BT_CHARACTER)
3174 {
3175 if (sym->ts.u.cl->backend_decl == NULL_TREE(tree) __null)
3176 length = gfc_create_string_length (sym);
3177 else
3178 length = sym->ts.u.cl->backend_decl;
3179 if (VAR_P (length)(((enum tree_code) (length)->base.code) == VAR_DECL) && DECL_CONTEXT (length)((contains_struct_check ((length), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3179, __FUNCTION__))->decl_minimal.context)
== NULL_TREE(tree) __null)
3180 gfc_add_decl_to_function (length);
3181 }
3182
3183 if (gfc_return_by_reference (sym))
3184 {
3185 decl = DECL_ARGUMENTS (this_function_decl)((tree_check ((this_function_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3185, __FUNCTION__, (FUNCTION_DECL)))->function_decl.arguments
)
;
3186
3187 if (sym->ns->proc_name->backend_decl == this_function_decl
3188 && sym->ns->proc_name->attr.entry_master)
3189 decl = DECL_CHAIN (decl)(((contains_struct_check (((contains_struct_check ((decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3189, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3189, __FUNCTION__))->common.chain))
;
3190
3191 TREE_USED (decl)((decl)->base.used_flag) = 1;
3192 if (sym->as)
3193 decl = gfc_build_dummy_array_decl (sym, decl);
3194 }
3195 else
3196 {
3197 sprintf (name, "__result_%.20s",
3198 IDENTIFIER_POINTER (DECL_NAME (this_function_decl))((const char *) (tree_check ((((contains_struct_check ((this_function_decl
), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3198, __FUNCTION__))->decl_minimal.name)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3198, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
);
3199
3200 if (!sym->attr.mixed_entry_master && sym->attr.function)
3201 decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl)((contains_struct_check ((this_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3201, __FUNCTION__))->decl_minimal.locus)
,
3202 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
,
3203 gfc_sym_type (sym));
3204 else
3205 decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl)((contains_struct_check ((this_function_decl), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3205, __FUNCTION__))->decl_minimal.locus)
,
3206 VAR_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
,
3207 TREE_TYPE (TREE_TYPE (this_function_decl))((contains_struct_check ((((contains_struct_check ((this_function_decl
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3207, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3207, __FUNCTION__))->typed.type)
);
3208 DECL_ARTIFICIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3208, __FUNCTION__))->decl_common.artificial_flag)
= 1;
3209 DECL_EXTERNAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3209, __FUNCTION__))->decl_common.decl_flag_1)
= 0;
3210 TREE_PUBLIC (decl)((decl)->base.public_flag) = 0;
3211 TREE_USED (decl)((decl)->base.used_flag) = 1;
3212 GFC_DECL_RESULT (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3212, __FUNCTION__))->decl_common.lang_flag_5)
= 1;
3213 TREE_ADDRESSABLE (decl)((decl)->base.addressable_flag) = 1;
3214
3215 layout_decl (decl, 0);
3216 gfc_finish_decl_attrs (decl, &sym->attr);
3217
3218 if (parent_flag)
3219 gfc_add_decl_to_parent_function (decl);
3220 else
3221 gfc_add_decl_to_function (decl);
3222 }
3223
3224 if (parent_flag)
3225 parent_fake_result_decl = build_tree_list (NULL__null, decl);
3226 else
3227 current_fake_result_decl = build_tree_list (NULL__null, decl);
3228
3229 if (sym->attr.assign)
3230 DECL_LANG_SPECIFIC (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3230, __FUNCTION__))->decl_common.lang_specific)
= DECL_LANG_SPECIFIC (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3230, __FUNCTION__))->decl_common.lang_specific)
;
3231
3232 return decl;
3233}
3234
3235
3236/* Builds a function decl. The remaining parameters are the types of the
3237 function arguments. Negative nargs indicates a varargs function. */
3238
3239static tree
3240build_library_function_decl_1 (tree name, const char *spec,
3241 tree rettype, int nargs, va_list p)
3242{
3243 vec<tree, va_gc> *arglist;
3244 tree fntype;
3245 tree fndecl;
3246 int n;
3247
3248 /* Library functions must be declared with global scope. */
3249 gcc_assert (current_function_decl == NULL_TREE)((void)(!(current_function_decl == (tree) __null) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3249, __FUNCTION__), 0 : 0))
;
3250
3251 /* Create a list of the argument types. */
3252 vec_alloc (arglist, abs (nargs));
3253 for (n = abs (nargs); n > 0; n--)
3254 {
3255 tree argtype = va_arg (p, tree)__builtin_va_arg(p, tree);
3256 arglist->quick_push (argtype);
3257 }
3258
3259 /* Build the function type and decl. */
3260 if (nargs >= 0)
3261 fntype = build_function_type_vec (rettype, arglist)build_function_type_array (rettype, vec_safe_length (arglist)
, vec_safe_address (arglist))
;
3262 else
3263 fntype = build_varargs_function_type_vec (rettype, arglist)build_varargs_function_type_array (rettype, vec_safe_length (
arglist), vec_safe_address (arglist))
;
3264 if (spec)
3265 {
3266 tree attr_args = build_tree_list (NULL_TREE(tree) __null,
3267 build_string (strlen (spec), spec));
3268 tree attrs = tree_cons (get_identifier ("fn spec")(__builtin_constant_p ("fn spec") ? get_identifier_with_length
(("fn spec"), strlen ("fn spec")) : get_identifier ("fn spec"
))
,
3269 attr_args, TYPE_ATTRIBUTES (fntype)((tree_class_check ((fntype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3269, __FUNCTION__))->type_common.attributes)
);
3270 fntype = build_type_attribute_variant (fntype, attrs);
3271 }
3272 fndecl = build_decl (input_location,
3273 FUNCTION_DECL, name, fntype);
3274
3275 /* Mark this decl as external. */
3276 DECL_EXTERNAL (fndecl)((contains_struct_check ((fndecl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3276, __FUNCTION__))->decl_common.decl_flag_1)
= 1;
3277 TREE_PUBLIC (fndecl)((fndecl)->base.public_flag) = 1;
3278
3279 pushdecl (fndecl);
3280
3281 rest_of_decl_compilation (fndecl, 1, 0);
3282
3283 return fndecl;
3284}
3285
3286/* Builds a function decl. The remaining parameters are the types of the
3287 function arguments. Negative nargs indicates a varargs function. */
3288
3289tree
3290gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
3291{
3292 tree ret;
3293 va_list args;
3294 va_start (args, nargs)__builtin_va_start(args, nargs);
3295 ret = build_library_function_decl_1 (name, NULL__null, rettype, nargs, args);
3296 va_end (args)__builtin_va_end(args);
3297 return ret;
3298}
3299
3300/* Builds a function decl. The remaining parameters are the types of the
3301 function arguments. Negative nargs indicates a varargs function.
3302 The SPEC parameter specifies the function argument and return type
3303 specification according to the fnspec function type attribute. */
3304
3305tree
3306gfc_build_library_function_decl_with_spec (tree name, const char *spec,
3307 tree rettype, int nargs, ...)
3308{
3309 tree ret;
3310 va_list args;
3311 va_start (args, nargs)__builtin_va_start(args, nargs);
3312 if (flag_checkingglobal_options.x_flag_checking)
3313 {
3314 attr_fnspec fnspec (spec, strlen (spec));
3315 fnspec.verify ();
3316 }
3317 ret = build_library_function_decl_1 (name, spec, rettype, nargs, args);
3318 va_end (args)__builtin_va_end(args);
3319 return ret;
3320}
3321
3322static void
3323gfc_build_intrinsic_function_decls (void)
3324{
3325 tree gfc_int4_type_node = gfc_get_int_type (4);
3326 tree gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node);
3327 tree gfc_int8_type_node = gfc_get_int_type (8);
3328 tree gfc_pint8_type_node = build_pointer_type (gfc_int8_type_node);
3329 tree gfc_int16_type_node = gfc_get_int_type (16);
3330 tree gfc_logical4_type_node = gfc_get_logical_type (4);
3331 tree pchar1_type_node = gfc_get_pchar_type (1);
3332 tree pchar4_type_node = gfc_get_pchar_type (4);
3333
3334 /* String functions. */
3335 gfor_fndecl_compare_string = gfc_build_library_function_decl_with_spec (
3336 get_identifier (PREFIX("compare_string"))(__builtin_constant_p ("_gfortran_" "compare_string") ? get_identifier_with_length
(("_gfortran_" "compare_string"), strlen ("_gfortran_" "compare_string"
)) : get_identifier ("_gfortran_" "compare_string"))
, ". . R . R ",
3337 integer_type_nodeinteger_types[itk_int], 4, gfc_charlen_type_node, pchar1_type_node,
3338 gfc_charlen_type_node, pchar1_type_node);
3339 DECL_PURE_P (gfor_fndecl_compare_string)((tree_check ((gfor_fndecl_compare_string), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3339, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3340 TREE_NOTHROW (gfor_fndecl_compare_string)((gfor_fndecl_compare_string)->base.nothrow_flag) = 1;
3341
3342 gfor_fndecl_concat_string = gfc_build_library_function_decl_with_spec (
3343 get_identifier (PREFIX("concat_string"))(__builtin_constant_p ("_gfortran_" "concat_string") ? get_identifier_with_length
(("_gfortran_" "concat_string"), strlen ("_gfortran_" "concat_string"
)) : get_identifier ("_gfortran_" "concat_string"))
, ". . W . R . R ",
3344 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, gfc_charlen_type_node, pchar1_type_node,
3345 gfc_charlen_type_node, pchar1_type_node,
3346 gfc_charlen_type_node, pchar1_type_node);
3347 TREE_NOTHROW (gfor_fndecl_concat_string)((gfor_fndecl_concat_string)->base.nothrow_flag) = 1;
3348
3349 gfor_fndecl_string_len_trim = gfc_build_library_function_decl_with_spec (
3350 get_identifier (PREFIX("string_len_trim"))(__builtin_constant_p ("_gfortran_" "string_len_trim") ? get_identifier_with_length
(("_gfortran_" "string_len_trim"), strlen ("_gfortran_" "string_len_trim"
)) : get_identifier ("_gfortran_" "string_len_trim"))
, ". . R ",
3351 gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar1_type_node);
3352 DECL_PURE_P (gfor_fndecl_string_len_trim)((tree_check ((gfor_fndecl_string_len_trim), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3352, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3353 TREE_NOTHROW (gfor_fndecl_string_len_trim)((gfor_fndecl_string_len_trim)->base.nothrow_flag) = 1;
3354
3355 gfor_fndecl_string_index = gfc_build_library_function_decl_with_spec (
3356 get_identifier (PREFIX("string_index"))(__builtin_constant_p ("_gfortran_" "string_index") ? get_identifier_with_length
(("_gfortran_" "string_index"), strlen ("_gfortran_" "string_index"
)) : get_identifier ("_gfortran_" "string_index"))
, ". . R . R . ",
3357 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
3358 gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
3359 DECL_PURE_P (gfor_fndecl_string_index)((tree_check ((gfor_fndecl_string_index), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3359, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3360 TREE_NOTHROW (gfor_fndecl_string_index)((gfor_fndecl_string_index)->base.nothrow_flag) = 1;
3361
3362 gfor_fndecl_string_scan = gfc_build_library_function_decl_with_spec (
3363 get_identifier (PREFIX("string_scan"))(__builtin_constant_p ("_gfortran_" "string_scan") ? get_identifier_with_length
(("_gfortran_" "string_scan"), strlen ("_gfortran_" "string_scan"
)) : get_identifier ("_gfortran_" "string_scan"))
, ". . R . R . ",
3364 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
3365 gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
3366 DECL_PURE_P (gfor_fndecl_string_scan)((tree_check ((gfor_fndecl_string_scan), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3366, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3367 TREE_NOTHROW (gfor_fndecl_string_scan)((gfor_fndecl_string_scan)->base.nothrow_flag) = 1;
3368
3369 gfor_fndecl_string_verify = gfc_build_library_function_decl_with_spec (
3370 get_identifier (PREFIX("string_verify"))(__builtin_constant_p ("_gfortran_" "string_verify") ? get_identifier_with_length
(("_gfortran_" "string_verify"), strlen ("_gfortran_" "string_verify"
)) : get_identifier ("_gfortran_" "string_verify"))
, ". . R . R . ",
3371 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
3372 gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
3373 DECL_PURE_P (gfor_fndecl_string_verify)((tree_check ((gfor_fndecl_string_verify), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3373, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3374 TREE_NOTHROW (gfor_fndecl_string_verify)((gfor_fndecl_string_verify)->base.nothrow_flag) = 1;
3375
3376 gfor_fndecl_string_trim = gfc_build_library_function_decl_with_spec (
3377 get_identifier (PREFIX("string_trim"))(__builtin_constant_p ("_gfortran_" "string_trim") ? get_identifier_with_length
(("_gfortran_" "string_trim"), strlen ("_gfortran_" "string_trim"
)) : get_identifier ("_gfortran_" "string_trim"))
, ". W w . R ",
3378 void_type_nodeglobal_trees[TI_VOID_TYPE], 4, build_pointer_type (gfc_charlen_type_node),
3379 build_pointer_type (pchar1_type_node), gfc_charlen_type_node,
3380 pchar1_type_node);
3381
3382 gfor_fndecl_string_minmax = gfc_build_library_function_decl_with_spec (
3383 get_identifier (PREFIX("string_minmax"))(__builtin_constant_p ("_gfortran_" "string_minmax") ? get_identifier_with_length
(("_gfortran_" "string_minmax"), strlen ("_gfortran_" "string_minmax"
)) : get_identifier ("_gfortran_" "string_minmax"))
, ". W w . R ",
3384 void_type_nodeglobal_trees[TI_VOID_TYPE], -4, build_pointer_type (gfc_charlen_type_node),
3385 build_pointer_type (pchar1_type_node), integer_type_nodeinteger_types[itk_int],
3386 integer_type_nodeinteger_types[itk_int]);
3387
3388 gfor_fndecl_adjustl = gfc_build_library_function_decl_with_spec (
3389 get_identifier (PREFIX("adjustl"))(__builtin_constant_p ("_gfortran_" "adjustl") ? get_identifier_with_length
(("_gfortran_" "adjustl"), strlen ("_gfortran_" "adjustl")) :
get_identifier ("_gfortran_" "adjustl"))
, ". W . R ",
3390 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar1_type_node, gfc_charlen_type_node,
3391 pchar1_type_node);
3392 TREE_NOTHROW (gfor_fndecl_adjustl)((gfor_fndecl_adjustl)->base.nothrow_flag) = 1;
3393
3394 gfor_fndecl_adjustr = gfc_build_library_function_decl_with_spec (
3395 get_identifier (PREFIX("adjustr"))(__builtin_constant_p ("_gfortran_" "adjustr") ? get_identifier_with_length
(("_gfortran_" "adjustr"), strlen ("_gfortran_" "adjustr")) :
get_identifier ("_gfortran_" "adjustr"))
, ". W . R ",
3396 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar1_type_node, gfc_charlen_type_node,
3397 pchar1_type_node);
3398 TREE_NOTHROW (gfor_fndecl_adjustr)((gfor_fndecl_adjustr)->base.nothrow_flag) = 1;
3399
3400 gfor_fndecl_select_string = gfc_build_library_function_decl_with_spec (
3401 get_identifier (PREFIX("select_string"))(__builtin_constant_p ("_gfortran_" "select_string") ? get_identifier_with_length
(("_gfortran_" "select_string"), strlen ("_gfortran_" "select_string"
)) : get_identifier ("_gfortran_" "select_string"))
, ". R . R . ",
3402 integer_type_nodeinteger_types[itk_int], 4, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3403 pchar1_type_node, gfc_charlen_type_node);
3404 DECL_PURE_P (gfor_fndecl_select_string)((tree_check ((gfor_fndecl_select_string), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3404, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3405 TREE_NOTHROW (gfor_fndecl_select_string)((gfor_fndecl_select_string)->base.nothrow_flag) = 1;
3406
3407 gfor_fndecl_compare_string_char4 = gfc_build_library_function_decl_with_spec (
3408 get_identifier (PREFIX("compare_string_char4"))(__builtin_constant_p ("_gfortran_" "compare_string_char4") ?
get_identifier_with_length (("_gfortran_" "compare_string_char4"
), strlen ("_gfortran_" "compare_string_char4")) : get_identifier
("_gfortran_" "compare_string_char4"))
, ". . R . R ",
3409 integer_type_nodeinteger_types[itk_int], 4, gfc_charlen_type_node, pchar4_type_node,
3410 gfc_charlen_type_node, pchar4_type_node);
3411 DECL_PURE_P (gfor_fndecl_compare_string_char4)((tree_check ((gfor_fndecl_compare_string_char4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3411, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3412 TREE_NOTHROW (gfor_fndecl_compare_string_char4)((gfor_fndecl_compare_string_char4)->base.nothrow_flag) = 1;
3413
3414 gfor_fndecl_concat_string_char4 = gfc_build_library_function_decl_with_spec (
3415 get_identifier (PREFIX("concat_string_char4"))(__builtin_constant_p ("_gfortran_" "concat_string_char4") ? get_identifier_with_length
(("_gfortran_" "concat_string_char4"), strlen ("_gfortran_" "concat_string_char4"
)) : get_identifier ("_gfortran_" "concat_string_char4"))
, ". . W . R . R ",
3416 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, gfc_charlen_type_node, pchar4_type_node,
3417 gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node,
3418 pchar4_type_node);
3419 TREE_NOTHROW (gfor_fndecl_concat_string_char4)((gfor_fndecl_concat_string_char4)->base.nothrow_flag) = 1;
3420
3421 gfor_fndecl_string_len_trim_char4 = gfc_build_library_function_decl_with_spec (
3422 get_identifier (PREFIX("string_len_trim_char4"))(__builtin_constant_p ("_gfortran_" "string_len_trim_char4") ?
get_identifier_with_length (("_gfortran_" "string_len_trim_char4"
), strlen ("_gfortran_" "string_len_trim_char4")) : get_identifier
("_gfortran_" "string_len_trim_char4"))
, ". . R ",
3423 gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar4_type_node);
3424 DECL_PURE_P (gfor_fndecl_string_len_trim_char4)((tree_check ((gfor_fndecl_string_len_trim_char4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3424, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3425 TREE_NOTHROW (gfor_fndecl_string_len_trim_char4)((gfor_fndecl_string_len_trim_char4)->base.nothrow_flag) = 1;
3426
3427 gfor_fndecl_string_index_char4 = gfc_build_library_function_decl_with_spec (
3428 get_identifier (PREFIX("string_index_char4"))(__builtin_constant_p ("_gfortran_" "string_index_char4") ? get_identifier_with_length
(("_gfortran_" "string_index_char4"), strlen ("_gfortran_" "string_index_char4"
)) : get_identifier ("_gfortran_" "string_index_char4"))
, ". . R . R . ",
3429 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
3430 gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
3431 DECL_PURE_P (gfor_fndecl_string_index_char4)((tree_check ((gfor_fndecl_string_index_char4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3431, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3432 TREE_NOTHROW (gfor_fndecl_string_index_char4)((gfor_fndecl_string_index_char4)->base.nothrow_flag) = 1;
3433
3434 gfor_fndecl_string_scan_char4 = gfc_build_library_function_decl_with_spec (
3435 get_identifier (PREFIX("string_scan_char4"))(__builtin_constant_p ("_gfortran_" "string_scan_char4") ? get_identifier_with_length
(("_gfortran_" "string_scan_char4"), strlen ("_gfortran_" "string_scan_char4"
)) : get_identifier ("_gfortran_" "string_scan_char4"))
, ". . R . R . ",
3436 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
3437 gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
3438 DECL_PURE_P (gfor_fndecl_string_scan_char4)((tree_check ((gfor_fndecl_string_scan_char4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3438, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3439 TREE_NOTHROW (gfor_fndecl_string_scan_char4)((gfor_fndecl_string_scan_char4)->base.nothrow_flag) = 1;
3440
3441 gfor_fndecl_string_verify_char4 = gfc_build_library_function_decl_with_spec (
3442 get_identifier (PREFIX("string_verify_char4"))(__builtin_constant_p ("_gfortran_" "string_verify_char4") ? get_identifier_with_length
(("_gfortran_" "string_verify_char4"), strlen ("_gfortran_" "string_verify_char4"
)) : get_identifier ("_gfortran_" "string_verify_char4"))
, ". . R . R . ",
3443 gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
3444 gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
3445 DECL_PURE_P (gfor_fndecl_string_verify_char4)((tree_check ((gfor_fndecl_string_verify_char4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3445, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3446 TREE_NOTHROW (gfor_fndecl_string_verify_char4)((gfor_fndecl_string_verify_char4)->base.nothrow_flag) = 1;
3447
3448 gfor_fndecl_string_trim_char4 = gfc_build_library_function_decl_with_spec (
3449 get_identifier (PREFIX("string_trim_char4"))(__builtin_constant_p ("_gfortran_" "string_trim_char4") ? get_identifier_with_length
(("_gfortran_" "string_trim_char4"), strlen ("_gfortran_" "string_trim_char4"
)) : get_identifier ("_gfortran_" "string_trim_char4"))
, ". W w . R ",
3450 void_type_nodeglobal_trees[TI_VOID_TYPE], 4, build_pointer_type (gfc_charlen_type_node),
3451 build_pointer_type (pchar4_type_node), gfc_charlen_type_node,
3452 pchar4_type_node);
3453
3454 gfor_fndecl_string_minmax_char4 = gfc_build_library_function_decl_with_spec (
3455 get_identifier (PREFIX("string_minmax_char4"))(__builtin_constant_p ("_gfortran_" "string_minmax_char4") ? get_identifier_with_length
(("_gfortran_" "string_minmax_char4"), strlen ("_gfortran_" "string_minmax_char4"
)) : get_identifier ("_gfortran_" "string_minmax_char4"))
, ". W w . R ",
3456 void_type_nodeglobal_trees[TI_VOID_TYPE], -4, build_pointer_type (gfc_charlen_type_node),
3457 build_pointer_type (pchar4_type_node), integer_type_nodeinteger_types[itk_int],
3458 integer_type_nodeinteger_types[itk_int]);
3459
3460 gfor_fndecl_adjustl_char4 = gfc_build_library_function_decl_with_spec (
3461 get_identifier (PREFIX("adjustl_char4"))(__builtin_constant_p ("_gfortran_" "adjustl_char4") ? get_identifier_with_length
(("_gfortran_" "adjustl_char4"), strlen ("_gfortran_" "adjustl_char4"
)) : get_identifier ("_gfortran_" "adjustl_char4"))
, ". W . R ",
3462 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar4_type_node, gfc_charlen_type_node,
3463 pchar4_type_node);
3464 TREE_NOTHROW (gfor_fndecl_adjustl_char4)((gfor_fndecl_adjustl_char4)->base.nothrow_flag) = 1;
3465
3466 gfor_fndecl_adjustr_char4 = gfc_build_library_function_decl_with_spec (
3467 get_identifier (PREFIX("adjustr_char4"))(__builtin_constant_p ("_gfortran_" "adjustr_char4") ? get_identifier_with_length
(("_gfortran_" "adjustr_char4"), strlen ("_gfortran_" "adjustr_char4"
)) : get_identifier ("_gfortran_" "adjustr_char4"))
, ". W . R ",
3468 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar4_type_node, gfc_charlen_type_node,
3469 pchar4_type_node);
3470 TREE_NOTHROW (gfor_fndecl_adjustr_char4)((gfor_fndecl_adjustr_char4)->base.nothrow_flag) = 1;
3471
3472 gfor_fndecl_select_string_char4 = gfc_build_library_function_decl_with_spec (
3473 get_identifier (PREFIX("select_string_char4"))(__builtin_constant_p ("_gfortran_" "select_string_char4") ? get_identifier_with_length
(("_gfortran_" "select_string_char4"), strlen ("_gfortran_" "select_string_char4"
)) : get_identifier ("_gfortran_" "select_string_char4"))
, ". R . R . ",
3474 integer_type_nodeinteger_types[itk_int], 4, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3475 pvoid_type_node, gfc_charlen_type_node);
3476 DECL_PURE_P (gfor_fndecl_select_string_char4)((tree_check ((gfor_fndecl_select_string_char4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3476, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3477 TREE_NOTHROW (gfor_fndecl_select_string_char4)((gfor_fndecl_select_string_char4)->base.nothrow_flag) = 1;
3478
3479
3480 /* Conversion between character kinds. */
3481
3482 gfor_fndecl_convert_char1_to_char4 = gfc_build_library_function_decl_with_spec (
3483 get_identifier (PREFIX("convert_char1_to_char4"))(__builtin_constant_p ("_gfortran_" "convert_char1_to_char4")
? get_identifier_with_length (("_gfortran_" "convert_char1_to_char4"
), strlen ("_gfortran_" "convert_char1_to_char4")) : get_identifier
("_gfortran_" "convert_char1_to_char4"))
, ". w . R ",
3484 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, build_pointer_type (pchar4_type_node),
3485 gfc_charlen_type_node, pchar1_type_node);
3486
3487 gfor_fndecl_convert_char4_to_char1 = gfc_build_library_function_decl_with_spec (
3488 get_identifier (PREFIX("convert_char4_to_char1"))(__builtin_constant_p ("_gfortran_" "convert_char4_to_char1")
? get_identifier_with_length (("_gfortran_" "convert_char4_to_char1"
), strlen ("_gfortran_" "convert_char4_to_char1")) : get_identifier
("_gfortran_" "convert_char4_to_char1"))
, ". w . R ",
3489 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, build_pointer_type (pchar1_type_node),
3490 gfc_charlen_type_node, pchar4_type_node);
3491
3492 /* Misc. functions. */
3493
3494 gfor_fndecl_ttynam = gfc_build_library_function_decl_with_spec (
3495 get_identifier (PREFIX("ttynam"))(__builtin_constant_p ("_gfortran_" "ttynam") ? get_identifier_with_length
(("_gfortran_" "ttynam"), strlen ("_gfortran_" "ttynam")) : get_identifier
("_gfortran_" "ttynam"))
, ". W . . ",
3496 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, gfc_charlen_type_node,
3497 integer_type_nodeinteger_types[itk_int]);
3498
3499 gfor_fndecl_fdate = gfc_build_library_function_decl_with_spec (
3500 get_identifier (PREFIX("fdate"))(__builtin_constant_p ("_gfortran_" "fdate") ? get_identifier_with_length
(("_gfortran_" "fdate"), strlen ("_gfortran_" "fdate")) : get_identifier
("_gfortran_" "fdate"))
, ". W . ",
3501 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, gfc_charlen_type_node);
3502
3503 gfor_fndecl_ctime = gfc_build_library_function_decl_with_spec (
3504 get_identifier (PREFIX("ctime"))(__builtin_constant_p ("_gfortran_" "ctime") ? get_identifier_with_length
(("_gfortran_" "ctime"), strlen ("_gfortran_" "ctime")) : get_identifier
("_gfortran_" "ctime"))
, ". W . . ",
3505 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, gfc_charlen_type_node,
3506 gfc_int8_type_node);
3507
3508 gfor_fndecl_random_init = gfc_build_library_function_decl (
3509 get_identifier (PREFIX("random_init"))(__builtin_constant_p ("_gfortran_" "random_init") ? get_identifier_with_length
(("_gfortran_" "random_init"), strlen ("_gfortran_" "random_init"
)) : get_identifier ("_gfortran_" "random_init"))
,
3510 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, gfc_logical4_type_node, gfc_logical4_type_node,
3511 gfc_int4_type_node);
3512
3513 gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec (
3514 get_identifier (PREFIX("selected_char_kind"))(__builtin_constant_p ("_gfortran_" "selected_char_kind") ? get_identifier_with_length
(("_gfortran_" "selected_char_kind"), strlen ("_gfortran_" "selected_char_kind"
)) : get_identifier ("_gfortran_" "selected_char_kind"))
, ". . R ",
3515 gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node);
3516 DECL_PURE_P (gfor_fndecl_sc_kind)((tree_check ((gfor_fndecl_sc_kind), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3516, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3517 TREE_NOTHROW (gfor_fndecl_sc_kind)((gfor_fndecl_sc_kind)->base.nothrow_flag) = 1;
3518
3519 gfor_fndecl_si_kind = gfc_build_library_function_decl_with_spec (
3520 get_identifier (PREFIX("selected_int_kind"))(__builtin_constant_p ("_gfortran_" "selected_int_kind") ? get_identifier_with_length
(("_gfortran_" "selected_int_kind"), strlen ("_gfortran_" "selected_int_kind"
)) : get_identifier ("_gfortran_" "selected_int_kind"))
, ". R ",
3521 gfc_int4_type_node, 1, pvoid_type_node);
3522 DECL_PURE_P (gfor_fndecl_si_kind)((tree_check ((gfor_fndecl_si_kind), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3522, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3523 TREE_NOTHROW (gfor_fndecl_si_kind)((gfor_fndecl_si_kind)->base.nothrow_flag) = 1;
3524
3525 gfor_fndecl_sr_kind = gfc_build_library_function_decl_with_spec (
3526 get_identifier (PREFIX("selected_real_kind2008"))(__builtin_constant_p ("_gfortran_" "selected_real_kind2008")
? get_identifier_with_length (("_gfortran_" "selected_real_kind2008"
), strlen ("_gfortran_" "selected_real_kind2008")) : get_identifier
("_gfortran_" "selected_real_kind2008"))
, ". R R ",
3527 gfc_int4_type_node, 3, pvoid_type_node, pvoid_type_node,
3528 pvoid_type_node);
3529 DECL_PURE_P (gfor_fndecl_sr_kind)((tree_check ((gfor_fndecl_sr_kind), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3529, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3530 TREE_NOTHROW (gfor_fndecl_sr_kind)((gfor_fndecl_sr_kind)->base.nothrow_flag) = 1;
3531
3532 gfor_fndecl_system_clock4 = gfc_build_library_function_decl (
3533 get_identifier (PREFIX("system_clock_4"))(__builtin_constant_p ("_gfortran_" "system_clock_4") ? get_identifier_with_length
(("_gfortran_" "system_clock_4"), strlen ("_gfortran_" "system_clock_4"
)) : get_identifier ("_gfortran_" "system_clock_4"))
,
3534 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, gfc_pint4_type_node, gfc_pint4_type_node,
3535 gfc_pint4_type_node);
3536
3537 gfor_fndecl_system_clock8 = gfc_build_library_function_decl (
3538 get_identifier (PREFIX("system_clock_8"))(__builtin_constant_p ("_gfortran_" "system_clock_8") ? get_identifier_with_length
(("_gfortran_" "system_clock_8"), strlen ("_gfortran_" "system_clock_8"
)) : get_identifier ("_gfortran_" "system_clock_8"))
,
3539 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, gfc_pint8_type_node, gfc_pint8_type_node,
3540 gfc_pint8_type_node);
3541
3542 /* Power functions. */
3543 {
3544 tree ctype, rtype, itype, jtype;
3545 int rkind, ikind, jkind;
3546#define NIKINDS 3
3547#define NRKINDS 4
3548 static int ikinds[NIKINDS] = {4, 8, 16};
3549 static int rkinds[NRKINDS] = {4, 8, 10, 16};
3550 char name[PREFIX_LEN10 + 12]; /* _gfortran_pow_?n_?n */
3551
3552 for (ikind=0; ikind < NIKINDS; ikind++)
3553 {
3554 itype = gfc_get_int_type (ikinds[ikind]);
3555
3556 for (jkind=0; jkind < NIKINDS; jkind++)
3557 {
3558 jtype = gfc_get_int_type (ikinds[jkind]);
3559 if (itype && jtype)
3560 {
3561 sprintf (name, PREFIX("pow_i%d_i%d")"_gfortran_" "pow_i%d_i%d", ikinds[ikind],
3562 ikinds[jkind]);
3563 gfor_fndecl_math_powi[jkind][ikind].integer =
3564 gfc_build_library_function_decl (get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
,
3565 jtype, 2, jtype, itype);
3566 TREE_READONLY (gfor_fndecl_math_powi[jkind][ikind].integer)((non_type_check ((gfor_fndecl_math_powi[jkind][ikind].integer
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3566, __FUNCTION__))->base.readonly_flag)
= 1;
3567 TREE_NOTHROW (gfor_fndecl_math_powi[jkind][ikind].integer)((gfor_fndecl_math_powi[jkind][ikind].integer)->base.nothrow_flag
)
= 1;
3568 }
3569 }
3570
3571 for (rkind = 0; rkind < NRKINDS; rkind ++)
3572 {
3573 rtype = gfc_get_real_type (rkinds[rkind]);
3574 if (rtype && itype)
3575 {
3576 sprintf (name, PREFIX("pow_r%d_i%d")"_gfortran_" "pow_r%d_i%d", rkinds[rkind],
3577 ikinds[ikind]);
3578 gfor_fndecl_math_powi[rkind][ikind].real =
3579 gfc_build_library_function_decl (get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
,
3580 rtype, 2, rtype, itype);
3581 TREE_READONLY (gfor_fndecl_math_powi[rkind][ikind].real)((non_type_check ((gfor_fndecl_math_powi[rkind][ikind].real),
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3581, __FUNCTION__))->base.readonly_flag)
= 1;
3582 TREE_NOTHROW (gfor_fndecl_math_powi[rkind][ikind].real)((gfor_fndecl_math_powi[rkind][ikind].real)->base.nothrow_flag
)
= 1;
3583 }
3584
3585 ctype = gfc_get_complex_type (rkinds[rkind]);
3586 if (ctype && itype)
3587 {
3588 sprintf (name, PREFIX("pow_c%d_i%d")"_gfortran_" "pow_c%d_i%d", rkinds[rkind],
3589 ikinds[ikind]);
3590 gfor_fndecl_math_powi[rkind][ikind].cmplx =
3591 gfc_build_library_function_decl (get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
,
3592 ctype, 2,ctype, itype);
3593 TREE_READONLY (gfor_fndecl_math_powi[rkind][ikind].cmplx)((non_type_check ((gfor_fndecl_math_powi[rkind][ikind].cmplx)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3593, __FUNCTION__))->base.readonly_flag)
= 1;
3594 TREE_NOTHROW (gfor_fndecl_math_powi[rkind][ikind].cmplx)((gfor_fndecl_math_powi[rkind][ikind].cmplx)->base.nothrow_flag
)
= 1;
3595 }
3596 }
3597 }
3598#undef NIKINDS
3599#undef NRKINDS
3600 }
3601
3602 gfor_fndecl_math_ishftc4 = gfc_build_library_function_decl (
3603 get_identifier (PREFIX("ishftc4"))(__builtin_constant_p ("_gfortran_" "ishftc4") ? get_identifier_with_length
(("_gfortran_" "ishftc4"), strlen ("_gfortran_" "ishftc4")) :
get_identifier ("_gfortran_" "ishftc4"))
,
3604 gfc_int4_type_node, 3, gfc_int4_type_node, gfc_int4_type_node,
3605 gfc_int4_type_node);
3606 TREE_READONLY (gfor_fndecl_math_ishftc4)((non_type_check ((gfor_fndecl_math_ishftc4), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3606, __FUNCTION__))->base.readonly_flag)
= 1;
3607 TREE_NOTHROW (gfor_fndecl_math_ishftc4)((gfor_fndecl_math_ishftc4)->base.nothrow_flag) = 1;
3608
3609 gfor_fndecl_math_ishftc8 = gfc_build_library_function_decl (
3610 get_identifier (PREFIX("ishftc8"))(__builtin_constant_p ("_gfortran_" "ishftc8") ? get_identifier_with_length
(("_gfortran_" "ishftc8"), strlen ("_gfortran_" "ishftc8")) :
get_identifier ("_gfortran_" "ishftc8"))
,
3611 gfc_int8_type_node, 3, gfc_int8_type_node, gfc_int4_type_node,
3612 gfc_int4_type_node);
3613 TREE_READONLY (gfor_fndecl_math_ishftc8)((non_type_check ((gfor_fndecl_math_ishftc8), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3613, __FUNCTION__))->base.readonly_flag)
= 1;
3614 TREE_NOTHROW (gfor_fndecl_math_ishftc8)((gfor_fndecl_math_ishftc8)->base.nothrow_flag) = 1;
3615
3616 if (gfc_int16_type_node)
3617 {
3618 gfor_fndecl_math_ishftc16 = gfc_build_library_function_decl (
3619 get_identifier (PREFIX("ishftc16"))(__builtin_constant_p ("_gfortran_" "ishftc16") ? get_identifier_with_length
(("_gfortran_" "ishftc16"), strlen ("_gfortran_" "ishftc16")
) : get_identifier ("_gfortran_" "ishftc16"))
,
3620 gfc_int16_type_node, 3, gfc_int16_type_node, gfc_int4_type_node,
3621 gfc_int4_type_node);
3622 TREE_READONLY (gfor_fndecl_math_ishftc16)((non_type_check ((gfor_fndecl_math_ishftc16), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3622, __FUNCTION__))->base.readonly_flag)
= 1;
3623 TREE_NOTHROW (gfor_fndecl_math_ishftc16)((gfor_fndecl_math_ishftc16)->base.nothrow_flag) = 1;
3624 }
3625
3626 /* BLAS functions. */
3627 {
3628 tree pint = build_pointer_type (integer_type_nodeinteger_types[itk_int]);
3629 tree ps = build_pointer_type (gfc_get_real_type (gfc_default_real_kind));
3630 tree pd = build_pointer_type (gfc_get_real_type (gfc_default_double_kind));
3631 tree pc = build_pointer_type (gfc_get_complex_type (gfc_default_real_kind));
3632 tree pz = build_pointer_type
3633 (gfc_get_complex_type (gfc_default_double_kind));
3634
3635 gfor_fndecl_sgemm = gfc_build_library_function_decl
3636 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "sgemm_"
: "sgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "sgemm_" : "sgemm"), strlen (global_options.x_flag_underscoring
? "sgemm_" : "sgemm")) : get_identifier (global_options.x_flag_underscoring
? "sgemm_" : "sgemm"))
3637 (flag_underscoring ? "sgemm_" : "sgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "sgemm_"
: "sgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "sgemm_" : "sgemm"), strlen (global_options.x_flag_underscoring
? "sgemm_" : "sgemm")) : get_identifier (global_options.x_flag_underscoring
? "sgemm_" : "sgemm"))
,
3638 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3639 pchar_type_node, pint, pint, pint, ps, ps, pint,
3640 ps, pint, ps, ps, pint, integer_type_nodeinteger_types[itk_int],
3641 integer_type_nodeinteger_types[itk_int]);
3642 gfor_fndecl_dgemm = gfc_build_library_function_decl
3643 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "dgemm_"
: "dgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "dgemm_" : "dgemm"), strlen (global_options.x_flag_underscoring
? "dgemm_" : "dgemm")) : get_identifier (global_options.x_flag_underscoring
? "dgemm_" : "dgemm"))
3644 (flag_underscoring ? "dgemm_" : "dgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "dgemm_"
: "dgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "dgemm_" : "dgemm"), strlen (global_options.x_flag_underscoring
? "dgemm_" : "dgemm")) : get_identifier (global_options.x_flag_underscoring
? "dgemm_" : "dgemm"))
,
3645 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3646 pchar_type_node, pint, pint, pint, pd, pd, pint,
3647 pd, pint, pd, pd, pint, integer_type_nodeinteger_types[itk_int],
3648 integer_type_nodeinteger_types[itk_int]);
3649 gfor_fndecl_cgemm = gfc_build_library_function_decl
3650 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "cgemm_"
: "cgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "cgemm_" : "cgemm"), strlen (global_options.x_flag_underscoring
? "cgemm_" : "cgemm")) : get_identifier (global_options.x_flag_underscoring
? "cgemm_" : "cgemm"))
3651 (flag_underscoring ? "cgemm_" : "cgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "cgemm_"
: "cgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "cgemm_" : "cgemm"), strlen (global_options.x_flag_underscoring
? "cgemm_" : "cgemm")) : get_identifier (global_options.x_flag_underscoring
? "cgemm_" : "cgemm"))
,
3652 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3653 pchar_type_node, pint, pint, pint, pc, pc, pint,
3654 pc, pint, pc, pc, pint, integer_type_nodeinteger_types[itk_int],
3655 integer_type_nodeinteger_types[itk_int]);
3656 gfor_fndecl_zgemm = gfc_build_library_function_decl
3657 (get_identifier(__builtin_constant_p (global_options.x_flag_underscoring ? "zgemm_"
: "zgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "zgemm_" : "zgemm"), strlen (global_options.x_flag_underscoring
? "zgemm_" : "zgemm")) : get_identifier (global_options.x_flag_underscoring
? "zgemm_" : "zgemm"))
3658 (flag_underscoring ? "zgemm_" : "zgemm")(__builtin_constant_p (global_options.x_flag_underscoring ? "zgemm_"
: "zgemm") ? get_identifier_with_length ((global_options.x_flag_underscoring
? "zgemm_" : "zgemm"), strlen (global_options.x_flag_underscoring
? "zgemm_" : "zgemm")) : get_identifier (global_options.x_flag_underscoring
? "zgemm_" : "zgemm"))
,
3659 void_type_nodeglobal_trees[TI_VOID_TYPE], 15, pchar_type_node,
3660 pchar_type_node, pint, pint, pint, pz, pz, pint,
3661 pz, pint, pz, pz, pint, integer_type_nodeinteger_types[itk_int],
3662 integer_type_nodeinteger_types[itk_int]);
3663 }
3664
3665 /* Other functions. */
3666 gfor_fndecl_size0 = gfc_build_library_function_decl_with_spec (
3667 get_identifier (PREFIX("size0"))(__builtin_constant_p ("_gfortran_" "size0") ? get_identifier_with_length
(("_gfortran_" "size0"), strlen ("_gfortran_" "size0")) : get_identifier
("_gfortran_" "size0"))
, ". R ",
3668 gfc_array_index_type, 1, pvoid_type_node);
3669 DECL_PURE_P (gfor_fndecl_size0)((tree_check ((gfor_fndecl_size0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3669, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3670 TREE_NOTHROW (gfor_fndecl_size0)((gfor_fndecl_size0)->base.nothrow_flag) = 1;
3671
3672 gfor_fndecl_size1 = gfc_build_library_function_decl_with_spec (
3673 get_identifier (PREFIX("size1"))(__builtin_constant_p ("_gfortran_" "size1") ? get_identifier_with_length
(("_gfortran_" "size1"), strlen ("_gfortran_" "size1")) : get_identifier
("_gfortran_" "size1"))
, ". R . ",
3674 gfc_array_index_type, 2, pvoid_type_node, gfc_array_index_type);
3675 DECL_PURE_P (gfor_fndecl_size1)((tree_check ((gfor_fndecl_size1), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3675, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3676 TREE_NOTHROW (gfor_fndecl_size1)((gfor_fndecl_size1)->base.nothrow_flag) = 1;
3677
3678 gfor_fndecl_iargc = gfc_build_library_function_decl (
3679 get_identifier (PREFIX ("iargc"))(__builtin_constant_p ("_gfortran_" "iargc") ? get_identifier_with_length
(("_gfortran_" "iargc"), strlen ("_gfortran_" "iargc")) : get_identifier
("_gfortran_" "iargc"))
, gfc_int4_type_node, 0);
3680 TREE_NOTHROW (gfor_fndecl_iargc)((gfor_fndecl_iargc)->base.nothrow_flag) = 1;
3681
3682 gfor_fndecl_kill_sub = gfc_build_library_function_decl (
3683 get_identifier (PREFIX ("kill_sub"))(__builtin_constant_p ("_gfortran_" "kill_sub") ? get_identifier_with_length
(("_gfortran_" "kill_sub"), strlen ("_gfortran_" "kill_sub")
) : get_identifier ("_gfortran_" "kill_sub"))
, void_type_nodeglobal_trees[TI_VOID_TYPE],
3684 3, gfc_int4_type_node, gfc_int4_type_node, gfc_pint4_type_node);
3685
3686 gfor_fndecl_kill = gfc_build_library_function_decl (
3687 get_identifier (PREFIX ("kill"))(__builtin_constant_p ("_gfortran_" "kill") ? get_identifier_with_length
(("_gfortran_" "kill"), strlen ("_gfortran_" "kill")) : get_identifier
("_gfortran_" "kill"))
, gfc_int4_type_node,
3688 2, gfc_int4_type_node, gfc_int4_type_node);
3689
3690 gfor_fndecl_is_contiguous0 = gfc_build_library_function_decl_with_spec (
3691 get_identifier (PREFIX("is_contiguous0"))(__builtin_constant_p ("_gfortran_" "is_contiguous0") ? get_identifier_with_length
(("_gfortran_" "is_contiguous0"), strlen ("_gfortran_" "is_contiguous0"
)) : get_identifier ("_gfortran_" "is_contiguous0"))
, ". R ",
3692 gfc_int4_type_node, 1, pvoid_type_node);
3693 DECL_PURE_P (gfor_fndecl_is_contiguous0)((tree_check ((gfor_fndecl_is_contiguous0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3693, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3694 TREE_NOTHROW (gfor_fndecl_is_contiguous0)((gfor_fndecl_is_contiguous0)->base.nothrow_flag) = 1;
3695}
3696
3697
3698/* Make prototypes for runtime library functions. */
3699
3700void
3701gfc_build_builtin_function_decls (void)
3702{
3703 tree gfc_int8_type_node = gfc_get_int_type (8);
3704
3705 gfor_fndecl_stop_numeric = gfc_build_library_function_decl (
3706 get_identifier (PREFIX("stop_numeric"))(__builtin_constant_p ("_gfortran_" "stop_numeric") ? get_identifier_with_length
(("_gfortran_" "stop_numeric"), strlen ("_gfortran_" "stop_numeric"
)) : get_identifier ("_gfortran_" "stop_numeric"))
,
3707 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3708 /* STOP doesn't return. */
3709 TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric)((gfor_fndecl_stop_numeric)->base.volatile_flag) = 1;
3710
3711 gfor_fndecl_stop_string = gfc_build_library_function_decl_with_spec (
3712 get_identifier (PREFIX("stop_string"))(__builtin_constant_p ("_gfortran_" "stop_string") ? get_identifier_with_length
(("_gfortran_" "stop_string"), strlen ("_gfortran_" "stop_string"
)) : get_identifier ("_gfortran_" "stop_string"))
, ". R . . ",
3713 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3714 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3715 /* STOP doesn't return. */
3716 TREE_THIS_VOLATILE (gfor_fndecl_stop_string)((gfor_fndecl_stop_string)->base.volatile_flag) = 1;
3717
3718 gfor_fndecl_error_stop_numeric = gfc_build_library_function_decl (
3719 get_identifier (PREFIX("error_stop_numeric"))(__builtin_constant_p ("_gfortran_" "error_stop_numeric") ? get_identifier_with_length
(("_gfortran_" "error_stop_numeric"), strlen ("_gfortran_" "error_stop_numeric"
)) : get_identifier ("_gfortran_" "error_stop_numeric"))
,
3720 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3721 /* ERROR STOP doesn't return. */
3722 TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric)((gfor_fndecl_error_stop_numeric)->base.volatile_flag) = 1;
3723
3724 gfor_fndecl_error_stop_string = gfc_build_library_function_decl_with_spec (
3725 get_identifier (PREFIX("error_stop_string"))(__builtin_constant_p ("_gfortran_" "error_stop_string") ? get_identifier_with_length
(("_gfortran_" "error_stop_string"), strlen ("_gfortran_" "error_stop_string"
)) : get_identifier ("_gfortran_" "error_stop_string"))
, ". R . . ",
3726 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3727 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3728 /* ERROR STOP doesn't return. */
3729 TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string)((gfor_fndecl_error_stop_string)->base.volatile_flag) = 1;
3730
3731 gfor_fndecl_pause_numeric = gfc_build_library_function_decl (
3732 get_identifier (PREFIX("pause_numeric"))(__builtin_constant_p ("_gfortran_" "pause_numeric") ? get_identifier_with_length
(("_gfortran_" "pause_numeric"), strlen ("_gfortran_" "pause_numeric"
)) : get_identifier ("_gfortran_" "pause_numeric"))
,
3733 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, gfc_int8_type_node);
3734
3735 gfor_fndecl_pause_string = gfc_build_library_function_decl_with_spec (
3736 get_identifier (PREFIX("pause_string"))(__builtin_constant_p ("_gfortran_" "pause_string") ? get_identifier_with_length
(("_gfortran_" "pause_string"), strlen ("_gfortran_" "pause_string"
)) : get_identifier ("_gfortran_" "pause_string"))
, ". R . ",
3737 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3738
3739 gfor_fndecl_runtime_error = gfc_build_library_function_decl_with_spec (
3740 get_identifier (PREFIX("runtime_error"))(__builtin_constant_p ("_gfortran_" "runtime_error") ? get_identifier_with_length
(("_gfortran_" "runtime_error"), strlen ("_gfortran_" "runtime_error"
)) : get_identifier ("_gfortran_" "runtime_error"))
, ". R ",
3741 void_type_nodeglobal_trees[TI_VOID_TYPE], -1, pchar_type_node);
3742 /* The runtime_error function does not return. */
3743 TREE_THIS_VOLATILE (gfor_fndecl_runtime_error)((gfor_fndecl_runtime_error)->base.volatile_flag) = 1;
3744
3745 gfor_fndecl_runtime_error_at = gfc_build_library_function_decl_with_spec (
3746 get_identifier (PREFIX("runtime_error_at"))(__builtin_constant_p ("_gfortran_" "runtime_error_at") ? get_identifier_with_length
(("_gfortran_" "runtime_error_at"), strlen ("_gfortran_" "runtime_error_at"
)) : get_identifier ("_gfortran_" "runtime_error_at"))
, ". R R ",
3747 void_type_nodeglobal_trees[TI_VOID_TYPE], -2, pchar_type_node, pchar_type_node);
3748 /* The runtime_error_at function does not return. */
3749 TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at)((gfor_fndecl_runtime_error_at)->base.volatile_flag) = 1;
3750
3751 gfor_fndecl_runtime_warning_at = gfc_build_library_function_decl_with_spec (
3752 get_identifier (PREFIX("runtime_warning_at"))(__builtin_constant_p ("_gfortran_" "runtime_warning_at") ? get_identifier_with_length
(("_gfortran_" "runtime_warning_at"), strlen ("_gfortran_" "runtime_warning_at"
)) : get_identifier ("_gfortran_" "runtime_warning_at"))
, ". R R ",
3753 void_type_nodeglobal_trees[TI_VOID_TYPE], -2, pchar_type_node, pchar_type_node);
3754
3755 gfor_fndecl_generate_error = gfc_build_library_function_decl_with_spec (
3756 get_identifier (PREFIX("generate_error"))(__builtin_constant_p ("_gfortran_" "generate_error") ? get_identifier_with_length
(("_gfortran_" "generate_error"), strlen ("_gfortran_" "generate_error"
)) : get_identifier ("_gfortran_" "generate_error"))
, ". R . R ",
3757 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3758 pchar_type_node);
3759
3760 gfor_fndecl_os_error_at = gfc_build_library_function_decl_with_spec (
3761 get_identifier (PREFIX("os_error_at"))(__builtin_constant_p ("_gfortran_" "os_error_at") ? get_identifier_with_length
(("_gfortran_" "os_error_at"), strlen ("_gfortran_" "os_error_at"
)) : get_identifier ("_gfortran_" "os_error_at"))
, ". R R ",
3762 void_type_nodeglobal_trees[TI_VOID_TYPE], -2, pchar_type_node, pchar_type_node);
3763 /* The os_error_at function does not return. */
3764 TREE_THIS_VOLATILE (gfor_fndecl_os_error_at)((gfor_fndecl_os_error_at)->base.volatile_flag) = 1;
3765
3766 gfor_fndecl_set_args = gfc_build_library_function_decl (
3767 get_identifier (PREFIX("set_args"))(__builtin_constant_p ("_gfortran_" "set_args") ? get_identifier_with_length
(("_gfortran_" "set_args"), strlen ("_gfortran_" "set_args")
) : get_identifier ("_gfortran_" "set_args"))
,
3768 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int],
3769 build_pointer_type (pchar_type_node));
3770
3771 gfor_fndecl_set_fpe = gfc_build_library_function_decl (
3772 get_identifier (PREFIX("set_fpe"))(__builtin_constant_p ("_gfortran_" "set_fpe") ? get_identifier_with_length
(("_gfortran_" "set_fpe"), strlen ("_gfortran_" "set_fpe")) :
get_identifier ("_gfortran_" "set_fpe"))
,
3773 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3774
3775 gfor_fndecl_ieee_procedure_entry = gfc_build_library_function_decl (
3776 get_identifier (PREFIX("ieee_procedure_entry"))(__builtin_constant_p ("_gfortran_" "ieee_procedure_entry") ?
get_identifier_with_length (("_gfortran_" "ieee_procedure_entry"
), strlen ("_gfortran_" "ieee_procedure_entry")) : get_identifier
("_gfortran_" "ieee_procedure_entry"))
,
3777 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, pvoid_type_node);
3778
3779 gfor_fndecl_ieee_procedure_exit = gfc_build_library_function_decl (
3780 get_identifier (PREFIX("ieee_procedure_exit"))(__builtin_constant_p ("_gfortran_" "ieee_procedure_exit") ? get_identifier_with_length
(("_gfortran_" "ieee_procedure_exit"), strlen ("_gfortran_" "ieee_procedure_exit"
)) : get_identifier ("_gfortran_" "ieee_procedure_exit"))
,
3781 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, pvoid_type_node);
3782
3783 /* Keep the array dimension in sync with the call, later in this file. */
3784 gfor_fndecl_set_options = gfc_build_library_function_decl_with_spec (
3785 get_identifier (PREFIX("set_options"))(__builtin_constant_p ("_gfortran_" "set_options") ? get_identifier_with_length
(("_gfortran_" "set_options"), strlen ("_gfortran_" "set_options"
)) : get_identifier ("_gfortran_" "set_options"))
, ". . R ",
3786 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, integer_type_nodeinteger_types[itk_int],
3787 build_pointer_type (integer_type_nodeinteger_types[itk_int]));
3788
3789 gfor_fndecl_set_convert = gfc_build_library_function_decl (
3790 get_identifier (PREFIX("set_convert"))(__builtin_constant_p ("_gfortran_" "set_convert") ? get_identifier_with_length
(("_gfortran_" "set_convert"), strlen ("_gfortran_" "set_convert"
)) : get_identifier ("_gfortran_" "set_convert"))
,
3791 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3792
3793 gfor_fndecl_set_record_marker = gfc_build_library_function_decl (
3794 get_identifier (PREFIX("set_record_marker"))(__builtin_constant_p ("_gfortran_" "set_record_marker") ? get_identifier_with_length
(("_gfortran_" "set_record_marker"), strlen ("_gfortran_" "set_record_marker"
)) : get_identifier ("_gfortran_" "set_record_marker"))
,
3795 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3796
3797 gfor_fndecl_set_max_subrecord_length = gfc_build_library_function_decl (
3798 get_identifier (PREFIX("set_max_subrecord_length"))(__builtin_constant_p ("_gfortran_" "set_max_subrecord_length"
) ? get_identifier_with_length (("_gfortran_" "set_max_subrecord_length"
), strlen ("_gfortran_" "set_max_subrecord_length")) : get_identifier
("_gfortran_" "set_max_subrecord_length"))
,
3799 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3800
3801 gfor_fndecl_in_pack = gfc_build_library_function_decl_with_spec (
3802 get_identifier (PREFIX("internal_pack"))(__builtin_constant_p ("_gfortran_" "internal_pack") ? get_identifier_with_length
(("_gfortran_" "internal_pack"), strlen ("_gfortran_" "internal_pack"
)) : get_identifier ("_gfortran_" "internal_pack"))
, ". r ",
3803 pvoid_type_node, 1, pvoid_type_node);
3804
3805 gfor_fndecl_in_unpack = gfc_build_library_function_decl_with_spec (
3806 get_identifier (PREFIX("internal_unpack"))(__builtin_constant_p ("_gfortran_" "internal_unpack") ? get_identifier_with_length
(("_gfortran_" "internal_unpack"), strlen ("_gfortran_" "internal_unpack"
)) : get_identifier ("_gfortran_" "internal_unpack"))
, ". w R ",
3807 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pvoid_type_node, pvoid_type_node);
3808
3809 /* These two builtins write into what the first argument points to and
3810 read from what the second argument points to, but we can't use R
3811 for that, because the directly pointed structure contains a pointer
3812 which is copied into the descriptor pointed by the first argument,
3813 effectively escaping that way. See PR92123. */
3814 gfor_fndecl_cfi_to_gfc = gfc_build_library_function_decl_with_spec (
3815 get_identifier (PREFIX("cfi_desc_to_gfc_desc"))(__builtin_constant_p ("_gfortran_" "cfi_desc_to_gfc_desc") ?
get_identifier_with_length (("_gfortran_" "cfi_desc_to_gfc_desc"
), strlen ("_gfortran_" "cfi_desc_to_gfc_desc")) : get_identifier
("_gfortran_" "cfi_desc_to_gfc_desc"))
, ". w . ",
3816 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pvoid_type_node, ppvoid_type_node);
3817
3818 gfor_fndecl_gfc_to_cfi = gfc_build_library_function_decl_with_spec (
3819 get_identifier (PREFIX("gfc_desc_to_cfi_desc"))(__builtin_constant_p ("_gfortran_" "gfc_desc_to_cfi_desc") ?
get_identifier_with_length (("_gfortran_" "gfc_desc_to_cfi_desc"
), strlen ("_gfortran_" "gfc_desc_to_cfi_desc")) : get_identifier
("_gfortran_" "gfc_desc_to_cfi_desc"))
, ". w . ",
3820 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, ppvoid_type_node, pvoid_type_node);
3821
3822 gfor_fndecl_associated = gfc_build_library_function_decl_with_spec (
3823 get_identifier (PREFIX("associated"))(__builtin_constant_p ("_gfortran_" "associated") ? get_identifier_with_length
(("_gfortran_" "associated"), strlen ("_gfortran_" "associated"
)) : get_identifier ("_gfortran_" "associated"))
, ". R R ",
3824 integer_type_nodeinteger_types[itk_int], 2, ppvoid_type_node, ppvoid_type_node);
3825 DECL_PURE_P (gfor_fndecl_associated)((tree_check ((gfor_fndecl_associated), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 3825, __FUNCTION__, (FUNCTION_DECL)))->function_decl.pure_flag
)
= 1;
3826 TREE_NOTHROW (gfor_fndecl_associated)((gfor_fndecl_associated)->base.nothrow_flag) = 1;
3827
3828 /* Coarray library calls. */
3829 if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
3830 {
3831 tree pint_type, pppchar_type;
3832
3833 pint_type = build_pointer_type (integer_type_nodeinteger_types[itk_int]);
3834 pppchar_type
3835 = build_pointer_type (build_pointer_type (pchar_type_node));
3836
3837 gfor_fndecl_caf_init = gfc_build_library_function_decl_with_spec (
3838 get_identifier (PREFIX("caf_init"))(__builtin_constant_p ("_gfortran_" "caf_init") ? get_identifier_with_length
(("_gfortran_" "caf_init"), strlen ("_gfortran_" "caf_init")
) : get_identifier ("_gfortran_" "caf_init"))
, ". W W ",
3839 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pint_type, pppchar_type);
3840
3841 gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
3842 get_identifier (PREFIX("caf_finalize"))(__builtin_constant_p ("_gfortran_" "caf_finalize") ? get_identifier_with_length
(("_gfortran_" "caf_finalize"), strlen ("_gfortran_" "caf_finalize"
)) : get_identifier ("_gfortran_" "caf_finalize"))
, void_type_nodeglobal_trees[TI_VOID_TYPE], 0);
3843
3844 gfor_fndecl_caf_this_image = gfc_build_library_function_decl (
3845 get_identifier (PREFIX("caf_this_image"))(__builtin_constant_p ("_gfortran_" "caf_this_image") ? get_identifier_with_length
(("_gfortran_" "caf_this_image"), strlen ("_gfortran_" "caf_this_image"
)) : get_identifier ("_gfortran_" "caf_this_image"))
, integer_type_nodeinteger_types[itk_int],
3846 1, integer_type_nodeinteger_types[itk_int]);
3847
3848 gfor_fndecl_caf_num_images = gfc_build_library_function_decl (
3849 get_identifier (PREFIX("caf_num_images"))(__builtin_constant_p ("_gfortran_" "caf_num_images") ? get_identifier_with_length
(("_gfortran_" "caf_num_images"), strlen ("_gfortran_" "caf_num_images"
)) : get_identifier ("_gfortran_" "caf_num_images"))
, integer_type_nodeinteger_types[itk_int],
3850 2, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3851
3852 gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
3853 get_identifier (PREFIX("caf_register"))(__builtin_constant_p ("_gfortran_" "caf_register") ? get_identifier_with_length
(("_gfortran_" "caf_register"), strlen ("_gfortran_" "caf_register"
)) : get_identifier ("_gfortran_" "caf_register"))
, ". . . W w w w . ",
3854 void_type_nodeglobal_trees[TI_VOID_TYPE], 7,
3855 size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int], ppvoid_type_node, pvoid_type_node,
3856 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3857
3858 gfor_fndecl_caf_deregister = gfc_build_library_function_decl_with_spec (
3859 get_identifier (PREFIX("caf_deregister"))(__builtin_constant_p ("_gfortran_" "caf_deregister") ? get_identifier_with_length
(("_gfortran_" "caf_deregister"), strlen ("_gfortran_" "caf_deregister"
)) : get_identifier ("_gfortran_" "caf_deregister"))
, ". W . w w . ",
3860 void_type_nodeglobal_trees[TI_VOID_TYPE], 5,
3861 ppvoid_type_node, integer_type_nodeinteger_types[itk_int], pint_type, pchar_type_node,
3862 size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3863
3864 gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
3865 get_identifier (PREFIX("caf_get"))(__builtin_constant_p ("_gfortran_" "caf_get") ? get_identifier_with_length
(("_gfortran_" "caf_get"), strlen ("_gfortran_" "caf_get")) :
get_identifier ("_gfortran_" "caf_get"))
, ". r . . r r w . . . w ",
3866 void_type_nodeglobal_trees[TI_VOID_TYPE], 10,
3867 pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3868 pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3869 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type);
3870
3871 gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
3872 get_identifier (PREFIX("caf_send"))(__builtin_constant_p ("_gfortran_" "caf_send") ? get_identifier_with_length
(("_gfortran_" "caf_send"), strlen ("_gfortran_" "caf_send")
) : get_identifier ("_gfortran_" "caf_send"))
, ". r . . w r r . . . w ",
3873 void_type_nodeglobal_trees[TI_VOID_TYPE], 11,
3874 pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3875 pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3876 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, pvoid_type_node);
3877
3878 gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
3879 get_identifier (PREFIX("caf_sendget"))(__builtin_constant_p ("_gfortran_" "caf_sendget") ? get_identifier_with_length
(("_gfortran_" "caf_sendget"), strlen ("_gfortran_" "caf_sendget"
)) : get_identifier ("_gfortran_" "caf_sendget"))
, ". r . . w r r . . r r . . . w ",
3880 void_type_nodeglobal_trees[TI_VOID_TYPE], 14, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3881 pvoid_type_node, pvoid_type_node, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3882 integer_type_nodeinteger_types[itk_int], pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3883 integer_type_nodeinteger_types[itk_int], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], integer_type_nodeinteger_types[itk_int]);
3884
3885 gfor_fndecl_caf_get_by_ref = gfc_build_library_function_decl_with_spec (
3886 get_identifier (PREFIX("caf_get_by_ref"))(__builtin_constant_p ("_gfortran_" "caf_get_by_ref") ? get_identifier_with_length
(("_gfortran_" "caf_get_by_ref"), strlen ("_gfortran_" "caf_get_by_ref"
)) : get_identifier ("_gfortran_" "caf_get_by_ref"))
, ". r . w r . . . . w . ",
3887 void_type_nodeglobal_trees[TI_VOID_TYPE],
3888 10, pvoid_type_node, integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3889 pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3890 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, integer_type_nodeinteger_types[itk_int]);
3891
3892 gfor_fndecl_caf_send_by_ref = gfc_build_library_function_decl_with_spec (
3893 get_identifier (PREFIX("caf_send_by_ref"))(__builtin_constant_p ("_gfortran_" "caf_send_by_ref") ? get_identifier_with_length
(("_gfortran_" "caf_send_by_ref"), strlen ("_gfortran_" "caf_send_by_ref"
)) : get_identifier ("_gfortran_" "caf_send_by_ref"))
, ". r . r r . . . . w . ",
3894 void_type_nodeglobal_trees[TI_VOID_TYPE], 10, pvoid_type_node, integer_type_nodeinteger_types[itk_int], pvoid_type_node,
3895 pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3896 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, integer_type_nodeinteger_types[itk_int]);
3897
3898 gfor_fndecl_caf_sendget_by_ref
3899 = gfc_build_library_function_decl_with_spec (
3900 get_identifier (PREFIX("caf_sendget_by_ref"))(__builtin_constant_p ("_gfortran_" "caf_sendget_by_ref") ? get_identifier_with_length
(("_gfortran_" "caf_sendget_by_ref"), strlen ("_gfortran_" "caf_sendget_by_ref"
)) : get_identifier ("_gfortran_" "caf_sendget_by_ref"))
,
3901 ". r . r r . r . . . w w . . ",
3902 void_type_nodeglobal_trees[TI_VOID_TYPE], 13, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3903 pvoid_type_node, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
3904 pvoid_type_node, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int],
3905 boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE], pint_type, pint_type, integer_type_nodeinteger_types[itk_int],
3906 integer_type_nodeinteger_types[itk_int]);
3907
3908 gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
3909 get_identifier (PREFIX("caf_sync_all"))(__builtin_constant_p ("_gfortran_" "caf_sync_all") ? get_identifier_with_length
(("_gfortran_" "caf_sync_all"), strlen ("_gfortran_" "caf_sync_all"
)) : get_identifier ("_gfortran_" "caf_sync_all"))
, ". w w . ", void_type_nodeglobal_trees[TI_VOID_TYPE],
3910 3, pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3911
3912 gfor_fndecl_caf_sync_memory = gfc_build_library_function_decl_with_spec (
3913 get_identifier (PREFIX("caf_sync_memory"))(__builtin_constant_p ("_gfortran_" "caf_sync_memory") ? get_identifier_with_length
(("_gfortran_" "caf_sync_memory"), strlen ("_gfortran_" "caf_sync_memory"
)) : get_identifier ("_gfortran_" "caf_sync_memory"))
, ". w w . ", void_type_nodeglobal_trees[TI_VOID_TYPE],
3914 3, pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3915
3916 gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
3917 get_identifier (PREFIX("caf_sync_images"))(__builtin_constant_p ("_gfortran_" "caf_sync_images") ? get_identifier_with_length
(("_gfortran_" "caf_sync_images"), strlen ("_gfortran_" "caf_sync_images"
)) : get_identifier ("_gfortran_" "caf_sync_images"))
, ". . r w w . ", void_type_nodeglobal_trees[TI_VOID_TYPE],
3918 5, integer_type_nodeinteger_types[itk_int], pint_type, pint_type,
3919 pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3920
3921 gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
3922 get_identifier (PREFIX("caf_error_stop"))(__builtin_constant_p ("_gfortran_" "caf_error_stop") ? get_identifier_with_length
(("_gfortran_" "caf_error_stop"), strlen ("_gfortran_" "caf_error_stop"
)) : get_identifier ("_gfortran_" "caf_error_stop"))
,
3923 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3924 /* CAF's ERROR STOP doesn't return. */
3925 TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop)((gfor_fndecl_caf_error_stop)->base.volatile_flag) = 1;
3926
3927 gfor_fndecl_caf_error_stop_str = gfc_build_library_function_decl_with_spec (
3928 get_identifier (PREFIX("caf_error_stop_str"))(__builtin_constant_p ("_gfortran_" "caf_error_stop_str") ? get_identifier_with_length
(("_gfortran_" "caf_error_stop_str"), strlen ("_gfortran_" "caf_error_stop_str"
)) : get_identifier ("_gfortran_" "caf_error_stop_str"))
, ". r . ",
3929 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3930 /* CAF's ERROR STOP doesn't return. */
3931 TREE_THIS_VOLATILE (gfor_fndecl_caf_error_stop_str)((gfor_fndecl_caf_error_stop_str)->base.volatile_flag) = 1;
3932
3933 gfor_fndecl_caf_stop_numeric = gfc_build_library_function_decl (
3934 get_identifier (PREFIX("caf_stop_numeric"))(__builtin_constant_p ("_gfortran_" "caf_stop_numeric") ? get_identifier_with_length
(("_gfortran_" "caf_stop_numeric"), strlen ("_gfortran_" "caf_stop_numeric"
)) : get_identifier ("_gfortran_" "caf_stop_numeric"))
,
3935 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
3936 /* CAF's STOP doesn't return. */
3937 TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_numeric)((gfor_fndecl_caf_stop_numeric)->base.volatile_flag) = 1;
3938
3939 gfor_fndecl_caf_stop_str = gfc_build_library_function_decl_with_spec (
3940 get_identifier (PREFIX("caf_stop_str"))(__builtin_constant_p ("_gfortran_" "caf_stop_str") ? get_identifier_with_length
(("_gfortran_" "caf_stop_str"), strlen ("_gfortran_" "caf_stop_str"
)) : get_identifier ("_gfortran_" "caf_stop_str"))
, ". r . ",
3941 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3942 /* CAF's STOP doesn't return. */
3943 TREE_THIS_VOLATILE (gfor_fndecl_caf_stop_str)((gfor_fndecl_caf_stop_str)->base.volatile_flag) = 1;
3944
3945 gfor_fndecl_caf_atomic_def = gfc_build_library_function_decl_with_spec (
3946 get_identifier (PREFIX("caf_atomic_define"))(__builtin_constant_p ("_gfortran_" "caf_atomic_define") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_define"), strlen ("_gfortran_" "caf_atomic_define"
)) : get_identifier ("_gfortran_" "caf_atomic_define"))
, ". r . . w w . . ",
3947 void_type_nodeglobal_trees[TI_VOID_TYPE], 7, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3948 pvoid_type_node, pint_type, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3949
3950 gfor_fndecl_caf_atomic_ref = gfc_build_library_function_decl_with_spec (
3951 get_identifier (PREFIX("caf_atomic_ref"))(__builtin_constant_p ("_gfortran_" "caf_atomic_ref") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_ref"), strlen ("_gfortran_" "caf_atomic_ref"
)) : get_identifier ("_gfortran_" "caf_atomic_ref"))
, ". r . . w w . . ",
3952 void_type_nodeglobal_trees[TI_VOID_TYPE], 7, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3953 pvoid_type_node, pint_type, integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3954
3955 gfor_fndecl_caf_atomic_cas = gfc_build_library_function_decl_with_spec (
3956 get_identifier (PREFIX("caf_atomic_cas"))(__builtin_constant_p ("_gfortran_" "caf_atomic_cas") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_cas"), strlen ("_gfortran_" "caf_atomic_cas"
)) : get_identifier ("_gfortran_" "caf_atomic_cas"))
, ". r . . w r r w . . ",
3957 void_type_nodeglobal_trees[TI_VOID_TYPE], 9, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3958 pvoid_type_node, pvoid_type_node, pvoid_type_node, pint_type,
3959 integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3960
3961 gfor_fndecl_caf_atomic_op = gfc_build_library_function_decl_with_spec (
3962 get_identifier (PREFIX("caf_atomic_op"))(__builtin_constant_p ("_gfortran_" "caf_atomic_op") ? get_identifier_with_length
(("_gfortran_" "caf_atomic_op"), strlen ("_gfortran_" "caf_atomic_op"
)) : get_identifier ("_gfortran_" "caf_atomic_op"))
, ". . r . . r w w . . ",
3963 void_type_nodeglobal_trees[TI_VOID_TYPE], 9, integer_type_nodeinteger_types[itk_int], pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE],
3964 integer_type_nodeinteger_types[itk_int], pvoid_type_node, pvoid_type_node, pint_type,
3965 integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int]);
3966
3967 gfor_fndecl_caf_lock = gfc_build_library_function_decl_with_spec (
3968 get_identifier (PREFIX("caf_lock"))(__builtin_constant_p ("_gfortran_" "caf_lock") ? get_identifier_with_length
(("_gfortran_" "caf_lock"), strlen ("_gfortran_" "caf_lock")
) : get_identifier ("_gfortran_" "caf_lock"))
, ". r . . w w w . ",
3969 void_type_nodeglobal_trees[TI_VOID_TYPE], 7, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3970 pint_type, pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3971
3972 gfor_fndecl_caf_unlock = gfc_build_library_function_decl_with_spec (
3973 get_identifier (PREFIX("caf_unlock"))(__builtin_constant_p ("_gfortran_" "caf_unlock") ? get_identifier_with_length
(("_gfortran_" "caf_unlock"), strlen ("_gfortran_" "caf_unlock"
)) : get_identifier ("_gfortran_" "caf_unlock"))
, ". r . . w w . ",
3974 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3975 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3976
3977 gfor_fndecl_caf_event_post = gfc_build_library_function_decl_with_spec (
3978 get_identifier (PREFIX("caf_event_post"))(__builtin_constant_p ("_gfortran_" "caf_event_post") ? get_identifier_with_length
(("_gfortran_" "caf_event_post"), strlen ("_gfortran_" "caf_event_post"
)) : get_identifier ("_gfortran_" "caf_event_post"))
, ". r . . w w . ",
3979 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3980 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3981
3982 gfor_fndecl_caf_event_wait = gfc_build_library_function_decl_with_spec (
3983 get_identifier (PREFIX("caf_event_wait"))(__builtin_constant_p ("_gfortran_" "caf_event_wait") ? get_identifier_with_length
(("_gfortran_" "caf_event_wait"), strlen ("_gfortran_" "caf_event_wait"
)) : get_identifier ("_gfortran_" "caf_event_wait"))
, ". r . . w w . ",
3984 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3985 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
3986
3987 gfor_fndecl_caf_event_query = gfc_build_library_function_decl_with_spec (
3988 get_identifier (PREFIX("caf_event_query"))(__builtin_constant_p ("_gfortran_" "caf_event_query") ? get_identifier_with_length
(("_gfortran_" "caf_event_query"), strlen ("_gfortran_" "caf_event_query"
)) : get_identifier ("_gfortran_" "caf_event_query"))
, ". r . . w w ",
3989 void_type_nodeglobal_trees[TI_VOID_TYPE], 5, pvoid_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE], integer_type_nodeinteger_types[itk_int],
3990 pint_type, pint_type);
3991
3992 gfor_fndecl_caf_fail_image = gfc_build_library_function_decl (
3993 get_identifier (PREFIX("caf_fail_image"))(__builtin_constant_p ("_gfortran_" "caf_fail_image") ? get_identifier_with_length
(("_gfortran_" "caf_fail_image"), strlen ("_gfortran_" "caf_fail_image"
)) : get_identifier ("_gfortran_" "caf_fail_image"))
, void_type_nodeglobal_trees[TI_VOID_TYPE], 0);
3994 /* CAF's FAIL doesn't return. */
3995 TREE_THIS_VOLATILE (gfor_fndecl_caf_fail_image)((gfor_fndecl_caf_fail_image)->base.volatile_flag) = 1;
3996
3997 gfor_fndecl_caf_failed_images
3998 = gfc_build_library_function_decl_with_spec (
3999 get_identifier (PREFIX("caf_failed_images"))(__builtin_constant_p ("_gfortran_" "caf_failed_images") ? get_identifier_with_length
(("_gfortran_" "caf_failed_images"), strlen ("_gfortran_" "caf_failed_images"
)) : get_identifier ("_gfortran_" "caf_failed_images"))
, ". w . r ",
4000 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pvoid_type_node, ppvoid_type_node,
4001 integer_type_nodeinteger_types[itk_int]);
4002
4003 gfor_fndecl_caf_form_team
4004 = gfc_build_library_function_decl_with_spec (
4005 get_identifier (PREFIX("caf_form_team"))(__builtin_constant_p ("_gfortran_" "caf_form_team") ? get_identifier_with_length
(("_gfortran_" "caf_form_team"), strlen ("_gfortran_" "caf_form_team"
)) : get_identifier ("_gfortran_" "caf_form_team"))
, ". . W . ",
4006 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, integer_type_nodeinteger_types[itk_int], ppvoid_type_node,
4007 integer_type_nodeinteger_types[itk_int]);
4008
4009 gfor_fndecl_caf_change_team
4010 = gfc_build_library_function_decl_with_spec (
4011 get_identifier (PREFIX("caf_change_team"))(__builtin_constant_p ("_gfortran_" "caf_change_team") ? get_identifier_with_length
(("_gfortran_" "caf_change_team"), strlen ("_gfortran_" "caf_change_team"
)) : get_identifier ("_gfortran_" "caf_change_team"))
, ". w . ",
4012 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, ppvoid_type_node,
4013 integer_type_nodeinteger_types[itk_int]);
4014
4015 gfor_fndecl_caf_end_team
4016 = gfc_build_library_function_decl (
4017 get_identifier (PREFIX("caf_end_team"))(__builtin_constant_p ("_gfortran_" "caf_end_team") ? get_identifier_with_length
(("_gfortran_" "caf_end_team"), strlen ("_gfortran_" "caf_end_team"
)) : get_identifier ("_gfortran_" "caf_end_team"))
, void_type_nodeglobal_trees[TI_VOID_TYPE], 0);
4018
4019 gfor_fndecl_caf_get_team
4020 = gfc_build_library_function_decl (
4021 get_identifier (PREFIX("caf_get_team"))(__builtin_constant_p ("_gfortran_" "caf_get_team") ? get_identifier_with_length
(("_gfortran_" "caf_get_team"), strlen ("_gfortran_" "caf_get_team"
)) : get_identifier ("_gfortran_" "caf_get_team"))
,
4022 void_type_nodeglobal_trees[TI_VOID_TYPE], 1, integer_type_nodeinteger_types[itk_int]);
4023
4024 gfor_fndecl_caf_sync_team
4025 = gfc_build_library_function_decl_with_spec (
4026 get_identifier (PREFIX("caf_sync_team"))(__builtin_constant_p ("_gfortran_" "caf_sync_team") ? get_identifier_with_length
(("_gfortran_" "caf_sync_team"), strlen ("_gfortran_" "caf_sync_team"
)) : get_identifier ("_gfortran_" "caf_sync_team"))
, ". r . ",
4027 void_type_nodeglobal_trees[TI_VOID_TYPE], 2, ppvoid_type_node,
4028 integer_type_nodeinteger_types[itk_int]);
4029
4030 gfor_fndecl_caf_team_number
4031 = gfc_build_library_function_decl_with_spec (
4032 get_identifier (PREFIX("caf_team_number"))(__builtin_constant_p ("_gfortran_" "caf_team_number") ? get_identifier_with_length
(("_gfortran_" "caf_team_number"), strlen ("_gfortran_" "caf_team_number"
)) : get_identifier ("_gfortran_" "caf_team_number"))
, ". r ",
4033 integer_type_nodeinteger_types[itk_int], 1, integer_type_nodeinteger_types[itk_int]);
4034
4035 gfor_fndecl_caf_image_status
4036 = gfc_build_library_function_decl_with_spec (
4037 get_identifier (PREFIX("caf_image_status"))(__builtin_constant_p ("_gfortran_" "caf_image_status") ? get_identifier_with_length
(("_gfortran_" "caf_image_status"), strlen ("_gfortran_" "caf_image_status"
)) : get_identifier ("_gfortran_" "caf_image_status"))
, ". . r ",
4038 integer_type_nodeinteger_types[itk_int], 2, integer_type_nodeinteger_types[itk_int], ppvoid_type_node);
4039
4040 gfor_fndecl_caf_stopped_images
4041 = gfc_build_library_function_decl_with_spec (
4042 get_identifier (PREFIX("caf_stopped_images"))(__builtin_constant_p ("_gfortran_" "caf_stopped_images") ? get_identifier_with_length
(("_gfortran_" "caf_stopped_images"), strlen ("_gfortran_" "caf_stopped_images"
)) : get_identifier ("_gfortran_" "caf_stopped_images"))
, ". w r r ",
4043 void_type_nodeglobal_trees[TI_VOID_TYPE], 3, pvoid_type_node, ppvoid_type_node,
4044 integer_type_nodeinteger_types[itk_int]);
4045
4046 gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
4047 get_identifier (PREFIX("caf_co_broadcast"))(__builtin_constant_p ("_gfortran_" "caf_co_broadcast") ? get_identifier_with_length
(("_gfortran_" "caf_co_broadcast"), strlen ("_gfortran_" "caf_co_broadcast"
)) : get_identifier ("_gfortran_" "caf_co_broadcast"))
, ". w . w w . ",
4048 void_type_nodeglobal_trees[TI_VOID_TYPE], 5, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4049 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4050
4051 gfor_fndecl_co_max = gfc_build_library_function_decl_with_spec (
4052 get_identifier (PREFIX("caf_co_max"))(__builtin_constant_p ("_gfortran_" "caf_co_max") ? get_identifier_with_length
(("_gfortran_" "caf_co_max"), strlen ("_gfortran_" "caf_co_max"
)) : get_identifier ("_gfortran_" "caf_co_max"))
, ". w . w w . . ",
4053 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4054 pint_type, pchar_type_node, integer_type_nodeinteger_types[itk_int], size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4055
4056 gfor_fndecl_co_min = gfc_build_library_function_decl_with_spec (
4057 get_identifier (PREFIX("caf_co_min"))(__builtin_constant_p ("_gfortran_" "caf_co_min") ? get_identifier_with_length
(("_gfortran_" "caf_co_min"), strlen ("_gfortran_" "caf_co_min"
)) : get_identifier ("_gfortran_" "caf_co_min"))
, ". w . w w . . ",
4058 void_type_nodeglobal_trees[TI_VOID_TYPE], 6, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4059 pint_type, pchar_type_node, integer_type_nodeinteger_types[itk_int], size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4060
4061 gfor_fndecl_co_reduce = gfc_build_library_function_decl_with_spec (
4062 get_identifier (PREFIX("caf_co_reduce"))(__builtin_constant_p ("_gfortran_" "caf_co_reduce") ? get_identifier_with_length
(("_gfortran_" "caf_co_reduce"), strlen ("_gfortran_" "caf_co_reduce"
)) : get_identifier ("_gfortran_" "caf_co_reduce"))
, ". w r . . w w . . ",
4063 void_type_nodeglobal_trees[TI_VOID_TYPE], 8, pvoid_type_node,
4064 build_pointer_type (build_varargs_function_type_list (void_type_nodeglobal_trees[TI_VOID_TYPE],
4065 NULL_TREE(tree) __null)),
4066 integer_type_nodeinteger_types[itk_int], integer_type_nodeinteger_types[itk_int], pint_type, pchar_type_node,
4067 integer_type_nodeinteger_types[itk_int], size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4068
4069 gfor_fndecl_co_sum = gfc_build_library_function_decl_with_spec (
4070 get_identifier (PREFIX("caf_co_sum"))(__builtin_constant_p ("_gfortran_" "caf_co_sum") ? get_identifier_with_length
(("_gfortran_" "caf_co_sum"), strlen ("_gfortran_" "caf_co_sum"
)) : get_identifier ("_gfortran_" "caf_co_sum"))
, ". w . w w . ",
4071 void_type_nodeglobal_trees[TI_VOID_TYPE], 5, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4072 pint_type, pchar_type_node, size_type_nodeglobal_trees[TI_SIZE_TYPE]);
4073
4074 gfor_fndecl_caf_is_present = gfc_build_library_function_decl_with_spec (
4075 get_identifier (PREFIX("caf_is_present"))(__builtin_constant_p ("_gfortran_" "caf_is_present") ? get_identifier_with_length
(("_gfortran_" "caf_is_present"), strlen ("_gfortran_" "caf_is_present"
)) : get_identifier ("_gfortran_" "caf_is_present"))
, ". r . r ",
4076 integer_type_nodeinteger_types[itk_int], 3, pvoid_type_node, integer_type_nodeinteger_types[itk_int],
4077 pvoid_type_node);
4078 }
4079
4080 gfc_build_intrinsic_function_decls ();
4081 gfc_build_intrinsic_lib_fndecls ();
4082 gfc_build_io_library_fndecls ();
4083}
4084
4085
4086/* Evaluate the length of dummy character variables. */
4087
4088static void
4089gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl,
4090 gfc_wrapped_block *block)
4091{
4092 stmtblock_t init;
4093
4094 gfc_finish_decl (cl->backend_decl);
4095
4096 gfc_start_block (&init);
4097
4098 /* Evaluate the string length expression. */
4099 gfc_conv_string_length (cl, NULL__null, &init);
4100
4101 gfc_trans_vla_type_sizes (sym, &init);
4102
4103 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4104}
4105
4106
4107/* Allocate and cleanup an automatic character variable. */
4108
4109static void
4110gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
4111{
4112 stmtblock_t init;
4113 tree decl;
4114 tree tmp;
4115
4116 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4116, __FUNCTION__), 0 : 0))
;
4117 gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length)((void)(!(sym->ts.u.cl && sym->ts.u.cl->length
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4117, __FUNCTION__), 0 : 0))
;
4118
4119 gfc_init_block (&init);
4120
4121 /* Evaluate the string length expression. */
4122 gfc_conv_string_length (sym->ts.u.cl, NULL__null, &init);
4123
4124 gfc_trans_vla_type_sizes (sym, &init);
4125
4126 decl = sym->backend_decl;
4127
4128 /* Emit a DECL_EXPR for this variable, which will cause the
4129 gimplifier to allocate storage, and all that good stuff. */
4130 tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl)((contains_struct_check ((decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4130, __FUNCTION__))->typed.type)
, decl);
4131 gfc_add_expr_to_block (&init, tmp);
4132
4133 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4134}
4135
4136/* Set the initial value of ASSIGN statement auxiliary variable explicitly. */
4137
4138static void
4139gfc_trans_assign_aux_var (gfc_symbol * sym, gfc_wrapped_block * block)
4140{
4141 stmtblock_t init;
4142
4143 gcc_assert (sym->backend_decl)((void)(!(sym->backend_decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4143, __FUNCTION__), 0 : 0))
;
4144 gfc_start_block (&init);
4145
4146 /* Set the initial value to length. See the comments in
4147 function gfc_add_assign_aux_vars in this file. */
4148 gfc_add_modify (&init, GFC_DECL_STRING_LEN (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4148, __FUNCTION__))->decl_common.lang_specific)->stringlen
,
4149 build_int_cst (gfc_charlen_type_node, -2));
4150
4151 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4152}
4153
4154static void
4155gfc_trans_vla_one_sizepos (tree *tp, stmtblock_t *body)
4156{
4157 tree t = *tp, var, val;
4158
4159 if (t == NULL__null || t == error_mark_nodeglobal_trees[TI_ERROR_MARK])
4160 return;
4161 if (TREE_CONSTANT (t)((non_type_check ((t), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4161, __FUNCTION__))->base.constant_flag)
|| DECL_P (t)(tree_code_type[(int) (((enum tree_code) (t)->base.code))]
== tcc_declaration)
)
4162 return;
4163
4164 if (TREE_CODE (t)((enum tree_code) (t)->base.code) == SAVE_EXPR)
4165 {
4166 if (SAVE_EXPR_RESOLVED_P (t)((tree_check ((t), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4166, __FUNCTION__, (SAVE_EXPR)))->base.public_flag)
)
4167 {
4168 *tp = TREE_OPERAND (t, 0)(*((const_cast<tree*> (tree_operand_check ((t), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4168, __FUNCTION__)))))
;
4169 return;
4170 }
4171 val = TREE_OPERAND (t, 0)(*((const_cast<tree*> (tree_operand_check ((t), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4171, __FUNCTION__)))))
;
4172 }
4173 else
4174 val = t;
4175
4176 var = gfc_create_var_np (TREE_TYPE (t)((contains_struct_check ((t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4176, __FUNCTION__))->typed.type)
, NULL__null);
4177 gfc_add_decl_to_function (var);
4178 gfc_add_modify (body, var, unshare_expr (val));
4179 if (TREE_CODE (t)((enum tree_code) (t)->base.code) == SAVE_EXPR)
4180 TREE_OPERAND (t, 0)(*((const_cast<tree*> (tree_operand_check ((t), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4180, __FUNCTION__)))))
= var;
4181 *tp = var;
4182}
4183
4184static void
4185gfc_trans_vla_type_sizes_1 (tree type, stmtblock_t *body)
4186{
4187 tree t;
4188
4189 if (type == NULL__null || type == error_mark_nodeglobal_trees[TI_ERROR_MARK])
4190 return;
4191
4192 type = TYPE_MAIN_VARIANT (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4192, __FUNCTION__))->type_common.main_variant)
;
4193
4194 if (TREE_CODE (type)((enum tree_code) (type)->base.code) == INTEGER_TYPE)
4195 {
4196 gfc_trans_vla_one_sizepos (&TYPE_MIN_VALUE (type)((tree_check5 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4196, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval
)
, body);
4197 gfc_trans_vla_one_sizepos (&TYPE_MAX_VALUE (type)((tree_check5 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4197, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
, body);
4198
4199 for (t = TYPE_NEXT_VARIANT (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4199, __FUNCTION__))->type_common.next_variant)
; t; t = TYPE_NEXT_VARIANT (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4199, __FUNCTION__))->type_common.next_variant)
)
4200 {
4201 TYPE_MIN_VALUE (t)((tree_check5 ((t), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4201, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval
)
= TYPE_MIN_VALUE (type)((tree_check5 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4201, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.minval
)
;
4202 TYPE_MAX_VALUE (t)((tree_check5 ((t), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4202, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
= TYPE_MAX_VALUE (type)((tree_check5 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4202, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
;
4203 }
4204 }
4205 else if (TREE_CODE (type)((enum tree_code) (type)->base.code) == ARRAY_TYPE)
4206 {
4207 gfc_trans_vla_type_sizes_1 (TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4207, __FUNCTION__))->typed.type)
, body);
4208 gfc_trans_vla_type_sizes_1 (TYPE_DOMAIN (type)((tree_check ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4208, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
)
, body);
4209 gfc_trans_vla_one_sizepos (&TYPE_SIZE (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4209, __FUNCTION__))->type_common.size)
, body);
4210 gfc_trans_vla_one_sizepos (&TYPE_SIZE_UNIT (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4210, __FUNCTION__))->type_common.size_unit)
, body);
4211
4212 for (t = TYPE_NEXT_VARIANT (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4212, __FUNCTION__))->type_common.next_variant)
; t; t = TYPE_NEXT_VARIANT (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4212, __FUNCTION__))->type_common.next_variant)
)
4213 {
4214 TYPE_SIZE (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4214, __FUNCTION__))->type_common.size)
= TYPE_SIZE (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4214, __FUNCTION__))->type_common.size)
;
4215 TYPE_SIZE_UNIT (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4215, __FUNCTION__))->type_common.size_unit)
= TYPE_SIZE_UNIT (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4215, __FUNCTION__))->type_common.size_unit)
;
4216 }
4217 }
4218}
4219
4220/* Make sure all type sizes and array domains are either constant,
4221 or variable or parameter decls. This is a simplified variant
4222 of gimplify_type_sizes, but we can't use it here, as none of the
4223 variables in the expressions have been gimplified yet.
4224 As type sizes and domains for various variable length arrays
4225 contain VAR_DECLs that are only initialized at gfc_trans_deferred_vars
4226 time, without this routine gimplify_type_sizes in the middle-end
4227 could result in the type sizes being gimplified earlier than where
4228 those variables are initialized. */
4229
4230void
4231gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
4232{
4233 tree type = TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4233, __FUNCTION__))->typed.type)
;
4234
4235 if (TREE_CODE (type)((enum tree_code) (type)->base.code) == FUNCTION_TYPE
4236 && (sym->attr.function || sym->attr.result || sym->attr.entry))
4237 {
4238 if (! current_fake_result_decl)
4239 return;
4240
4241 type = TREE_TYPE (TREE_VALUE (current_fake_result_decl))((contains_struct_check ((((tree_check ((current_fake_result_decl
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4241, __FUNCTION__, (TREE_LIST)))->list.value)), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4241, __FUNCTION__))->typed.type)
;
4242 }
4243
4244 while (POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE)
)
4245 type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4245, __FUNCTION__))->typed.type)
;
4246
4247 if (GFC_DESCRIPTOR_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4247, __FUNCTION__))->type_common.lang_flag_1)
)
4248 {
4249 tree etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4249, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
;
4250
4251 while (POINTER_TYPE_P (etype)(((enum tree_code) (etype)->base.code) == POINTER_TYPE || (
(enum tree_code) (etype)->base.code) == REFERENCE_TYPE)
)
4252 etype = TREE_TYPE (etype)((contains_struct_check ((etype), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4252, __FUNCTION__))->typed.type)
;
4253
4254 gfc_trans_vla_type_sizes_1 (etype, body);
4255 }
4256
4257 gfc_trans_vla_type_sizes_1 (type, body);
4258}
4259
4260
4261/* Initialize a derived type by building an lvalue from the symbol
4262 and using trans_assignment to do the work. Set dealloc to false
4263 if no deallocation prior the assignment is needed. */
4264void
4265gfc_init_default_dt (gfc_symbol * sym, stmtblock_t * block, bool dealloc)
4266{
4267 gfc_expr *e;
4268 tree tmp;
4269 tree present;
4270
4271 gcc_assert (block)((void)(!(block) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4271, __FUNCTION__), 0 : 0))
;
4272
4273 /* Initialization of PDTs is done elsewhere. */
4274 if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_type)
4275 return;
4276
4277 gcc_assert (!sym->attr.allocatable)((void)(!(!sym->attr.allocatable) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4277, __FUNCTION__), 0 : 0))
;
4278 gfc_set_sym_referenced (sym);
4279 e = gfc_lval_expr_from_sym (sym);
4280 tmp = gfc_trans_assignment (e, sym->value, false, dealloc);
4281 if (sym->attr.dummy && (sym->attr.optional
4282 || sym->ns->proc_name->attr.entry_master))
4283 {
4284 present = gfc_conv_expr_present (sym);
4285 tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4285, __FUNCTION__))->typed.type)
, present,
4286 tmp, build_empty_stmt (input_location));
4287 }
4288 gfc_add_expr_to_block (block, tmp);
4289 gfc_free_expr (e);
4290}
4291
4292
4293/* Initialize INTENT(OUT) derived type dummies. As well as giving
4294 them their default initializer, if they do not have allocatable
4295 components, they have their allocatable components deallocated. */
4296
4297static void
4298init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
4299{
4300 stmtblock_t init;
4301 gfc_formal_arglist *f;
4302 tree tmp;
4303 tree present;
4304
4305 gfc_init_block (&init);
4306 for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
4307 if (f->sym && f->sym->attr.intent == INTENT_OUT
4308 && !f->sym->attr.pointer
4309 && f->sym->ts.type == BT_DERIVED)
4310 {
4311 tmp = NULL_TREE(tree) __null;
4312
4313 /* Note: Allocatables are excluded as they are already handled
4314 by the caller. */
4315 if (!f->sym->attr.allocatable
4316 && gfc_is_finalizable (f->sym->ts.u.derived, NULL__null))
4317 {
4318 stmtblock_t block;
4319 gfc_expr *e;
4320
4321 gfc_init_block (&block);
4322 f->sym->attr.referenced = 1;
4323 e = gfc_lval_expr_from_sym (f->sym);
4324 gfc_add_finalizer_call (&block, e);
4325 gfc_free_expr (e);
4326 tmp = gfc_finish_block (&block);
4327 }
4328
4329 if (tmp == NULL_TREE(tree) __null && !f->sym->attr.allocatable
4330 && f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value)
4331 tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived,
4332 f->sym->backend_decl,
4333 f->sym->as ? f->sym->as->rank : 0);
4334
4335 if (tmp != NULL_TREE(tree) __null && (f->sym->attr.optional
4336 || f->sym->ns->proc_name->attr.entry_master))
4337 {
4338 present = gfc_conv_expr_present (f->sym);
4339 tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4339, __FUNCTION__))->typed.type)
,
4340 present, tmp, build_empty_stmt (input_location));
4341 }
4342
4343 if (tmp != NULL_TREE(tree) __null)
4344 gfc_add_expr_to_block (&init, tmp);
4345 else if (f->sym->value && !f->sym->attr.allocatable)
4346 gfc_init_default_dt (f->sym, &init, true);
4347 }
4348 else if (f->sym && f->sym->attr.intent == INTENT_OUT
4349 && f->sym->ts.type == BT_CLASS
4350 && !CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.class_pointer
4351 && !CLASS_DATA (f->sym)f->sym->ts.u.derived->components->attr.allocatable)
4352 {
4353 stmtblock_t block;
4354 gfc_expr *e;
4355
4356 gfc_init_block (&block);
4357 f->sym->attr.referenced = 1;
4358 e = gfc_lval_expr_from_sym (f->sym);
4359 gfc_add_finalizer_call (&block, e);
4360 gfc_free_expr (e);
4361 tmp = gfc_finish_block (&block);
4362
4363 if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master)
4364 {
4365 present = gfc_conv_expr_present (f->sym);
4366 tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4366, __FUNCTION__))->typed.type)
,
4367 present, tmp,
4368 build_empty_stmt (input_location));
4369 }
4370
4371 gfc_add_expr_to_block (&init, tmp);
4372 }
4373
4374 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4375}
4376
4377
4378/* Helper function to manage deferred string lengths. */
4379
4380static tree
4381gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init,
4382 locus *loc)
4383{
4384 tree tmp;
4385
4386 /* Character length passed by reference. */
4387 tmp = sym->ts.u.cl->passed_length;
4388 tmp = build_fold_indirect_ref_loc (input_location, tmp);
4389 tmp = fold_convert (gfc_charlen_type_node, tmp)fold_convert_loc (((location_t) 0), gfc_charlen_type_node, tmp
)
;
4390
4391 if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
4392 /* Zero the string length when entering the scope. */
4393 gfc_add_modify (init, sym->ts.u.cl->backend_decl,
4394 build_int_cst (gfc_charlen_type_node, 0));
4395 else
4396 {
4397 tree tmp2;
4398
4399 tmp2 = fold_build2_loc (input_location, MODIFY_EXPR,
4400 gfc_charlen_type_node,
4401 sym->ts.u.cl->backend_decl, tmp);
4402 if (sym->attr.optional)
4403 {
4404 tree present = gfc_conv_expr_present (sym);
4405 tmp2 = build3_loc (input_location, COND_EXPR,
4406 void_type_nodeglobal_trees[TI_VOID_TYPE], present, tmp2,
4407 build_empty_stmt (input_location));
4408 }
4409 gfc_add_expr_to_block (init, tmp2);
4410 }
4411
4412 gfc_restore_backend_locus (loc);
4413
4414 /* Pass the final character length back. */
4415 if (sym->attr.intent != INTENT_IN)
4416 {
4417 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
4418 gfc_charlen_type_node, tmp,
4419 sym->ts.u.cl->backend_decl);
4420 if (sym->attr.optional)
4421 {
4422 tree present = gfc_conv_expr_present (sym);
4423 tmp = build3_loc (input_location, COND_EXPR,
4424 void_type_nodeglobal_trees[TI_VOID_TYPE], present, tmp,
4425 build_empty_stmt (input_location));
4426 }
4427 }
4428 else
4429 tmp = NULL_TREE(tree) __null;
4430
4431 return tmp;
4432}
4433
4434
4435/* Convert CFI descriptor dummies into gfc types and back again. */
4436static void
4437convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
4438{
4439 tree gfc_desc;
4440 tree gfc_desc_ptr;
4441 tree CFI_desc;
4442 tree CFI_desc_ptr;
4443 tree dummy_ptr;
4444 tree tmp;
4445 tree present;
4446 tree incoming;
4447 tree outgoing;
4448 stmtblock_t outer_block;
4449 stmtblock_t tmpblock;
4450
4451 /* dummy_ptr will be the pointer to the passed array descriptor,
4452 while CFI_desc is the descriptor itself. */
4453 if (DECL_LANG_SPECIFIC (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4453, __FUNCTION__))->decl_common.lang_specific)
)
4454 CFI_desc = GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl)(((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4454, __FUNCTION__))->decl_common.lang_specific)->saved_descriptor
)
;
4455 else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (sym->backend_decl)))((tree_class_check ((((contains_struct_check ((((contains_struct_check
((sym->backend_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4455, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4455, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4455, __FUNCTION__))->type_common.lang_flag_1)
)
4456 CFI_desc = sym->backend_decl;
4457 else
4458 CFI_desc = NULL__null;
4459
4460 dummy_ptr = CFI_desc;
4461
4462 if (CFI_desc)
4463 {
4464 CFI_desc = build_fold_indirect_ref_loc (input_location, CFI_desc);
4465
4466 /* The compiler will have given CFI_desc the correct gfortran
4467 type. Use this new variable to store the converted
4468 descriptor. */
4469 gfc_desc = gfc_create_var (TREE_TYPE (CFI_desc)((contains_struct_check ((CFI_desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4469, __FUNCTION__))->typed.type)
, "gfc_desc");
4470 tmp = build_pointer_type (TREE_TYPE (gfc_desc)((contains_struct_check ((gfc_desc), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4470, __FUNCTION__))->typed.type)
);
4471 gfc_desc_ptr = gfc_create_var (tmp, "gfc_desc_ptr");
4472 CFI_desc_ptr = gfc_create_var (pvoid_type_node, "CFI_desc_ptr");
4473
4474 /* Fix the condition for the presence of the argument. */
4475 gfc_init_block (&outer_block);
4476 present = fold_build2_loc (input_location, NE_EXPR,
4477 logical_type_node, dummy_ptr,
4478 build_int_cst (TREE_TYPE (dummy_ptr)((contains_struct_check ((dummy_ptr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4478, __FUNCTION__))->typed.type)
, 0));
4479
4480 gfc_init_block (&tmpblock);
4481 /* Pointer to the gfc descriptor. */
4482 gfc_add_modify (&tmpblock, gfc_desc_ptr,
4483 gfc_build_addr_expr (NULL__null, gfc_desc));
4484 /* Store the pointer to the CFI descriptor. */
4485 gfc_add_modify (&tmpblock, CFI_desc_ptr,
4486 fold_convert (pvoid_type_node, dummy_ptr)fold_convert_loc (((location_t) 0), pvoid_type_node, dummy_ptr
)
);
4487 tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
4488 /* Convert the CFI descriptor. */
4489 incoming = build_call_expr_loc (input_location,
4490 gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
4491 gfc_add_expr_to_block (&tmpblock, incoming);
4492 /* Set the dummy pointer to point to the gfc_descriptor. */
4493 gfc_add_modify (&tmpblock, dummy_ptr,
4494 fold_convert (TREE_TYPE (dummy_ptr), gfc_desc_ptr)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(dummy_ptr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4494, __FUNCTION__))->typed.type), gfc_desc_ptr)
);
4495
4496 /* The hidden string length is not passed to bind(C) procedures so set
4497 it from the descriptor element length. */
4498 if (sym->ts.type == BT_CHARACTER
4499 && sym->ts.u.cl->backend_decl
4500 && VAR_P (sym->ts.u.cl->backend_decl)(((enum tree_code) (sym->ts.u.cl->backend_decl)->base
.code) == VAR_DECL)
)
4501 {
4502 tmp = build_fold_indirect_ref_loc (input_location, dummy_ptr);
4503 tmp = gfc_conv_descriptor_elem_len (tmp);
4504 gfc_add_modify (&tmpblock, sym->ts.u.cl->backend_decl,
4505 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), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4505, __FUNCTION__))->typed.type), tmp)
4506 tmp)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(sym->ts.u.cl->backend_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4505, __FUNCTION__))->typed.type), tmp)
);
4507 }
4508
4509 /* Check that the argument is present before executing the above. */
4510 incoming = build3_v (COND_EXPR, present,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], present, gfc_finish_block (&tmpblock), build_empty_stmt
(input_location))
4511 gfc_finish_block (&tmpblock),fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], present, gfc_finish_block (&tmpblock), build_empty_stmt
(input_location))
4512 build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], present, gfc_finish_block (&tmpblock), build_empty_stmt
(input_location))
;
4513 gfc_add_expr_to_block (&outer_block, incoming);
4514 incoming = gfc_finish_block (&outer_block);
4515
4516
4517 /* Convert the gfc descriptor back to the CFI type before going
4518 out of scope, if the CFI type was present at entry. */
4519 gfc_init_block (&outer_block);
4520 gfc_init_block (&tmpblock);
4521
4522 tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
4523 outgoing = build_call_expr_loc (input_location,
4524 gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
4525 gfc_add_expr_to_block (&tmpblock, outgoing);
4526
4527 outgoing = build3_v (COND_EXPR, present,fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], present, gfc_finish_block (&tmpblock), build_empty_stmt
(input_location))
4528 gfc_finish_block (&tmpblock),fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], present, gfc_finish_block (&tmpblock), build_empty_stmt
(input_location))
4529 build_empty_stmt (input_location))fold_build3_loc (input_location, COND_EXPR, global_trees[TI_VOID_TYPE
], present, gfc_finish_block (&tmpblock), build_empty_stmt
(input_location))
;
4530 gfc_add_expr_to_block (&outer_block, outgoing);
4531 outgoing = gfc_finish_block (&outer_block);
4532
4533 /* Add the lot to the procedure init and finally blocks. */
4534 gfc_add_init_cleanup (block, incoming, outgoing);
4535 }
4536}
4537
4538/* Get the result expression for a procedure. */
4539
4540static tree
4541get_proc_result (gfc_symbol* sym)
4542{
4543 if (sym->attr.subroutine || sym == sym->result)
4544 {
4545 if (current_fake_result_decl != NULL__null)
4546 return TREE_VALUE (current_fake_result_decl)((tree_check ((current_fake_result_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4546, __FUNCTION__, (TREE_LIST)))->list.value)
;
4547
4548 return NULL_TREE(tree) __null;
4549 }
4550
4551 return sym->result->backend_decl;
4552}
4553
4554
4555/* Generate function entry and exit code, and add it to the function body.
4556 This includes:
4557 Allocation and initialization of array variables.
4558 Allocation of character string variables.
4559 Initialization and possibly repacking of dummy arrays.
4560 Initialization of ASSIGN statement auxiliary variable.
4561 Initialization of ASSOCIATE names.
4562 Automatic deallocation. */
4563
4564void
4565gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
4566{
4567 locus loc;
4568 gfc_symbol *sym;
4569 gfc_formal_arglist *f;
4570 stmtblock_t tmpblock;
4571 bool seen_trans_deferred_array = false;
4572 bool is_pdt_type = false;
4573 tree tmp = NULL__null;
4574 gfc_expr *e;
4575 gfc_se se;
4576 stmtblock_t init;
4577
4578 /* Deal with implicit return variables. Explicit return variables will
4579 already have been added. */
4580 if (gfc_return_by_reference (proc_sym) && proc_sym->result == proc_sym)
4581 {
4582 if (!current_fake_result_decl)
4583 {
4584 gfc_entry_list *el = NULL__null;
4585 if (proc_sym->attr.entry_master)
4586 {
4587 for (el = proc_sym->ns->entries; el; el = el->next)
4588 if (el->sym != el->sym->result)
4589 break;
4590 }
4591 /* TODO: move to the appropriate place in resolve.c. */
4592 if (warn_return_typeglobal_options.x_warn_return_type > 0 && el == NULL__null)
4593 gfc_warning (OPT_Wreturn_type,
4594 "Return value of function %qs at %L not set",
4595 proc_sym->name, &proc_sym->declared_at);
4596 }
4597 else if (proc_sym->as)
4598 {
4599 tree result = TREE_VALUE (current_fake_result_decl)((tree_check ((current_fake_result_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4599, __FUNCTION__, (TREE_LIST)))->list.value)
;
4600 gfc_save_backend_locus (&loc);
4601 gfc_set_backend_locus (&proc_sym->declared_at);
4602 gfc_trans_dummy_array_bias (proc_sym, result, block);
4603
4604 /* An automatic character length, pointer array result. */
4605 if (proc_sym->ts.type == BT_CHARACTER
4606 && VAR_P (proc_sym->ts.u.cl->backend_decl)(((enum tree_code) (proc_sym->ts.u.cl->backend_decl)->
base.code) == VAR_DECL)
)
4607 {
4608 tmp = NULL__null;
4609 if (proc_sym->ts.deferred)
4610 {
4611 gfc_start_block (&init);
4612 tmp = gfc_null_and_pass_deferred_len (proc_sym, &init, &loc);
4613 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
4614 }
4615 else
4616 gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
4617 }
4618 }
4619 else if (proc_sym->ts.type == BT_CHARACTER)
4620 {
4621 if (proc_sym->ts.deferred)
4622 {
4623 tmp = NULL__null;
4624 gfc_save_backend_locus (&loc);
4625 gfc_set_backend_locus (&proc_sym->declared_at);
4626 gfc_start_block (&init);
4627 /* Zero the string length on entry. */
4628 gfc_add_modify (&init, proc_sym->ts.u.cl->backend_decl,
4629 build_int_cst (gfc_charlen_type_node, 0));
4630 /* Null the pointer. */
4631 e = gfc_lval_expr_from_sym (proc_sym);
4632 gfc_init_se (&se, NULL__null);
4633 se.want_pointer = 1;
4634 gfc_conv_expr (&se, e);
4635 gfc_free_expr (e);
4636 tmp = se.expr;
4637 gfc_add_modify (&init, tmp,
4638 fold_convert (TREE_TYPE (se.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4638, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
])
4639 null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4638, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
])
);
4640 gfc_restore_backend_locus (&loc);
4641
4642 /* Pass back the string length on exit. */
4643 tmp = proc_sym->ts.u.cl->backend_decl;
4644 if (TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) != INDIRECT_REF
4645 && proc_sym->ts.u.cl->passed_length)
4646 {
4647 tmp = proc_sym->ts.u.cl->passed_length;
4648 tmp = build_fold_indirect_ref_loc (input_location, tmp);
4649 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
4650 TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4650, __FUNCTION__))->typed.type)
, tmp,
4651 fold_convertfold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4652, __FUNCTION__))->typed.type), proc_sym->ts.u.cl->
backend_decl)
4652 (TREE_TYPE (tmp),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4652, __FUNCTION__))->typed.type), proc_sym->ts.u.cl->
backend_decl)
4653 proc_sym->ts.u.cl->backend_decl)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4652, __FUNCTION__))->typed.type), proc_sym->ts.u.cl->
backend_decl)
);
4654 }
4655 else
4656 tmp = NULL_TREE(tree) __null;
4657
4658 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
4659 }
4660 else if (VAR_P (proc_sym->ts.u.cl->backend_decl)(((enum tree_code) (proc_sym->ts.u.cl->backend_decl)->
base.code) == VAR_DECL)
)
4661 gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
4662 }
4663 else
4664 gcc_assert (flag_f2c && proc_sym->ts.type == BT_COMPLEX)((void)(!(global_options.x_flag_f2c && proc_sym->ts
.type == BT_COMPLEX) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4664, __FUNCTION__), 0 : 0))
;
4665 }
4666 else if (proc_sym == proc_sym->result && IS_CLASS_ARRAY (proc_sym)(proc_sym->ts.type == BT_CLASS && proc_sym->ts.
u.derived->components && proc_sym->ts.u.derived
->components->attr.dimension && !proc_sym->ts
.u.derived->components->attr.class_pointer)
)
4667 {
4668 /* Nullify explicit return class arrays on entry. */
4669 tree type;
4670 tmp = get_proc_result (proc_sym);
4671 if (tmp && GFC_CLASS_TYPE_P (TREE_TYPE (tmp))((tree_class_check ((((contains_struct_check ((tmp), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4671, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4671, __FUNCTION__))->type_common.lang_flag_4)
)
4672 {
4673 gfc_start_block (&init);
4674 tmp = gfc_class_data_get (tmp);
4675 type = TREE_TYPE (gfc_conv_descriptor_data_get (tmp))((contains_struct_check ((gfc_conv_descriptor_data_get (tmp))
, (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4675, __FUNCTION__))->typed.type)
;
4676 gfc_conv_descriptor_data_set (&init, tmp, build_int_cst (type, 0));
4677 gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE(tree) __null);
4678 }
4679 }
4680
4681
4682 /* Initialize the INTENT(OUT) derived type dummy arguments. This
4683 should be done here so that the offsets and lbounds of arrays
4684 are available. */
4685 gfc_save_backend_locus (&loc);
4686 gfc_set_backend_locus (&proc_sym->declared_at);
4687 init_intent_out_dt (proc_sym, block);
4688 gfc_restore_backend_locus (&loc);
4689
4690 for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
4691 {
4692 bool alloc_comp_or_fini = (sym->ts.type == BT_DERIVED)
4693 && (sym->ts.u.derived->attr.alloc_comp
4694 || gfc_is_finalizable (sym->ts.u.derived,
4695 NULL__null));
4696 if (sym->assoc)
4697 continue;
4698
4699 if (sym->ts.type == BT_DERIVED
4700 && sym->ts.u.derived
4701 && sym->ts.u.derived->attr.pdt_type)
4702 {
4703 is_pdt_type = true;
4704 gfc_init_block (&tmpblock);
4705 if (!(sym->attr.dummy
4706 || sym->attr.pointer
4707 || sym->attr.allocatable))
4708 {
4709 tmp = gfc_allocate_pdt_comp (sym->ts.u.derived,
4710 sym->backend_decl,
4711 sym->as ? sym->as->rank : 0,
4712 sym->param_list);
4713 gfc_add_expr_to_block (&tmpblock, tmp);
4714 if (!sym->attr.result)
4715 tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived,
4716 sym->backend_decl,
4717 sym->as ? sym->as->rank : 0);
4718 else
4719 tmp = NULL_TREE(tree) __null;
4720 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp);
4721 }
4722 else if (sym->attr.dummy)
4723 {
4724 tmp = gfc_check_pdt_dummy (sym->ts.u.derived,
4725 sym->backend_decl,
4726 sym->as ? sym->as->rank : 0,
4727 sym->param_list);
4728 gfc_add_expr_to_block (&tmpblock, tmp);
4729 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL__null);
4730 }
4731 }
4732 else if (sym->ts.type == BT_CLASS
4733 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived
4734 && CLASS_DATA (sym)sym->ts.u.derived->components->ts.u.derived->attr.pdt_type)
4735 {
4736 gfc_component *data = CLASS_DATA (sym)sym->ts.u.derived->components;
4737 is_pdt_type = true;
4738 gfc_init_block (&tmpblock);
4739 if (!(sym->attr.dummy
4740 || CLASS_DATA (sym)sym->ts.u.derived->components->attr.pointer
4741 || CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable))
4742 {
4743 tmp = gfc_class_data_get (sym->backend_decl);
4744 tmp = gfc_allocate_pdt_comp (data->ts.u.derived, tmp,
4745 data->as ? data->as->rank : 0,
4746 sym->param_list);
4747 gfc_add_expr_to_block (&tmpblock, tmp);
4748 tmp = gfc_class_data_get (sym->backend_decl);
4749 if (!sym->attr.result)
4750 tmp = gfc_deallocate_pdt_comp (data->ts.u.derived, tmp,
4751 data->as ? data->as->rank : 0);
4752 else
4753 tmp = NULL_TREE(tree) __null;
4754 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp);
4755 }
4756 else if (sym->attr.dummy)
4757 {
4758 tmp = gfc_class_data_get (sym->backend_decl);
4759 tmp = gfc_check_pdt_dummy (data->ts.u.derived, tmp,
4760 data->as ? data->as->rank : 0,
4761 sym->param_list);
4762 gfc_add_expr_to_block (&tmpblock, tmp);
4763 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL__null);
4764 }
4765 }
4766
4767 if (sym->attr.pointer && sym->attr.dimension
4768 && sym->attr.save == SAVE_NONE
4769 && !sym->attr.use_assoc
4770 && !sym->attr.host_assoc
4771 && !sym->attr.dummy
4772 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl))((tree_class_check ((((contains_struct_check ((sym->backend_decl
), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4772, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4772, __FUNCTION__))->type_common.lang_flag_1)
)
4773 {
4774 gfc_init_block (&tmpblock);
4775 gfc_conv_descriptor_span_set (&tmpblock, sym->backend_decl,
4776 build_int_cst (gfc_array_index_type, 0));
4777 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
4778 NULL_TREE(tree) __null);
4779 }
4780
4781 if (sym->ts.type == BT_CLASS
4782 && (sym->attr.save || flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size == 0)
4783 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable)
4784 {
4785 tree vptr;
4786
4787 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
)
)
4788 vptr = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
4789 else
4790 {
4791 gfc_symbol *vsym;
4792 vsym = gfc_find_derived_vtab (sym->ts.u.derived);
4793 vptr = gfc_get_symbol_decl (vsym);
4794 vptr = gfc_build_addr_expr (NULL__null, vptr);
4795 }
4796
4797 if (CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
4798 || (CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension
4799 && flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB))
4800 {
4801 tmp = gfc_class_data_get (sym->backend_decl);
4802 tmp = gfc_build_null_descriptor (TREE_TYPE (tmp)((contains_struct_check ((tmp), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4802, __FUNCTION__))->typed.type)
);
4803 }
4804 else
4805 tmp = null_pointer_nodeglobal_trees[TI_NULL_POINTER];
4806
4807 DECL_INITIAL (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4807, __FUNCTION__))->decl_common.initial)
4808 = gfc_class_set_static_fields (sym->backend_decl, vptr, tmp);
4809 TREE_CONSTANT (DECL_INITIAL (sym->backend_decl))((non_type_check ((((contains_struct_check ((sym->backend_decl
), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4809, __FUNCTION__))->decl_common.initial)), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4809, __FUNCTION__))->base.constant_flag)
= 1;
4810 }
4811 else if ((sym->attr.dimension || sym->attr.codimension
4812 || (IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer)
&& !CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable)))
4813 {
4814 bool is_classarray = IS_CLASS_ARRAY (sym)(sym->ts.type == BT_CLASS && sym->ts.u.derived->
components && sym->ts.u.derived->components->
attr.dimension && !sym->ts.u.derived->components
->attr.class_pointer)
;
4815 symbol_attribute *array_attr;
4816 gfc_array_spec *as;
4817 array_type type_of_array;
4818
4819 array_attr = is_classarray ? &CLASS_DATA (sym)sym->ts.u.derived->components->attr : &sym->attr;
4820 as = is_classarray ? CLASS_DATA (sym)sym->ts.u.derived->components->as : sym->as;
4821 /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT. */
4822 type_of_array = as->type;
4823 if (type_of_array == AS_ASSUMED_SIZE && as->cp_was_assumed)
4824 type_of_array = AS_EXPLICIT;
4825 switch (type_of_array)
4826 {
4827 case AS_EXPLICIT:
4828 if (sym->attr.dummy || sym->attr.result)
4829 gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
4830 /* Allocatable and pointer arrays need to processed
4831 explicitly. */
4832 else if ((sym->ts.type != BT_CLASS && sym->attr.pointer)
4833 || (sym->ts.type == BT_CLASS
4834 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer)
4835 || array_attr->allocatable)
4836 {
4837 if (TREE_STATIC (sym->backend_decl)((sym->backend_decl)->base.static_flag))
4838 {
4839 gfc_save_backend_locus (&loc);
4840 gfc_set_backend_locus (&sym->declared_at);
4841 gfc_trans_static_array_pointer (sym);
4842 gfc_restore_backend_locus (&loc);
4843 }
4844 else
4845 {
4846 seen_trans_deferred_array = true;
4847 gfc_trans_deferred_array (sym, block);
4848 }
4849 }
4850 else if (sym->attr.codimension
4851 && TREE_STATIC (sym->backend_decl)((sym->backend_decl)->base.static_flag))
4852 {
4853 gfc_init_block (&tmpblock);
4854 gfc_trans_array_cobounds (TREE_TYPE (sym->backend_decl)((contains_struct_check ((sym->backend_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4854, __FUNCTION__))->typed.type)
,
4855 &tmpblock, sym);
4856 gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
4857 NULL_TREE(tree) __null);
4858 continue;
4859 }
4860 else
4861 {
4862 gfc_save_backend_locus (&loc);
4863 gfc_set_backend_locus (&sym->declared_at);
4864
4865 if (alloc_comp_or_fini)
4866 {
4867 seen_trans_deferred_array = true;
4868 gfc_trans_deferred_array (sym, block);
4869 }
4870 else if (sym->ts.type == BT_DERIVED
4871 && sym->value
4872 && !sym->attr.data
4873 && sym->attr.save == SAVE_NONE)
4874 {
4875 gfc_start_block (&tmpblock);
4876 gfc_init_default_dt (sym, &tmpblock, false);
4877 gfc_add_init_cleanup (block,
4878 gfc_finish_block (&tmpblock),
4879 NULL_TREE(tree) __null);
4880 }
4881
4882 gfc_trans_auto_array_allocation (sym->backend_decl,
4883 sym, block);
4884 gfc_restore_backend_locus (&loc);
4885 }
4886 break;
4887
4888 case AS_ASSUMED_SIZE:
4889 /* Must be a dummy parameter. */
4890 gcc_assert (sym->attr.dummy || as->cp_was_assumed)((void)(!(sym->attr.dummy || as->cp_was_assumed) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4890, __FUNCTION__), 0 : 0))
;
4891
4892 /* We should always pass assumed size arrays the g77 way. */
4893 if (sym->attr.dummy)
4894 gfc_trans_g77_array (sym, block);
4895 break;
4896
4897 case AS_ASSUMED_SHAPE:
4898 /* Must be a dummy parameter. */
4899 gcc_assert (sym->attr.dummy)((void)(!(sym->attr.dummy) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4899, __FUNCTION__), 0 : 0))
;
4900
4901 gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
4902 break;
4903
4904 case AS_ASSUMED_RANK:
4905 case AS_DEFERRED:
4906 seen_trans_deferred_array = true;
4907 gfc_trans_deferred_array (sym, block);
4908 if (sym->ts.type == BT_CHARACTER && sym->ts.deferred
4909 && sym->attr.result)
4910 {
4911 gfc_start_block (&init);
4912 gfc_save_backend_locus (&loc);
4913 gfc_set_backend_locus (&sym->declared_at);
4914 tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
4915 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
4916 }
4917 break;
4918
4919 default:
4920 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4920, __FUNCTION__))
;
4921 }
4922 if (alloc_comp_or_fini && !seen_trans_deferred_array)
4923 gfc_trans_deferred_array (sym, block);
4924 }
4925 else if ((!sym->attr.dummy || sym->ts.deferred)
4926 && (sym->ts.type == BT_CLASS
4927 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer))
4928 continue;
4929 else if ((!sym->attr.dummy || sym->ts.deferred)
4930 && (sym->attr.allocatable
4931 || (sym->attr.pointer && sym->attr.result)
4932 || (sym->ts.type == BT_CLASS
4933 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.allocatable)))
4934 {
4935 if (!sym->attr.save && flag_max_stack_var_sizeglobal_options.x_flag_max_stack_var_size != 0)
4936 {
4937 tree descriptor = NULL_TREE(tree) __null;
4938
4939 gfc_save_backend_locus (&loc);
4940 gfc_set_backend_locus (&sym->declared_at);
4941 gfc_start_block (&init);
4942
4943 if (sym->ts.type == BT_CHARACTER
4944 && sym->attr.allocatable
4945 && !sym->attr.dimension
4946 && sym->ts.u.cl && sym->ts.u.cl->length
4947 && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE)
4948 gfc_conv_string_length (sym->ts.u.cl, NULL__null, &init);
4949
4950 if (!sym->attr.pointer)
4951 {
4952 /* Nullify and automatic deallocation of allocatable
4953 scalars. */
4954 e = gfc_lval_expr_from_sym (sym);
4955 if (sym->ts.type == BT_CLASS)
4956 gfc_add_data_component (e)gfc_add_component_ref(e,"_data");
4957
4958 gfc_init_se (&se, NULL__null);
4959 if (sym->ts.type != BT_CLASS
4960 || sym->ts.u.derived->attr.dimension
4961 || sym->ts.u.derived->attr.codimension)
4962 {
4963 se.want_pointer = 1;
4964 gfc_conv_expr (&se, e);
4965 }
4966 else if (sym->ts.type == BT_CLASS
4967 && !CLASS_DATA (sym)sym->ts.u.derived->components->attr.dimension
4968 && !CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension)
4969 {
4970 se.want_pointer = 1;
4971 gfc_conv_expr (&se, e);
4972 }
4973 else
4974 {
4975 se.descriptor_only = 1;
4976 gfc_conv_expr (&se, e);
4977 descriptor = se.expr;
4978 se.expr = gfc_conv_descriptor_data_addr (se.expr);
4979 se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
4980 }
4981 gfc_free_expr (e);
4982
4983 if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
4984 {
4985 /* Nullify when entering the scope. */
4986 tmp = fold_build2_loc (input_location, MODIFY_EXPR,
4987 TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4987, __FUNCTION__))->typed.type)
, se.expr,
4988 fold_convert (TREE_TYPE (se.expr),fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4988, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
])
4989 null_pointer_node)fold_convert_loc (((location_t) 0), ((contains_struct_check (
(se.expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 4988, __FUNCTION__))->typed.type), global_trees[TI_NULL_POINTER
])
);
4990 if (sym->attr.optional)
4991 {
4992 tree present = gfc_conv_expr_present (sym);
4993 tmp = build3_loc (input_location, COND_EXPR,
4994 void_type_nodeglobal_trees[TI_VOID_TYPE], present, tmp,
4995 build_empty_stmt (input_location));
4996 }
4997 gfc_add_expr_to_block (&init, tmp);
4998 }
4999 }
5000
5001 if ((sym->attr.dummy || sym->attr.result)
5002 && sym->ts.type == BT_CHARACTER
5003 && sym->ts.deferred
5004 && sym->ts.u.cl->passed_length)
5005 tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
5006 else
5007 {
5008 gfc_restore_backend_locus (&loc);
5009 tmp = NULL_TREE(tree) __null;
5010 }
5011
5012 /* Deallocate when leaving the scope. Nullifying is not
5013 needed. */
5014 if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer
5015 && !sym->ns->proc_name->attr.is_main_program)
5016 {
5017 if (sym->ts.type == BT_CLASS
5018 && CLASS_DATA (sym)sym->ts.u.derived->components->attr.codimension)
5019 tmp = gfc_deallocate_with_status (descriptor, NULL_TREE(tree) __null,
5020 NULL_TREE(tree) __null, NULL_TREE(tree) __null,
5021 NULL_TREE(tree) __null, true, NULL__null,
5022 GFC_CAF_COARRAY_ANALYZE);
5023 else
5024 {
5025 gfc_expr *expr = gfc_lval_expr_from_sym (sym);
5026 tmp = gfc_deallocate_scalar_with_status (se.expr,
5027 NULL_TREE(tree) __null,
5028 NULL_TREE(tree) __null,
5029 true, expr,
5030 sym->ts);
5031 gfc_free_expr (expr);
5032 }
5033 }
5034
5035 if (sym->ts.type == BT_CLASS)
5036 {
5037 /* Initialize _vptr to declared type. */
5038 gfc_symbol *vtab;
5039 tree rhs;
5040
5041 gfc_save_backend_locus (&loc);
5042 gfc_set_backend_locus (&sym->declared_at);
5043 e = gfc_lval_expr_from_sym (sym);
5044 gfc_add_vptr_component (e)gfc_add_component_ref(e,"_vptr");
5045 gfc_init_se (&se, NULL__null);
5046 se.want_pointer = 1;
5047 gfc_conv_expr (&se, e);
5048 gfc_free_expr (e);
5049 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
)
)
5050 rhs = build_int_cst (TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 5050, __FUNCTION__))->typed.type)
, 0);
5051 else
5052 {
5053 vtab = gfc_find_derived_vtab (sym->ts.u.derived);
5054 rhs = gfc_build_addr_expr (TREE_TYPE (se.expr)((contains_struct_check ((se.expr), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-decl.c"
, 5054, __FUNCTION__))->typed.type)
,
5055 gfc_get_symbol_decl (vtab));
5056 }
5057 gfc_add_modify (&init, se.expr, rhs);
5058 gfc_restore_backend_locus (&loc);
5059 }
5060
5061 gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
5062 }
5063 }
5064 else if (sym->ts.type == BT_CHARACTER && sym->ts.deferred)
5065 {
5066 tree tmp = NULL__null;
5067