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-types.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-AuTiOU.plist -x c++ /home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c

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

1/* Backend support for Fortran 95 basic types and derived types.
2 Copyright (C) 2002-2021 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
4 and Steven Bosscher <s.bosscher@student.tudelft.nl>
5
6This file is part of GCC.
7
8GCC is free software; you can redistribute it and/or modify it under
9the terms of the GNU General Public License as published by the Free
10Software Foundation; either version 3, or (at your option) any later
11version.
12
13GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14WARRANTY; without even the implied warranty of MERCHANTABILITY or
15FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16for more details.
17
18You should have received a copy of the GNU General Public License
19along with GCC; see the file COPYING3. If not see
20<http://www.gnu.org/licenses/>. */
21
22/* trans-types.c -- gfortran backend types */
23
24#include "config.h"
25#include "system.h"
26#include "coretypes.h"
27#include "target.h"
28#include "tree.h"
29#include "gfortran.h"
30#include "trans.h"
31#include "stringpool.h"
32#include "fold-const.h"
33#include "stor-layout.h"
34#include "langhooks.h" /* For iso-c-bindings.def. */
35#include "toplev.h" /* For rest_of_decl_compilation. */
36#include "trans-types.h"
37#include "trans-const.h"
38#include "trans-array.h"
39#include "dwarf2out.h" /* For struct array_descr_info. */
40#include "attribs.h"
41#include "alias.h"
42
43
44#if (GFC_MAX_DIMENSIONS15 < 10)
45#define GFC_RANK_DIGITS2 1
46#define GFC_RANK_PRINTF_FORMAT"%02d" "%01d"
47#elif (GFC_MAX_DIMENSIONS15 < 100)
48#define GFC_RANK_DIGITS2 2
49#define GFC_RANK_PRINTF_FORMAT"%02d" "%02d"
50#else
51#error If you really need >99 dimensions, continue the sequence above...
52#endif
53
54/* array of structs so we don't have to worry about xmalloc or free */
55CInteropKind_t c_interop_kinds_table[ISOCBINDING_NUMBER];
56
57tree gfc_array_index_type;
58tree gfc_array_range_type;
59tree gfc_character1_type_node;
60tree pvoid_type_node;
61tree prvoid_type_node;
62tree ppvoid_type_node;
63tree pchar_type_node;
64tree pfunc_type_node;
65
66tree logical_type_node;
67tree logical_true_node;
68tree logical_false_node;
69tree gfc_charlen_type_node;
70
71tree gfc_float128_type_node = NULL_TREE(tree) __null;
72tree gfc_complex_float128_type_node = NULL_TREE(tree) __null;
73
74bool gfc_real16_is_float128 = false;
75
76static GTY(()) tree gfc_desc_dim_type;
77static GTY(()) tree gfc_max_array_element_size;
78static GTY(()) tree gfc_array_descriptor_base[2 * (GFC_MAX_DIMENSIONS15+1)];
79static GTY(()) tree gfc_array_descriptor_base_caf[2 * (GFC_MAX_DIMENSIONS15+1)];
80
81/* Arrays for all integral and real kinds. We'll fill this in at runtime
82 after the target has a chance to process command-line options. */
83
84#define MAX_INT_KINDS5 5
85gfc_integer_info gfc_integer_kinds[MAX_INT_KINDS5 + 1];
86gfc_logical_info gfc_logical_kinds[MAX_INT_KINDS5 + 1];
87static GTY(()) tree gfc_integer_types[MAX_INT_KINDS5 + 1];
88static GTY(()) tree gfc_logical_types[MAX_INT_KINDS5 + 1];
89
90#define MAX_REAL_KINDS5 5
91gfc_real_info gfc_real_kinds[MAX_REAL_KINDS5 + 1];
92static GTY(()) tree gfc_real_types[MAX_REAL_KINDS5 + 1];
93static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS5 + 1];
94
95#define MAX_CHARACTER_KINDS2 2
96gfc_character_info gfc_character_kinds[MAX_CHARACTER_KINDS2 + 1];
97static GTY(()) tree gfc_character_types[MAX_CHARACTER_KINDS2 + 1];
98static GTY(()) tree gfc_pcharacter_types[MAX_CHARACTER_KINDS2 + 1];
99
100static tree gfc_add_field_to_struct_1 (tree, tree, tree, tree **);
101
102/* The integer kind to use for array indices. This will be set to the
103 proper value based on target information from the backend. */
104
105int gfc_index_integer_kind;
106
107/* The default kinds of the various types. */
108
109int gfc_default_integer_kind;
110int gfc_max_integer_kind;
111int gfc_default_real_kind;
112int gfc_default_double_kind;
113int gfc_default_character_kind;
114int gfc_default_logical_kind;
115int gfc_default_complex_kind;
116int gfc_c_int_kind;
117int gfc_atomic_int_kind;
118int gfc_atomic_logical_kind;
119
120/* The kind size used for record offsets. If the target system supports
121 kind=8, this will be set to 8, otherwise it is set to 4. */
122int gfc_intio_kind;
123
124/* The integer kind used to store character lengths. */
125int gfc_charlen_int_kind;
126
127/* Kind of internal integer for storing object sizes. */
128int gfc_size_kind;
129
130/* The size of the numeric storage unit and character storage unit. */
131int gfc_numeric_storage_size;
132int gfc_character_storage_size;
133
134tree dtype_type_node = NULL_TREE(tree) __null;
135
136
137/* Build the dtype_type_node if necessary. */
138tree get_dtype_type_node (void)
139{
140 tree field;
141 tree dtype_node;
142 tree *dtype_chain = NULL__null;
143
144 if (dtype_type_node == NULL_TREE(tree) __null)
145 {
146 dtype_node = make_node (RECORD_TYPE);
147 TYPE_NAME (dtype_node)((tree_class_check ((dtype_node), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 147, __FUNCTION__))->type_common.name)
= get_identifier ("dtype_type")(__builtin_constant_p ("dtype_type") ? get_identifier_with_length
(("dtype_type"), strlen ("dtype_type")) : get_identifier ("dtype_type"
))
;
148 TYPE_NAMELESS (dtype_node)((tree_class_check ((dtype_node), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 148, __FUNCTION__))->base.u.bits.nameless_flag)
= 1;
149 field = gfc_add_field_to_struct_1 (dtype_node,
150 get_identifier ("elem_len")(__builtin_constant_p ("elem_len") ? get_identifier_with_length
(("elem_len"), strlen ("elem_len")) : get_identifier ("elem_len"
))
,
151 size_type_nodeglobal_trees[TI_SIZE_TYPE], &dtype_chain);
152 TREE_NO_WARNING (field)((field)->base.nowarning_flag) = 1;
153 field = gfc_add_field_to_struct_1 (dtype_node,
154 get_identifier ("version")(__builtin_constant_p ("version") ? get_identifier_with_length
(("version"), strlen ("version")) : get_identifier ("version"
))
,
155 integer_type_nodeinteger_types[itk_int], &dtype_chain);
156 TREE_NO_WARNING (field)((field)->base.nowarning_flag) = 1;
157 field = gfc_add_field_to_struct_1 (dtype_node,
158 get_identifier ("rank")(__builtin_constant_p ("rank") ? get_identifier_with_length (
("rank"), strlen ("rank")) : get_identifier ("rank"))
,
159 signed_char_type_nodeinteger_types[itk_signed_char], &dtype_chain);
160 TREE_NO_WARNING (field)((field)->base.nowarning_flag) = 1;
161 field = gfc_add_field_to_struct_1 (dtype_node,
162 get_identifier ("type")(__builtin_constant_p ("type") ? get_identifier_with_length (
("type"), strlen ("type")) : get_identifier ("type"))
,
163 signed_char_type_nodeinteger_types[itk_signed_char], &dtype_chain);
164 TREE_NO_WARNING (field)((field)->base.nowarning_flag) = 1;
165 field = gfc_add_field_to_struct_1 (dtype_node,
166 get_identifier ("attribute")(__builtin_constant_p ("attribute") ? get_identifier_with_length
(("attribute"), strlen ("attribute")) : get_identifier ("attribute"
))
,
167 short_integer_type_nodeinteger_types[itk_short], &dtype_chain);
168 TREE_NO_WARNING (field)((field)->base.nowarning_flag) = 1;
169 gfc_finish_type (dtype_node);
170 TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (dtype_node))((tree_check (((((contains_struct_check (((tree_class_check (
(dtype_node), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 170, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 170, __FUNCTION__))->common.chain))), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 170, __FUNCTION__, (TYPE_DECL)))->decl_common.decl_flag_1
)
= 1;
171 dtype_type_node = dtype_node;
172 }
173 return dtype_type_node;
174}
175
176bool
177gfc_check_any_c_kind (gfc_typespec *ts)
178{
179 int i;
180
181 for (i = 0; i < ISOCBINDING_NUMBER; i++)
182 {
183 /* Check for any C interoperable kind for the given type/kind in ts.
184 This can be used after verify_c_interop to make sure that the
185 Fortran kind being used exists in at least some form for C. */
186 if (c_interop_kinds_table[i].f90_type == ts->type &&
187 c_interop_kinds_table[i].value == ts->kind)
188 return true;
189 }
190
191 return false;
192}
193
194
195static int
196get_real_kind_from_node (tree type)
197{
198 int i;
199
200 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
201 if (gfc_real_kinds[i].mode_precision == TYPE_PRECISION (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 201, __FUNCTION__))->type_common.precision)
)
202 return gfc_real_kinds[i].kind;
203
204 return -4;
205}
206
207static int
208get_int_kind_from_node (tree type)
209{
210 int i;
211
212 if (!type)
213 return -2;
214
215 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
216 if (gfc_integer_kinds[i].bit_size == TYPE_PRECISION (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 216, __FUNCTION__))->type_common.precision)
)
217 return gfc_integer_kinds[i].kind;
218
219 return -1;
220}
221
222static int
223get_int_kind_from_name (const char *name)
224{
225 return get_int_kind_from_node (get_typenode_from_name (name));
226}
227
228
229/* Get the kind number corresponding to an integer of given size,
230 following the required return values for ISO_FORTRAN_ENV INT* constants:
231 -2 is returned if we support a kind of larger size, -1 otherwise. */
232int
233gfc_get_int_kind_from_width_isofortranenv (int size)
234{
235 int i;
236
237 /* Look for a kind with matching storage size. */
238 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
239 if (gfc_integer_kinds[i].bit_size == size)
240 return gfc_integer_kinds[i].kind;
241
242 /* Look for a kind with larger storage size. */
243 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
244 if (gfc_integer_kinds[i].bit_size > size)
245 return -2;
246
247 return -1;
248}
249
250
251/* Get the kind number corresponding to a real of a given storage size.
252 If two real's have the same storage size, then choose the real with
253 the largest precision. If a kind type is unavailable and a real
254 exists with wider storage, then return -2; otherwise, return -1. */
255
256int
257gfc_get_real_kind_from_width_isofortranenv (int size)
258{
259 int digits, i, kind;
260
261 size /= 8;
262
263 kind = -1;
264 digits = 0;
265
266 /* Look for a kind with matching storage size. */
267 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
268 if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) == size)
269 {
270 if (gfc_real_kinds[i].digits > digits)
271 {
272 digits = gfc_real_kinds[i].digits;
273 kind = gfc_real_kinds[i].kind;
274 }
275 }
276
277 if (kind != -1)
278 return kind;
279
280 /* Look for a kind with larger storage size. */
281 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
282 if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) > size)
283 kind = -2;
284
285 return kind;
286}
287
288
289
290static int
291get_int_kind_from_width (int size)
292{
293 int i;
294
295 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
296 if (gfc_integer_kinds[i].bit_size == size)
297 return gfc_integer_kinds[i].kind;
298
299 return -2;
300}
301
302static int
303get_int_kind_from_minimal_width (int size)
304{
305 int i;
306
307 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
308 if (gfc_integer_kinds[i].bit_size >= size)
309 return gfc_integer_kinds[i].kind;
310
311 return -2;
312}
313
314
315/* Generate the CInteropKind_t objects for the C interoperable
316 kinds. */
317
318void
319gfc_init_c_interop_kinds (void)
320{
321 int i;
322
323 /* init all pointers in the list to NULL */
324 for (i = 0; i < ISOCBINDING_NUMBER; i++)
325 {
326 /* Initialize the name and value fields. */
327 c_interop_kinds_table[i].name[0] = '\0';
328 c_interop_kinds_table[i].value = -100;
329 c_interop_kinds_table[i].f90_type = BT_UNKNOWN;
330 }
331
332#define NAMED_INTCST(a,b,c,d) \
333 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
334 c_interop_kinds_table[a].f90_type = BT_INTEGER; \
335 c_interop_kinds_table[a].value = c;
336#define NAMED_REALCST(a,b,c,d) \
337 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
338 c_interop_kinds_table[a].f90_type = BT_REAL; \
339 c_interop_kinds_table[a].value = c;
340#define NAMED_CMPXCST(a,b,c,d) \
341 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
342 c_interop_kinds_table[a].f90_type = BT_COMPLEX; \
343 c_interop_kinds_table[a].value = c;
344#define NAMED_LOGCST(a,b,c) \
345 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
346 c_interop_kinds_table[a].f90_type = BT_LOGICAL; \
347 c_interop_kinds_table[a].value = c;
348#define NAMED_CHARKNDCST(a,b,c) \
349 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
350 c_interop_kinds_table[a].f90_type = BT_CHARACTER; \
351 c_interop_kinds_table[a].value = c;
352#define NAMED_CHARCST(a,b,c) \
353 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
354 c_interop_kinds_table[a].f90_type = BT_CHARACTER; \
355 c_interop_kinds_table[a].value = c;
356#define DERIVED_TYPE(a,b,c) \
357 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
358 c_interop_kinds_table[a].f90_type = BT_DERIVED; \
359 c_interop_kinds_table[a].value = c;
360#define NAMED_FUNCTION(a,b,c,d) \
361 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
362 c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
363 c_interop_kinds_table[a].value = c;
364#define NAMED_SUBROUTINE(a,b,c,d) \
365 strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
366 c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
367 c_interop_kinds_table[a].value = c;
368#include "iso-c-binding.def"
369}
370
371
372/* Query the target to determine which machine modes are available for
373 computation. Choose KIND numbers for them. */
374
375void
376gfc_init_kinds (void)
377{
378 opt_scalar_int_mode int_mode_iter;
379 opt_scalar_float_mode float_mode_iter;
380 int i_index, r_index, kind;
381 bool saw_i4 = false, saw_i8 = false;
382 bool saw_r4 = false, saw_r8 = false, saw_r10 = false, saw_r16 = false;
383
384 i_index = 0;
385 FOR_EACH_MODE_IN_CLASS (int_mode_iter, MODE_INT)for (mode_iterator::start (&(int_mode_iter), MODE_INT); mode_iterator
::iterate_p (&(int_mode_iter)); mode_iterator::get_wider (
&(int_mode_iter)))
386 {
387 scalar_int_mode mode = int_mode_iter.require ();
388 int kind, bitsize;
389
390 if (!targetm.scalar_mode_supported_p (mode))
391 continue;
392
393 /* The middle end doesn't support constants larger than 2*HWI.
394 Perhaps the target hook shouldn't have accepted these either,
395 but just to be safe... */
396 bitsize = GET_MODE_BITSIZE (mode);
397 if (bitsize > 2*HOST_BITS_PER_WIDE_INT64)
398 continue;
399
400 gcc_assert (i_index != MAX_INT_KINDS)((void)(!(i_index != 5) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 400, __FUNCTION__), 0 : 0))
;
401
402 /* Let the kind equal the bit size divided by 8. This insulates the
403 programmer from the underlying byte size. */
404 kind = bitsize / 8;
405
406 if (kind == 4)
407 saw_i4 = true;
408 if (kind == 8)
409 saw_i8 = true;
410
411 gfc_integer_kinds[i_index].kind = kind;
412 gfc_integer_kinds[i_index].radix = 2;
413 gfc_integer_kinds[i_index].digits = bitsize - 1;
414 gfc_integer_kinds[i_index].bit_size = bitsize;
415
416 gfc_logical_kinds[i_index].kind = kind;
417 gfc_logical_kinds[i_index].bit_size = bitsize;
418
419 i_index += 1;
420 }
421
422 /* Set the kind used to match GFC_INT_IO in libgfortran. This is
423 used for large file access. */
424
425 if (saw_i8)
426 gfc_intio_kind = 8;
427 else
428 gfc_intio_kind = 4;
429
430 /* If we do not at least have kind = 4, everything is pointless. */
431 gcc_assert(saw_i4)((void)(!(saw_i4) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 431, __FUNCTION__), 0 : 0))
;
432
433 /* Set the maximum integer kind. Used with at least BOZ constants. */
434 gfc_max_integer_kind = gfc_integer_kinds[i_index - 1].kind;
435
436 r_index = 0;
437 FOR_EACH_MODE_IN_CLASS (float_mode_iter, MODE_FLOAT)for (mode_iterator::start (&(float_mode_iter), MODE_FLOAT
); mode_iterator::iterate_p (&(float_mode_iter)); mode_iterator
::get_wider (&(float_mode_iter)))
438 {
439 scalar_float_mode mode = float_mode_iter.require ();
440 const struct real_format *fmt = REAL_MODE_FORMAT (mode)(real_format_for_mode[(((enum mode_class) mode_class[mode]) ==
MODE_DECIMAL_FLOAT) ? (((mode) - MIN_MODE_DECIMAL_FLOAT) + (
MAX_MODE_FLOAT - MIN_MODE_FLOAT + 1)) : ((enum mode_class) mode_class
[mode]) == MODE_FLOAT ? ((mode) - MIN_MODE_FLOAT) : ((fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 440, __FUNCTION__)), 0)])
;
441 int kind;
442
443 if (fmt == NULL__null)
444 continue;
445 if (!targetm.scalar_mode_supported_p (mode))
446 continue;
447
448 /* Only let float, double, long double and __float128 go through.
449 Runtime support for others is not provided, so they would be
450 useless. */
451 if (!targetm.libgcc_floating_mode_supported_p (mode))
452 continue;
453 if (mode != TYPE_MODE (float_type_node)((((enum tree_code) ((tree_class_check ((global_trees[TI_FLOAT_TYPE
]), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 453, __FUNCTION__)))->base.code) == VECTOR_TYPE) ? vector_type_mode
(global_trees[TI_FLOAT_TYPE]) : (global_trees[TI_FLOAT_TYPE]
)->type_common.mode)
454 && (mode != TYPE_MODE (double_type_node)((((enum tree_code) ((tree_class_check ((global_trees[TI_DOUBLE_TYPE
]), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 454, __FUNCTION__)))->base.code) == VECTOR_TYPE) ? vector_type_mode
(global_trees[TI_DOUBLE_TYPE]) : (global_trees[TI_DOUBLE_TYPE
])->type_common.mode)
)
455 && (mode != TYPE_MODE (long_double_type_node)((((enum tree_code) ((tree_class_check ((global_trees[TI_LONG_DOUBLE_TYPE
]), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 455, __FUNCTION__)))->base.code) == VECTOR_TYPE) ? vector_type_mode
(global_trees[TI_LONG_DOUBLE_TYPE]) : (global_trees[TI_LONG_DOUBLE_TYPE
])->type_common.mode)
)
456#if defined(HAVE_TFmode) && defined(ENABLE_LIBQUADMATH_SUPPORT1)
457 && (mode != TFmode(scalar_float_mode ((scalar_float_mode::from_int) E_TFmode)))
458#endif
459 )
460 continue;
461
462 /* Let the kind equal the precision divided by 8, rounding up. Again,
463 this insulates the programmer from the underlying byte size.
464
465 Also, it effectively deals with IEEE extended formats. There, the
466 total size of the type may equal 16, but it's got 6 bytes of padding
467 and the increased size can get in the way of a real IEEE quad format
468 which may also be supported by the target.
469
470 We round up so as to handle IA-64 __floatreg (RFmode), which is an
471 82 bit type. Not to be confused with __float80 (XFmode), which is
472 an 80 bit type also supported by IA-64. So XFmode should come out
473 to be kind=10, and RFmode should come out to be kind=11. Egads. */
474
475 kind = (GET_MODE_PRECISION (mode) + 7) / 8;
476
477 if (kind == 4)
478 saw_r4 = true;
479 if (kind == 8)
480 saw_r8 = true;
481 if (kind == 10)
482 saw_r10 = true;
483 if (kind == 16)
484 saw_r16 = true;
485
486 /* Careful we don't stumble a weird internal mode. */
487 gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind)((void)(!(r_index <= 0 || gfc_real_kinds[r_index-1].kind !=
kind) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 487, __FUNCTION__), 0 : 0))
;
488 /* Or have too many modes for the allocated space. */
489 gcc_assert (r_index != MAX_REAL_KINDS)((void)(!(r_index != 5) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 489, __FUNCTION__), 0 : 0))
;
490
491 gfc_real_kinds[r_index].kind = kind;
492 gfc_real_kinds[r_index].radix = fmt->b;
493 gfc_real_kinds[r_index].digits = fmt->p;
494 gfc_real_kinds[r_index].min_exponent = fmt->emin;
495 gfc_real_kinds[r_index].max_exponent = fmt->emax;
496 if (fmt->pnan < fmt->p)
497 /* This is an IBM extended double format (or the MIPS variant)
498 made up of two IEEE doubles. The value of the long double is
499 the sum of the values of the two parts. The most significant
500 part is required to be the value of the long double rounded
501 to the nearest double. If we use emax of 1024 then we can't
502 represent huge(x) = (1 - b**(-p)) * b**(emax-1) * b, because
503 rounding will make the most significant part overflow. */
504 gfc_real_kinds[r_index].max_exponent = fmt->emax - 1;
505 gfc_real_kinds[r_index].mode_precision = GET_MODE_PRECISION (mode);
506 r_index += 1;
507 }
508
509 /* Choose the default integer kind. We choose 4 unless the user directs us
510 otherwise. Even if the user specified that the default integer kind is 8,
511 the numeric storage size is not 64 bits. In this case, a warning will be
512 issued when NUMERIC_STORAGE_SIZE is used. Set NUMERIC_STORAGE_SIZE to 32. */
513
514 gfc_numeric_storage_size = 4 * 8;
515
516 if (flag_default_integerglobal_options.x_flag_default_integer)
517 {
518 if (!saw_i8)
519 gfc_fatal_error ("INTEGER(KIND=8) is not available for "
520 "%<-fdefault-integer-8%> option");
521
522 gfc_default_integer_kind = 8;
523
524 }
525 else if (flag_integer4_kindglobal_options.x_flag_integer4_kind == 8)
526 {
527 if (!saw_i8)
528 gfc_fatal_error ("INTEGER(KIND=8) is not available for "
529 "%<-finteger-4-integer-8%> option");
530
531 gfc_default_integer_kind = 8;
532 }
533 else if (saw_i4)
534 {
535 gfc_default_integer_kind = 4;
536 }
537 else
538 {
539 gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind;
540 gfc_numeric_storage_size = gfc_integer_kinds[i_index - 1].bit_size;
541 }
542
543 /* Choose the default real kind. Again, we choose 4 when possible. */
544 if (flag_default_real_8global_options.x_flag_default_real_8)
545 {
546 if (!saw_r8)
547 gfc_fatal_error ("REAL(KIND=8) is not available for "
548 "%<-fdefault-real-8%> option");
549
550 gfc_default_real_kind = 8;
551 }
552 else if (flag_default_real_10global_options.x_flag_default_real_10)
553 {
554 if (!saw_r10)
555 gfc_fatal_error ("REAL(KIND=10) is not available for "
556 "%<-fdefault-real-10%> option");
557
558 gfc_default_real_kind = 10;
559 }
560 else if (flag_default_real_16global_options.x_flag_default_real_16)
561 {
562 if (!saw_r16)
563 gfc_fatal_error ("REAL(KIND=16) is not available for "
564 "%<-fdefault-real-16%> option");
565
566 gfc_default_real_kind = 16;
567 }
568 else if (flag_real4_kindglobal_options.x_flag_real4_kind == 8)
569 {
570 if (!saw_r8)
571 gfc_fatal_error ("REAL(KIND=8) is not available for %<-freal-4-real-8%> "
572 "option");
573
574 gfc_default_real_kind = 8;
575 }
576 else if (flag_real4_kindglobal_options.x_flag_real4_kind == 10)
577 {
578 if (!saw_r10)
579 gfc_fatal_error ("REAL(KIND=10) is not available for "
580 "%<-freal-4-real-10%> option");
581
582 gfc_default_real_kind = 10;
583 }
584 else if (flag_real4_kindglobal_options.x_flag_real4_kind == 16)
585 {
586 if (!saw_r16)
587 gfc_fatal_error ("REAL(KIND=16) is not available for "
588 "%<-freal-4-real-16%> option");
589
590 gfc_default_real_kind = 16;
591 }
592 else if (saw_r4)
593 gfc_default_real_kind = 4;
594 else
595 gfc_default_real_kind = gfc_real_kinds[0].kind;
596
597 /* Choose the default double kind. If -fdefault-real and -fdefault-double
598 are specified, we use kind=8, if it's available. If -fdefault-real is
599 specified without -fdefault-double, we use kind=16, if it's available.
600 Otherwise we do not change anything. */
601 if (flag_default_doubleglobal_options.x_flag_default_double && saw_r8)
602 gfc_default_double_kind = 8;
603 else if (flag_default_real_8global_options.x_flag_default_real_8 || flag_default_real_10global_options.x_flag_default_real_10 || flag_default_real_16global_options.x_flag_default_real_16)
604 {
605 /* Use largest available kind. */
606 if (saw_r16)
607 gfc_default_double_kind = 16;
608 else if (saw_r10)
609 gfc_default_double_kind = 10;
610 else if (saw_r8)
611 gfc_default_double_kind = 8;
612 else
613 gfc_default_double_kind = gfc_default_real_kind;
614 }
615 else if (flag_real8_kindglobal_options.x_flag_real8_kind == 4)
616 {
617 if (!saw_r4)
618 gfc_fatal_error ("REAL(KIND=4) is not available for "
619 "%<-freal-8-real-4%> option");
620
621 gfc_default_double_kind = 4;
622 }
623 else if (flag_real8_kindglobal_options.x_flag_real8_kind == 10 )
624 {
625 if (!saw_r10)
626 gfc_fatal_error ("REAL(KIND=10) is not available for "
627 "%<-freal-8-real-10%> option");
628
629 gfc_default_double_kind = 10;
630 }
631 else if (flag_real8_kindglobal_options.x_flag_real8_kind == 16 )
632 {
633 if (!saw_r16)
634 gfc_fatal_error ("REAL(KIND=10) is not available for "
635 "%<-freal-8-real-16%> option");
636
637 gfc_default_double_kind = 16;
638 }
639 else if (saw_r4 && saw_r8)
640 gfc_default_double_kind = 8;
641 else
642 {
643 /* F95 14.6.3.1: A nonpointer scalar object of type double precision
644 real ... occupies two contiguous numeric storage units.
645
646 Therefore we must be supplied a kind twice as large as we chose
647 for single precision. There are loopholes, in that double
648 precision must *occupy* two storage units, though it doesn't have
649 to *use* two storage units. Which means that you can make this
650 kind artificially wide by padding it. But at present there are
651 no GCC targets for which a two-word type does not exist, so we
652 just let gfc_validate_kind abort and tell us if something breaks. */
653
654 gfc_default_double_kind
655 = gfc_validate_kind (BT_REAL, gfc_default_real_kind * 2, false);
656 }
657
658 /* The default logical kind is constrained to be the same as the
659 default integer kind. Similarly with complex and real. */
660 gfc_default_logical_kind = gfc_default_integer_kind;
661 gfc_default_complex_kind = gfc_default_real_kind;
662
663 /* We only have two character kinds: ASCII and UCS-4.
664 ASCII corresponds to a 8-bit integer type, if one is available.
665 UCS-4 corresponds to a 32-bit integer type, if one is available. */
666 i_index = 0;
667 if ((kind = get_int_kind_from_width (8)) > 0)
668 {
669 gfc_character_kinds[i_index].kind = kind;
670 gfc_character_kinds[i_index].bit_size = 8;
671 gfc_character_kinds[i_index].name = "ascii";
672 i_index++;
673 }
674 if ((kind = get_int_kind_from_width (32)) > 0)
675 {
676 gfc_character_kinds[i_index].kind = kind;
677 gfc_character_kinds[i_index].bit_size = 32;
678 gfc_character_kinds[i_index].name = "iso_10646";
679 i_index++;
680 }
681
682 /* Choose the smallest integer kind for our default character. */
683 gfc_default_character_kind = gfc_character_kinds[0].kind;
684 gfc_character_storage_size = gfc_default_character_kind * 8;
685
686 gfc_index_integer_kind = get_int_kind_from_name (PTRDIFF_TYPE(((global_options.x_ix86_isa_flags & (1UL << 4)) !=
0) ? "long int" : "int")
);
687
688 /* Pick a kind the same size as the C "int" type. */
689 gfc_c_int_kind = INT_TYPE_SIZE32 / 8;
690
691 /* Choose atomic kinds to match C's int. */
692 gfc_atomic_int_kind = gfc_c_int_kind;
693 gfc_atomic_logical_kind = gfc_c_int_kind;
694}
695
696
697/* Make sure that a valid kind is present. Returns an index into the
698 associated kinds array, -1 if the kind is not present. */
699
700static int
701validate_integer (int kind)
702{
703 int i;
704
705 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
706 if (gfc_integer_kinds[i].kind == kind)
707 return i;
708
709 return -1;
710}
711
712static int
713validate_real (int kind)
714{
715 int i;
716
717 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
718 if (gfc_real_kinds[i].kind == kind)
719 return i;
720
721 return -1;
722}
723
724static int
725validate_logical (int kind)
726{
727 int i;
728
729 for (i = 0; gfc_logical_kinds[i].kind; i++)
730 if (gfc_logical_kinds[i].kind == kind)
731 return i;
732
733 return -1;
734}
735
736static int
737validate_character (int kind)
738{
739 int i;
740
741 for (i = 0; gfc_character_kinds[i].kind; i++)
742 if (gfc_character_kinds[i].kind == kind)
743 return i;
744
745 return -1;
746}
747
748/* Validate a kind given a basic type. The return value is the same
749 for the child functions, with -1 indicating nonexistence of the
750 type. If MAY_FAIL is false, then -1 is never returned, and we ICE. */
751
752int
753gfc_validate_kind (bt type, int kind, bool may_fail)
754{
755 int rc;
756
757 switch (type)
758 {
759 case BT_REAL: /* Fall through */
760 case BT_COMPLEX:
761 rc = validate_real (kind);
762 break;
763 case BT_INTEGER:
764 rc = validate_integer (kind);
765 break;
766 case BT_LOGICAL:
767 rc = validate_logical (kind);
768 break;
769 case BT_CHARACTER:
770 rc = validate_character (kind);
771 break;
772
773 default:
774 gfc_internal_error ("gfc_validate_kind(): Got bad type");
775 }
776
777 if (rc < 0 && !may_fail)
778 gfc_internal_error ("gfc_validate_kind(): Got bad kind");
779
780 return rc;
781}
782
783
784/* Four subroutines of gfc_init_types. Create type nodes for the given kind.
785 Reuse common type nodes where possible. Recognize if the kind matches up
786 with a C type. This will be used later in determining which routines may
787 be scarfed from libm. */
788
789static tree
790gfc_build_int_type (gfc_integer_info *info)
791{
792 int mode_precision = info->bit_size;
793
794 if (mode_precision == CHAR_TYPE_SIZE(8))
795 info->c_char = 1;
796 if (mode_precision == SHORT_TYPE_SIZE16)
797 info->c_short = 1;
798 if (mode_precision == INT_TYPE_SIZE32)
799 info->c_int = 1;
800 if (mode_precision == LONG_TYPE_SIZE(((global_options.x_ix86_isa_flags & (1UL << 58)) !=
0) ? 32 : ((8) * (((global_options.x_ix86_isa_flags & (1UL
<< 1)) != 0) ? 8 : 4)))
)
801 info->c_long = 1;
802 if (mode_precision == LONG_LONG_TYPE_SIZE64)
803 info->c_long_long = 1;
804
805 if (TYPE_PRECISION (intQI_type_node)((tree_class_check ((global_trees[TI_INTQI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 805, __FUNCTION__))->type_common.precision)
== mode_precision)
806 return intQI_type_nodeglobal_trees[TI_INTQI_TYPE];
807 if (TYPE_PRECISION (intHI_type_node)((tree_class_check ((global_trees[TI_INTHI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 807, __FUNCTION__))->type_common.precision)
== mode_precision)
808 return intHI_type_nodeglobal_trees[TI_INTHI_TYPE];
809 if (TYPE_PRECISION (intSI_type_node)((tree_class_check ((global_trees[TI_INTSI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 809, __FUNCTION__))->type_common.precision)
== mode_precision)
810 return intSI_type_nodeglobal_trees[TI_INTSI_TYPE];
811 if (TYPE_PRECISION (intDI_type_node)((tree_class_check ((global_trees[TI_INTDI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 811, __FUNCTION__))->type_common.precision)
== mode_precision)
812 return intDI_type_nodeglobal_trees[TI_INTDI_TYPE];
813 if (TYPE_PRECISION (intTI_type_node)((tree_class_check ((global_trees[TI_INTTI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 813, __FUNCTION__))->type_common.precision)
== mode_precision)
814 return intTI_type_nodeglobal_trees[TI_INTTI_TYPE];
815
816 return make_signed_type (mode_precision);
817}
818
819tree
820gfc_build_uint_type (int size)
821{
822 if (size == CHAR_TYPE_SIZE(8))
823 return unsigned_char_type_nodeinteger_types[itk_unsigned_char];
824 if (size == SHORT_TYPE_SIZE16)
825 return short_unsigned_type_nodeinteger_types[itk_unsigned_short];
826 if (size == INT_TYPE_SIZE32)
827 return unsigned_type_nodeinteger_types[itk_unsigned_int];
828 if (size == LONG_TYPE_SIZE(((global_options.x_ix86_isa_flags & (1UL << 58)) !=
0) ? 32 : ((8) * (((global_options.x_ix86_isa_flags & (1UL
<< 1)) != 0) ? 8 : 4)))
)
829 return long_unsigned_type_nodeinteger_types[itk_unsigned_long];
830 if (size == LONG_LONG_TYPE_SIZE64)
831 return long_long_unsigned_type_nodeinteger_types[itk_unsigned_long_long];
832
833 return make_unsigned_type (size);
834}
835
836
837static tree
838gfc_build_real_type (gfc_real_info *info)
839{
840 int mode_precision = info->mode_precision;
841 tree new_type;
842
843 if (mode_precision == FLOAT_TYPE_SIZE32)
844 info->c_float = 1;
845 if (mode_precision == DOUBLE_TYPE_SIZE64)
846 info->c_double = 1;
847 if (mode_precision == LONG_DOUBLE_TYPE_SIZE(((global_options.x_target_flags & (1U << 17)) != 0
) ? 64 : (((global_options.x_target_flags & (1U << 16
)) != 0) ? 128 : 80))
)
848 info->c_long_double = 1;
849 if (mode_precision != LONG_DOUBLE_TYPE_SIZE(((global_options.x_target_flags & (1U << 17)) != 0
) ? 64 : (((global_options.x_target_flags & (1U << 16
)) != 0) ? 128 : 80))
&& mode_precision == 128)
850 {
851 info->c_float128 = 1;
852 gfc_real16_is_float128 = true;
853 }
854
855 if (TYPE_PRECISION (float_type_node)((tree_class_check ((global_trees[TI_FLOAT_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 855, __FUNCTION__))->type_common.precision)
== mode_precision)
856 return float_type_nodeglobal_trees[TI_FLOAT_TYPE];
857 if (TYPE_PRECISION (double_type_node)((tree_class_check ((global_trees[TI_DOUBLE_TYPE]), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 857, __FUNCTION__))->type_common.precision)
== mode_precision)
858 return double_type_nodeglobal_trees[TI_DOUBLE_TYPE];
859 if (TYPE_PRECISION (long_double_type_node)((tree_class_check ((global_trees[TI_LONG_DOUBLE_TYPE]), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 859, __FUNCTION__))->type_common.precision)
== mode_precision)
860 return long_double_type_nodeglobal_trees[TI_LONG_DOUBLE_TYPE];
861
862 new_type = make_node (REAL_TYPE);
863 TYPE_PRECISION (new_type)((tree_class_check ((new_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 863, __FUNCTION__))->type_common.precision)
= mode_precision;
864 layout_type (new_type);
865 return new_type;
866}
867
868static tree
869gfc_build_complex_type (tree scalar_type)
870{
871 tree new_type;
872
873 if (scalar_type == NULL__null)
874 return NULL__null;
875 if (scalar_type == float_type_nodeglobal_trees[TI_FLOAT_TYPE])
876 return complex_float_type_nodeglobal_trees[TI_COMPLEX_FLOAT_TYPE];
877 if (scalar_type == double_type_nodeglobal_trees[TI_DOUBLE_TYPE])
878 return complex_double_type_nodeglobal_trees[TI_COMPLEX_DOUBLE_TYPE];
879 if (scalar_type == long_double_type_nodeglobal_trees[TI_LONG_DOUBLE_TYPE])
880 return complex_long_double_type_nodeglobal_trees[TI_COMPLEX_LONG_DOUBLE_TYPE];
881
882 new_type = make_node (COMPLEX_TYPE);
883 TREE_TYPE (new_type)((contains_struct_check ((new_type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 883, __FUNCTION__))->typed.type)
= scalar_type;
884 layout_type (new_type);
885 return new_type;
886}
887
888static tree
889gfc_build_logical_type (gfc_logical_info *info)
890{
891 int bit_size = info->bit_size;
892 tree new_type;
893
894 if (bit_size == BOOL_TYPE_SIZE(8))
895 {
896 info->c_bool = 1;
897 return boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE];
898 }
899
900 new_type = make_unsigned_type (bit_size);
901 TREE_SET_CODE (new_type, BOOLEAN_TYPE)((new_type)->base.code = (BOOLEAN_TYPE));
902 TYPE_MAX_VALUE (new_type)((tree_check5 ((new_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 902, __FUNCTION__, (INTEGER_TYPE), (ENUMERAL_TYPE), (BOOLEAN_TYPE
), (REAL_TYPE), (FIXED_POINT_TYPE)))->type_non_common.maxval
)
= build_int_cst (new_type, 1);
903 TYPE_PRECISION (new_type)((tree_class_check ((new_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 903, __FUNCTION__))->type_common.precision)
= 1;
904
905 return new_type;
906}
907
908
909/* Create the backend type nodes. We map them to their
910 equivalent C type, at least for now. We also give
911 names to the types here, and we push them in the
912 global binding level context.*/
913
914void
915gfc_init_types (void)
916{
917 char name_buf[26];
918 int index;
919 tree type;
920 unsigned n;
921
922 /* Create and name the types. */
923#define PUSH_TYPE(name, node) \
924 pushdecl (build_decl (input_location, \
925 TYPE_DECL, get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
, node))
926
927 for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
928 {
929 type = gfc_build_int_type (&gfc_integer_kinds[index]);
930 /* Ensure integer(kind=1) doesn't have TYPE_STRING_FLAG set. */
931 if (TYPE_STRING_FLAG (type)((tree_check2 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 931, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common
.string_flag)
)
932 type = make_signed_type (gfc_integer_kinds[index].bit_size);
933 gfc_integer_types[index] = type;
934 snprintf (name_buf, sizeof(name_buf), "integer(kind=%d)",
935 gfc_integer_kinds[index].kind);
936 PUSH_TYPE (name_buf, type);
937 }
938
939 for (index = 0; gfc_logical_kinds[index].kind != 0; ++index)
940 {
941 type = gfc_build_logical_type (&gfc_logical_kinds[index]);
942 gfc_logical_types[index] = type;
943 snprintf (name_buf, sizeof(name_buf), "logical(kind=%d)",
944 gfc_logical_kinds[index].kind);
945 PUSH_TYPE (name_buf, type);
946 }
947
948 for (index = 0; gfc_real_kinds[index].kind != 0; index++)
949 {
950 type = gfc_build_real_type (&gfc_real_kinds[index]);
951 gfc_real_types[index] = type;
952 snprintf (name_buf, sizeof(name_buf), "real(kind=%d)",
953 gfc_real_kinds[index].kind);
954 PUSH_TYPE (name_buf, type);
955
956 if (gfc_real_kinds[index].c_float128)
957 gfc_float128_type_node = type;
958
959 type = gfc_build_complex_type (type);
960 gfc_complex_types[index] = type;
961 snprintf (name_buf, sizeof(name_buf), "complex(kind=%d)",
962 gfc_real_kinds[index].kind);
963 PUSH_TYPE (name_buf, type);
964
965 if (gfc_real_kinds[index].c_float128)
966 gfc_complex_float128_type_node = type;
967 }
968
969 for (index = 0; gfc_character_kinds[index].kind != 0; ++index)
970 {
971 type = gfc_build_uint_type (gfc_character_kinds[index].bit_size);
972 type = build_qualified_type (type, TYPE_UNQUALIFIED);
973 snprintf (name_buf, sizeof(name_buf), "character(kind=%d)",
974 gfc_character_kinds[index].kind);
975 PUSH_TYPE (name_buf, type);
976 gfc_character_types[index] = type;
977 gfc_pcharacter_types[index] = build_pointer_type (type);
978 }
979 gfc_character1_type_node = gfc_character_types[0];
980
981 PUSH_TYPE ("byte", unsigned_char_type_nodeinteger_types[itk_unsigned_char]);
982 PUSH_TYPE ("void", void_type_nodeglobal_trees[TI_VOID_TYPE]);
983
984 /* DBX debugging output gets upset if these aren't set. */
985 if (!TYPE_NAME (integer_type_node)((tree_class_check ((integer_types[itk_int]), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 985, __FUNCTION__))->type_common.name)
)
986 PUSH_TYPE ("c_integer", integer_type_nodeinteger_types[itk_int]);
987 if (!TYPE_NAME (char_type_node)((tree_class_check ((integer_types[itk_char]), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 987, __FUNCTION__))->type_common.name)
)
988 PUSH_TYPE ("c_char", char_type_nodeinteger_types[itk_char]);
989
990#undef PUSH_TYPE
991
992 pvoid_type_node = build_pointer_type (void_type_nodeglobal_trees[TI_VOID_TYPE]);
993 prvoid_type_node = build_qualified_type (pvoid_type_node, TYPE_QUAL_RESTRICT);
994 ppvoid_type_node = build_pointer_type (pvoid_type_node);
995 pchar_type_node = build_pointer_type (gfc_character1_type_node);
996 pfunc_type_node
997 = build_pointer_type (build_function_type_list (void_type_nodeglobal_trees[TI_VOID_TYPE], NULL_TREE(tree) __null));
998
999 gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
1000 /* We cannot use gfc_index_zero_node in definition of gfc_array_range_type,
1001 since this function is called before gfc_init_constants. */
1002 gfc_array_range_type
1003 = build_range_type (gfc_array_index_type,
1004 build_int_cst (gfc_array_index_type, 0),
1005 NULL_TREE(tree) __null);
1006
1007 /* The maximum array element size that can be handled is determined
1008 by the number of bits available to store this field in the array
1009 descriptor. */
1010
1011 n = TYPE_PRECISION (size_type_node)((tree_class_check ((global_trees[TI_SIZE_TYPE]), (tcc_type),
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1011, __FUNCTION__))->type_common.precision)
;
1012 gfc_max_array_element_size
1013 = wide_int_to_tree (size_type_nodeglobal_trees[TI_SIZE_TYPE],
1014 wi::mask (n, UNSIGNED,
1015 TYPE_PRECISION (size_type_node)((tree_class_check ((global_trees[TI_SIZE_TYPE]), (tcc_type),
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1015, __FUNCTION__))->type_common.precision)
));
1016
1017 logical_type_node = gfc_get_logical_type (gfc_default_logical_kind);
1018 logical_true_node = build_int_cst (logical_type_node, 1);
1019 logical_false_node = build_int_cst (logical_type_node, 0);
1020
1021 /* Character lengths are of type size_t, except signed. */
1022 gfc_charlen_int_kind = get_int_kind_from_node (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1023 gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind);
1024
1025 /* Fortran kind number of size_type_node (size_t). This is used for
1026 the _size member in vtables. */
1027 gfc_size_kind = get_int_kind_from_node (size_type_nodeglobal_trees[TI_SIZE_TYPE]);
1028}
1029
1030/* Get the type node for the given type and kind. */
1031
1032tree
1033gfc_get_int_type (int kind)
1034{
1035 int index = gfc_validate_kind (BT_INTEGER, kind, true);
1036 return index < 0 ? 0 : gfc_integer_types[index];
1037}
1038
1039tree
1040gfc_get_real_type (int kind)
1041{
1042 int index = gfc_validate_kind (BT_REAL, kind, true);
1043 return index < 0 ? 0 : gfc_real_types[index];
1044}
1045
1046tree
1047gfc_get_complex_type (int kind)
1048{
1049 int index = gfc_validate_kind (BT_COMPLEX, kind, true);
1050 return index < 0 ? 0 : gfc_complex_types[index];
1051}
1052
1053tree
1054gfc_get_logical_type (int kind)
1055{
1056 int index = gfc_validate_kind (BT_LOGICAL, kind, true);
1057 return index < 0 ? 0 : gfc_logical_types[index];
1058}
1059
1060tree
1061gfc_get_char_type (int kind)
1062{
1063 int index = gfc_validate_kind (BT_CHARACTER, kind, true);
1064 return index < 0 ? 0 : gfc_character_types[index];
1065}
1066
1067tree
1068gfc_get_pchar_type (int kind)
1069{
1070 int index = gfc_validate_kind (BT_CHARACTER, kind, true);
1071 return index < 0 ? 0 : gfc_pcharacter_types[index];
1072}
1073
1074
1075/* Create a character type with the given kind and length. */
1076
1077tree
1078gfc_get_character_type_len_for_eltype (tree eltype, tree len)
1079{
1080 tree bounds, type;
1081
1082 bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_nodegfc_rank_cst[1], len);
1083 type = build_array_type (eltype, bounds);
1084 TYPE_STRING_FLAG (type)((tree_check2 ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1084, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common
.string_flag)
= 1;
1085
1086 return type;
1087}
1088
1089tree
1090gfc_get_character_type_len (int kind, tree len)
1091{
1092 gfc_validate_kind (BT_CHARACTER, kind, false);
1093 return gfc_get_character_type_len_for_eltype (gfc_get_char_type (kind), len);
1094}
1095
1096
1097/* Get a type node for a character kind. */
1098
1099tree
1100gfc_get_character_type (int kind, gfc_charlen * cl)
1101{
1102 tree len;
1103
1104 len = (cl == NULL__null) ? NULL_TREE(tree) __null : cl->backend_decl;
1105 if (len && POINTER_TYPE_P (TREE_TYPE (len))(((enum tree_code) (((contains_struct_check ((len), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1105, __FUNCTION__))->typed.type))->base.code) == POINTER_TYPE
|| ((enum tree_code) (((contains_struct_check ((len), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1105, __FUNCTION__))->typed.type))->base.code) == REFERENCE_TYPE
)
)
1106 len = build_fold_indirect_ref (len)build_fold_indirect_ref_loc (((location_t) 0), len);
1107
1108 return gfc_get_character_type_len (kind, len);
1109}
1110
1111/* Convert a basic type. This will be an array for character types. */
1112
1113tree
1114gfc_typenode_for_spec (gfc_typespec * spec, int codim)
1115{
1116 tree basetype;
1117
1118 switch (spec->type)
1119 {
1120 case BT_UNKNOWN:
1121 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1121, __FUNCTION__))
;
1122
1123 case BT_INTEGER:
1124 /* We use INTEGER(c_intptr_t) for C_PTR and C_FUNPTR once the symbol
1125 has been resolved. This is done so we can convert C_PTR and
1126 C_FUNPTR to simple variables that get translated to (void *). */
1127 if (spec->f90_type == BT_VOID)
1128 {
1129 if (spec->u.derived
1130 && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)
1131 basetype = ptr_type_nodeglobal_trees[TI_PTR_TYPE];
1132 else
1133 basetype = pfunc_type_node;
1134 }
1135 else
1136 basetype = gfc_get_int_type (spec->kind);
1137 break;
1138
1139 case BT_REAL:
1140 basetype = gfc_get_real_type (spec->kind);
1141 break;
1142
1143 case BT_COMPLEX:
1144 basetype = gfc_get_complex_type (spec->kind);
1145 break;
1146
1147 case BT_LOGICAL:
1148 basetype = gfc_get_logical_type (spec->kind);
1149 break;
1150
1151 case BT_CHARACTER:
1152 basetype = gfc_get_character_type (spec->kind, spec->u.cl);
1153 break;
1154
1155 case BT_HOLLERITH:
1156 /* Since this cannot be used, return a length one character. */
1157 basetype = gfc_get_character_type_len (gfc_default_character_kind,
1158 gfc_index_one_nodegfc_rank_cst[1]);
1159 break;
1160
1161 case BT_UNION:
1162 basetype = gfc_get_union_type (spec->u.derived);
1163 break;
1164
1165 case BT_DERIVED:
1166 case BT_CLASS:
1167 basetype = gfc_get_derived_type (spec->u.derived, codim);
1168
1169 if (spec->type == BT_CLASS)
1170 GFC_CLASS_TYPE_P (basetype)((tree_class_check ((basetype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1170, __FUNCTION__))->type_common.lang_flag_4)
= 1;
1171
1172 /* If we're dealing with either C_PTR or C_FUNPTR, we modified the
1173 type and kind to fit a (void *) and the basetype returned was a
1174 ptr_type_node. We need to pass up this new information to the
1175 symbol that was declared of type C_PTR or C_FUNPTR. */
1176 if (spec->u.derived->ts.f90_type == BT_VOID)
1177 {
1178 spec->type = BT_INTEGER;
1179 spec->kind = gfc_index_integer_kind;
1180 spec->f90_type = BT_VOID;
1181 spec->is_c_interop = 1; /* Mark as escaping later. */
1182 }
1183 break;
1184 case BT_VOID:
1185 case BT_ASSUMED:
1186 /* This is for the second arg to c_f_pointer and c_f_procpointer
1187 of the iso_c_binding module, to accept any ptr type. */
1188 basetype = ptr_type_nodeglobal_trees[TI_PTR_TYPE];
1189 if (spec->f90_type == BT_VOID)
1190 {
1191 if (spec->u.derived
1192 && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)
1193 basetype = ptr_type_nodeglobal_trees[TI_PTR_TYPE];
1194 else
1195 basetype = pfunc_type_node;
1196 }
1197 break;
1198 case BT_PROCEDURE:
1199 basetype = pfunc_type_node;
1200 break;
1201 default:
1202 gcc_unreachable ()(fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1202, __FUNCTION__))
;
1203 }
1204 return basetype;
1205}
1206
1207/* Build an INT_CST for constant expressions, otherwise return NULL_TREE. */
1208
1209static tree
1210gfc_conv_array_bound (gfc_expr * expr)
1211{
1212 /* If expr is an integer constant, return that. */
1213 if (expr != NULL__null && expr->expr_type == EXPR_CONSTANT)
1214 return gfc_conv_mpz_to_tree (expr->value.integer, gfc_index_integer_kind);
1215
1216 /* Otherwise return NULL. */
1217 return NULL_TREE(tree) __null;
1218}
1219
1220/* Return the type of an element of the array. Note that scalar coarrays
1221 are special. In particular, for GFC_ARRAY_TYPE_P, the original argument
1222 (with POINTER_TYPE stripped) is returned. */
1223
1224tree
1225gfc_get_element_type (tree type)
1226{
1227 tree element;
1228
1229 if (GFC_ARRAY_TYPE_P (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1229, __FUNCTION__))->type_common.lang_flag_2)
)
1230 {
1231 if (TREE_CODE (type)((enum tree_code) (type)->base.code) == POINTER_TYPE)
1232 type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1232, __FUNCTION__))->typed.type)
;
1233 if (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-types.c"
, 1233, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
== 0)
1234 {
1235 gcc_assert (GFC_TYPE_ARRAY_CORANK (type) > 0)((void)(!((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1235, __FUNCTION__))->type_with_lang_specific.lang_specific
)->corank) > 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1235, __FUNCTION__), 0 : 0))
;
1236 element = type;
1237 }
1238 else
1239 {
1240 gcc_assert (TREE_CODE (type) == ARRAY_TYPE)((void)(!(((enum tree_code) (type)->base.code) == ARRAY_TYPE
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1240, __FUNCTION__), 0 : 0))
;
1241 element = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1241, __FUNCTION__))->typed.type)
;
1242 }
1243 }
1244 else
1245 {
1246 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type))((void)(!(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1246, __FUNCTION__))->type_common.lang_flag_1)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1246, __FUNCTION__), 0 : 0))
;
1247 element = 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-types.c"
, 1247, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
;
1248
1249 gcc_assert (TREE_CODE (element) == POINTER_TYPE)((void)(!(((enum tree_code) (element)->base.code) == POINTER_TYPE
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1249, __FUNCTION__), 0 : 0))
;
1250 element = TREE_TYPE (element)((contains_struct_check ((element), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1250, __FUNCTION__))->typed.type)
;
1251
1252 /* For arrays, which are not scalar coarrays. */
1253 if (TREE_CODE (element)((enum tree_code) (element)->base.code) == ARRAY_TYPE && !TYPE_STRING_FLAG (element)((tree_check2 ((element), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1253, __FUNCTION__, (ARRAY_TYPE), (INTEGER_TYPE)))->type_common
.string_flag)
)
1254 element = TREE_TYPE (element)((contains_struct_check ((element), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1254, __FUNCTION__))->typed.type)
;
1255 }
1256
1257 return element;
1258}
1259
1260/* Build an array. This function is called from gfc_sym_type().
1261 Actually returns array descriptor type.
1262
1263 Format of array descriptors is as follows:
1264
1265 struct gfc_array_descriptor
1266 {
1267 array *data;
1268 index offset;
1269 struct dtype_type dtype;
1270 struct descriptor_dimension dimension[N_DIM];
1271 }
1272
1273 struct dtype_type
1274 {
1275 size_t elem_len;
1276 int version;
1277 signed char rank;
1278 signed char type;
1279 signed short attribute;
1280 }
1281
1282 struct descriptor_dimension
1283 {
1284 index stride;
1285 index lbound;
1286 index ubound;
1287 }
1288
1289 Translation code should use gfc_conv_descriptor_* rather than
1290 accessing the descriptor directly. Any changes to the array
1291 descriptor type will require changes in gfc_conv_descriptor_* and
1292 gfc_build_array_initializer.
1293
1294 This is represented internally as a RECORD_TYPE. The index nodes
1295 are gfc_array_index_type and the data node is a pointer to the
1296 data. See below for the handling of character types.
1297
1298 I originally used nested ARRAY_TYPE nodes to represent arrays, but
1299 this generated poor code for assumed/deferred size arrays. These
1300 require use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part
1301 of the GENERIC grammar. Also, there is no way to explicitly set
1302 the array stride, so all data must be packed(1). I've tried to
1303 mark all the functions which would require modification with a GCC
1304 ARRAYS comment.
1305
1306 The data component points to the first element in the array. The
1307 offset field is the position of the origin of the array (i.e. element
1308 (0, 0 ...)). This may be outside the bounds of the array.
1309
1310 An element is accessed by
1311 data[offset + index0*stride0 + index1*stride1 + index2*stride2]
1312 This gives good performance as the computation does not involve the
1313 bounds of the array. For packed arrays, this is optimized further
1314 by substituting the known strides.
1315
1316 This system has one problem: all array bounds must be within 2^31
1317 elements of the origin (2^63 on 64-bit machines). For example
1318 integer, dimension (80000:90000, 80000:90000, 2) :: array
1319 may not work properly on 32-bit machines because 80000*80000 >
1320 2^31, so the calculation for stride2 would overflow. This may
1321 still work, but I haven't checked, and it relies on the overflow
1322 doing the right thing.
1323
1324 The way to fix this problem is to access elements as follows:
1325 data[(index0-lbound0)*stride0 + (index1-lbound1)*stride1]
1326 Obviously this is much slower. I will make this a compile time
1327 option, something like -fsmall-array-offsets. Mixing code compiled
1328 with and without this switch will work.
1329
1330 (1) This can be worked around by modifying the upper bound of the
1331 previous dimension. This requires extra fields in the descriptor
1332 (both real_ubound and fake_ubound). */
1333
1334
1335/* Returns true if the array sym does not require a descriptor. */
1336
1337int
1338gfc_is_nodesc_array (gfc_symbol * sym)
1339{
1340 symbol_attribute *array_attr;
1341 gfc_array_spec *as;
1342 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)
;
1343
1344 array_attr = is_classarray ? &CLASS_DATA (sym)sym->ts.u.derived->components->attr : &sym->attr;
1345 as = is_classarray ? CLASS_DATA (sym)sym->ts.u.derived->components->as : sym->as;
1346
1347 gcc_assert (array_attr->dimension || array_attr->codimension)((void)(!(array_attr->dimension || array_attr->codimension
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1347, __FUNCTION__), 0 : 0))
;
1348
1349 /* We only want local arrays. */
1350 if ((sym->ts.type != BT_CLASS && sym->attr.pointer)
1351 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)sym->ts.u.derived->components->attr.class_pointer)
1352 || array_attr->allocatable)
1353 return 0;
1354
1355 /* We want a descriptor for associate-name arrays that do not have an
1356 explicitly known shape already. */
1357 if (sym->assoc && as->type != AS_EXPLICIT)
1358 return 0;
1359
1360 /* The dummy is stored in sym and not in the component. */
1361 if (sym->attr.dummy)
1362 return as->type != AS_ASSUMED_SHAPE
1363 && as->type != AS_ASSUMED_RANK;
1364
1365 if (sym->attr.result || sym->attr.function)
1366 return 0;
1367
1368 gcc_assert (as->type == AS_EXPLICIT || as->cp_was_assumed)((void)(!(as->type == AS_EXPLICIT || as->cp_was_assumed
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1368, __FUNCTION__), 0 : 0))
;
1369
1370 return 1;
1371}
1372
1373
1374/* Create an array descriptor type. */
1375
1376static tree
1377gfc_build_array_type (tree type, gfc_array_spec * as,
1378 enum gfc_array_kind akind, bool restricted,
1379 bool contiguous, int codim)
1380{
1381 tree lbound[GFC_MAX_DIMENSIONS15];
1382 tree ubound[GFC_MAX_DIMENSIONS15];
1383 int n, corank;
1384
1385 /* Assumed-shape arrays do not have codimension information stored in the
1386 descriptor. */
1387 corank = MAX (as->corank, codim)((as->corank) > (codim) ? (as->corank) : (codim));
1388 if (as->type == AS_ASSUMED_SHAPE ||
1389 (as->type == AS_ASSUMED_RANK && akind == GFC_ARRAY_ALLOCATABLE))
1390 corank = codim;
1391
1392 if (as->type == AS_ASSUMED_RANK)
1393 for (n = 0; n < GFC_MAX_DIMENSIONS15; n++)
1394 {
1395 lbound[n] = NULL_TREE(tree) __null;
1396 ubound[n] = NULL_TREE(tree) __null;
1397 }
1398
1399 for (n = 0; n < as->rank; n++)
1400 {
1401 /* Create expressions for the known bounds of the array. */
1402 if (as->type == AS_ASSUMED_SHAPE && as->lower[n] == NULL__null)
1403 lbound[n] = gfc_index_one_nodegfc_rank_cst[1];
1404 else
1405 lbound[n] = gfc_conv_array_bound (as->lower[n]);
1406 ubound[n] = gfc_conv_array_bound (as->upper[n]);
1407 }
1408
1409 for (n = as->rank; n < as->rank + corank; n++)
1410 {
1411 if (as->type != AS_DEFERRED && as->lower[n] == NULL__null)
1412 lbound[n] = gfc_index_one_nodegfc_rank_cst[1];
1413 else
1414 lbound[n] = gfc_conv_array_bound (as->lower[n]);
1415
1416 if (n < as->rank + corank - 1)
1417 ubound[n] = gfc_conv_array_bound (as->upper[n]);
1418 }
1419
1420 if (as->type == AS_ASSUMED_SHAPE)
1421 akind = contiguous ? GFC_ARRAY_ASSUMED_SHAPE_CONT
1422 : GFC_ARRAY_ASSUMED_SHAPE;
1423 else if (as->type == AS_ASSUMED_RANK)
1424 akind = contiguous ? GFC_ARRAY_ASSUMED_RANK_CONT
1425 : GFC_ARRAY_ASSUMED_RANK;
1426 return gfc_get_array_type_bounds (type, as->rank == -1
1427 ? GFC_MAX_DIMENSIONS15 : as->rank,
1428 corank, lbound, ubound, 0, akind,
1429 restricted);
1430}
1431
1432/* Returns the struct descriptor_dimension type. */
1433
1434static tree
1435gfc_get_desc_dim_type (void)
1436{
1437 tree type;
1438 tree decl, *chain = NULL__null;
1439
1440 if (gfc_desc_dim_type)
1441 return gfc_desc_dim_type;
1442
1443 /* Build the type node. */
1444 type = make_node (RECORD_TYPE);
1445
1446 TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1446, __FUNCTION__))->type_common.name)
= get_identifier ("descriptor_dimension")(__builtin_constant_p ("descriptor_dimension") ? get_identifier_with_length
(("descriptor_dimension"), strlen ("descriptor_dimension")) :
get_identifier ("descriptor_dimension"))
;
1447 TYPE_PACKED (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1447, __FUNCTION__))->base.u.bits.packed_flag)
= 1;
1448
1449 /* Consists of the stride, lbound and ubound members. */
1450 decl = gfc_add_field_to_struct_1 (type,
1451 get_identifier ("stride")(__builtin_constant_p ("stride") ? get_identifier_with_length
(("stride"), strlen ("stride")) : get_identifier ("stride"))
,
1452 gfc_array_index_type, &chain);
1453 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1454
1455 decl = gfc_add_field_to_struct_1 (type,
1456 get_identifier ("lbound")(__builtin_constant_p ("lbound") ? get_identifier_with_length
(("lbound"), strlen ("lbound")) : get_identifier ("lbound"))
,
1457 gfc_array_index_type, &chain);
1458 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1459
1460 decl = gfc_add_field_to_struct_1 (type,
1461 get_identifier ("ubound")(__builtin_constant_p ("ubound") ? get_identifier_with_length
(("ubound"), strlen ("ubound")) : get_identifier ("ubound"))
,
1462 gfc_array_index_type, &chain);
1463 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1464
1465 /* Finish off the type. */
1466 gfc_finish_type (type);
1467 TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (type))((tree_check (((((contains_struct_check (((tree_class_check (
(type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1467, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1467, __FUNCTION__))->common.chain))), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1467, __FUNCTION__, (TYPE_DECL)))->decl_common.decl_flag_1
)
= 1;
1468
1469 gfc_desc_dim_type = type;
1470 return type;
1471}
1472
1473
1474/* Return the DTYPE for an array. This describes the type and type parameters
1475 of the array. */
1476/* TODO: Only call this when the value is actually used, and make all the
1477 unknown cases abort. */
1478
1479tree
1480gfc_get_dtype_rank_type (int rank, tree etype)
1481{
1482 tree size;
1483 int n;
1484 tree tmp;
1485 tree dtype;
1486 tree field;
1487 vec<constructor_elt, va_gc> *v = NULL__null;
1488
1489 size = TYPE_SIZE_UNIT (etype)((tree_class_check ((etype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1489, __FUNCTION__))->type_common.size_unit)
;
1490
1491 switch (TREE_CODE (etype)((enum tree_code) (etype)->base.code))
1492 {
1493 case INTEGER_TYPE:
1494 n = BT_INTEGER;
1495 break;
1496
1497 case BOOLEAN_TYPE:
1498 n = BT_LOGICAL;
1499 break;
1500
1501 case REAL_TYPE:
1502 n = BT_REAL;
1503 break;
1504
1505 case COMPLEX_TYPE:
1506 n = BT_COMPLEX;
1507 break;
1508
1509 case RECORD_TYPE:
1510 if (GFC_CLASS_TYPE_P (etype)((tree_class_check ((etype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1510, __FUNCTION__))->type_common.lang_flag_4)
)
1511 n = BT_CLASS;
1512 else
1513 n = BT_DERIVED;
1514 break;
1515
1516 /* We will never have arrays of arrays. */
1517 case ARRAY_TYPE:
1518 n = BT_CHARACTER;
1519 if (size == NULL_TREE(tree) __null)
1520 size = TYPE_SIZE_UNIT (TREE_TYPE (etype))((tree_class_check ((((contains_struct_check ((etype), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1520, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1520, __FUNCTION__))->type_common.size_unit)
;
1521 break;
1522
1523 case POINTER_TYPE:
1524 n = BT_ASSUMED;
1525 if (TREE_CODE (TREE_TYPE (etype))((enum tree_code) (((contains_struct_check ((etype), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1525, __FUNCTION__))->typed.type))->base.code)
!= VOID_TYPE)
1526 size = TYPE_SIZE_UNIT (TREE_TYPE (etype))((tree_class_check ((((contains_struct_check ((etype), (TS_TYPED
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1526, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1526, __FUNCTION__))->type_common.size_unit)
;
1527 else
1528 size = build_int_cst (size_type_nodeglobal_trees[TI_SIZE_TYPE], 0);
1529 break;
1530
1531 default:
1532 /* TODO: Don't do dtype for temporary descriptorless arrays. */
1533 /* We can encounter strange array types for temporary arrays. */
1534 return gfc_index_zero_nodegfc_rank_cst[0];
1535 }
1536
1537 tmp = get_dtype_type_node ();
1538 field = gfc_advance_chain (TYPE_FIELDS (tmp)((tree_check3 ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1538, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
,
1539 GFC_DTYPE_ELEM_LEN0);
1540 CONSTRUCTOR_APPEND_ELT (v, field,do { constructor_elt _ce___ = {field, fold_convert_loc (((location_t
) 0), ((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1541, __FUNCTION__))->typed.type), size)}; vec_safe_push
((v), _ce___); } while (0)
1541 fold_convert (TREE_TYPE (field), size))do { constructor_elt _ce___ = {field, fold_convert_loc (((location_t
) 0), ((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1541, __FUNCTION__))->typed.type), size)}; vec_safe_push
((v), _ce___); } while (0)
;
1542
1543 field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node)((tree_check3 ((dtype_type_node), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1543, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
,
1544 GFC_DTYPE_RANK2);
1545 CONSTRUCTOR_APPEND_ELT (v, field,do { constructor_elt _ce___ = {field, build_int_cst (((contains_struct_check
((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1546, __FUNCTION__))->typed.type), rank)}; vec_safe_push
((v), _ce___); } while (0)
1546 build_int_cst (TREE_TYPE (field), rank))do { constructor_elt _ce___ = {field, build_int_cst (((contains_struct_check
((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1546, __FUNCTION__))->typed.type), rank)}; vec_safe_push
((v), _ce___); } while (0)
;
1547
1548 field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node)((tree_check3 ((dtype_type_node), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1548, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
,
1549 GFC_DTYPE_TYPE3);
1550 CONSTRUCTOR_APPEND_ELT (v, field,do { constructor_elt _ce___ = {field, build_int_cst (((contains_struct_check
((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1551, __FUNCTION__))->typed.type), n)}; vec_safe_push ((
v), _ce___); } while (0)
1551 build_int_cst (TREE_TYPE (field), n))do { constructor_elt _ce___ = {field, build_int_cst (((contains_struct_check
((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1551, __FUNCTION__))->typed.type), n)}; vec_safe_push ((
v), _ce___); } while (0)
;
1552
1553 dtype = build_constructor (tmp, v);
1554
1555 return dtype;
1556}
1557
1558
1559tree
1560gfc_get_dtype (tree type)
1561{
1562 tree dtype;
1563 tree etype;
1564 int rank;
1565
1566 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || 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-types.c"
, 1566, __FUNCTION__))->type_common.lang_flag_1) || ((tree_class_check
((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1566, __FUNCTION__))->type_common.lang_flag_2)) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1566, __FUNCTION__), 0 : 0))
;
1567
1568 rank = 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-types.c"
, 1568, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
;
1569 etype = gfc_get_element_type (type);
1570 dtype = gfc_get_dtype_rank_type (rank, etype);
1571
1572 GFC_TYPE_ARRAY_DTYPE (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1572, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dtype)
= dtype;
1573 return dtype;
1574}
1575
1576
1577/* Build an array type for use without a descriptor, packed according
1578 to the value of PACKED. */
1579
1580tree
1581gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
1582 bool restricted)
1583{
1584 tree range;
1585 tree type;
1586 tree tmp;
1587 int n;
1588 int known_stride;
1589 int known_offset;
1590 mpz_t offset;
1591 mpz_t stride;
1592 mpz_t delta;
1593 gfc_expr *expr;
1594
1595 mpz_init_set_ui__gmpz_init_set_ui (offset, 0);
1596 mpz_init_set_ui__gmpz_init_set_ui (stride, 1);
1597 mpz_init__gmpz_init (delta);
1598
1599 /* We don't use build_array_type because this does not include
1600 lang-specific information (i.e. the bounds of the array) when checking
1601 for duplicates. */
1602 if (as->rank)
1603 type = make_node (ARRAY_TYPE);
1604 else
1605 type = build_variant_type_copy (etype);
1606
1607 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-types.c"
, 1607, __FUNCTION__))->type_common.lang_flag_2)
= 1;
1608 TYPE_LANG_SPECIFIC (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1608, __FUNCTION__))->type_with_lang_specific.lang_specific
)
= ggc_cleared_alloc<struct lang_type> ();
1609
1610 known_stride = (packed != PACKED_NO);
1611 known_offset = 1;
1612 for (n = 0; n < as->rank; n++)
1613 {
1614 /* Fill in the stride and bound components of the type. */
1615 if (known_stride)
1616 tmp = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
1617 else
1618 tmp = NULL_TREE(tree) __null;
1619 GFC_TYPE_ARRAY_STRIDE (type, n)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1619, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[n])
= tmp;
1620
1621 expr = as->lower[n];
1622 if (expr->expr_type == EXPR_CONSTANT)
1623 {
1624 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
1625 gfc_index_integer_kind);
1626 }
1627 else
1628 {
1629 known_stride = 0;
1630 tmp = NULL_TREE(tree) __null;
1631 }
1632 GFC_TYPE_ARRAY_LBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1632, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[n])
= tmp;
1633
1634 if (known_stride)
1635 {
1636 /* Calculate the offset. */
1637 mpz_mul__gmpz_mul (delta, stride, as->lower[n]->value.integer);
1638 mpz_sub__gmpz_sub (offset, offset, delta);
1639 }
1640 else
1641 known_offset = 0;
1642
1643 expr = as->upper[n];
1644 if (expr && expr->expr_type == EXPR_CONSTANT)
1645 {
1646 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
1647 gfc_index_integer_kind);
1648 }
1649 else
1650 {
1651 tmp = NULL_TREE(tree) __null;
1652 known_stride = 0;
1653 }
1654 GFC_TYPE_ARRAY_UBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1654, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[n])
= tmp;
1655
1656 if (known_stride)
1657 {
1658 /* Calculate the stride. */
1659 mpz_sub__gmpz_sub (delta, as->upper[n]->value.integer,
1660 as->lower[n]->value.integer);
1661 mpz_add_ui__gmpz_add_ui (delta, delta, 1);
1662 mpz_mul__gmpz_mul (stride, stride, delta);
1663 }
1664
1665 /* Only the first stride is known for partial packed arrays. */
1666 if (packed == PACKED_NO || packed == PACKED_PARTIAL)
1667 known_stride = 0;
1668 }
1669 for (n = as->rank; n < as->rank + as->corank; n++)
1670 {
1671 expr = as->lower[n];
1672 if (expr->expr_type == EXPR_CONSTANT)
1673 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
1674 gfc_index_integer_kind);
1675 else
1676 tmp = NULL_TREE(tree) __null;
1677 GFC_TYPE_ARRAY_LBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1677, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[n])
= tmp;
1678
1679 expr = as->upper[n];
1680 if (expr && expr->expr_type == EXPR_CONSTANT)
1681 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
1682 gfc_index_integer_kind);
1683 else
1684 tmp = NULL_TREE(tree) __null;
1685 if (n < as->rank + as->corank - 1)
1686 GFC_TYPE_ARRAY_UBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1686, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[n])
= tmp;
1687 }
1688
1689 if (known_offset)
1690 {
1691 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-types.c"
, 1691, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
=
1692 gfc_conv_mpz_to_tree (offset, gfc_index_integer_kind);
1693 }
1694 else
1695 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-types.c"
, 1695, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
= NULL_TREE(tree) __null;
1696
1697 if (known_stride)
1698 {
1699 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-types.c"
, 1699, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size)
=
1700 gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
1701 }
1702 else
1703 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-types.c"
, 1703, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size)
= NULL_TREE(tree) __null;
1704
1705 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-types.c"
, 1705, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
= as->rank;
1706 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-types.c"
, 1706, __FUNCTION__))->type_with_lang_specific.lang_specific
)->corank)
= as->corank;
1707 GFC_TYPE_ARRAY_DTYPE (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1707, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dtype)
= NULL_TREE(tree) __null;
1708 range = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
1709 NULL_TREE(tree) __null);
1710 /* TODO: use main type if it is unbounded. */
1711 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-types.c"
, 1711, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
=
1712 build_pointer_type (build_array_type (etype, range));
1713 if (restricted)
1714 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-types.c"
, 1714, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
=
1715 build_qualified_type (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-types.c"
, 1715, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
,
1716 TYPE_QUAL_RESTRICT);
1717
1718 if (as->rank == 0)
1719 {
1720 if (packed != PACKED_STATIC || flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1721 {
1722 type = build_pointer_type (type);
1723
1724 if (restricted)
1725 type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
1726
1727 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-types.c"
, 1727, __FUNCTION__))->type_common.lang_flag_2)
= 1;
1728 TYPE_LANG_SPECIFIC (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1728, __FUNCTION__))->type_with_lang_specific.lang_specific
)
= TYPE_LANG_SPECIFIC (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-types.c"
, 1728, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1728, __FUNCTION__))->type_with_lang_specific.lang_specific
)
;
1729 }
1730
1731 return type;
1732 }
1733
1734 if (known_stride)
1735 {
1736 mpz_sub_ui__gmpz_sub_ui (stride, stride, 1);
1737 range = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
1738 }
1739 else
1740 range = NULL_TREE(tree) __null;
1741
1742 range = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0], range);
1743 TYPE_DOMAIN (type)((tree_check ((type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1743, __FUNCTION__, (ARRAY_TYPE)))->type_non_common.values
)
= range;
1744
1745 build_pointer_type (etype);
1746 TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1746, __FUNCTION__))->typed.type)
= etype;
1747
1748 layout_type (type);
1749
1750 mpz_clear__gmpz_clear (offset);
1751 mpz_clear__gmpz_clear (stride);
1752 mpz_clear__gmpz_clear (delta);
1753
1754 /* Represent packed arrays as multi-dimensional if they have rank >
1755 1 and with proper bounds, instead of flat arrays. This makes for
1756 better debug info. */
1757 if (known_offset)
1758 {
1759 tree gtype = etype, rtype, type_decl;
1760
1761 for (n = as->rank - 1; n >= 0; n--)
1762 {
1763 rtype = build_range_type (gfc_array_index_type,
1764 GFC_TYPE_ARRAY_LBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1764, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[n])
,
1765 GFC_TYPE_ARRAY_UBOUND (type, n)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1765, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[n])
);
1766 gtype = build_array_type (gtype, rtype);
1767 }
1768 TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1768, __FUNCTION__))->type_common.name)
= type_decl = build_decl (input_location,
1769 TYPE_DECL, NULL__null, gtype);
1770 DECL_ORIGINAL_TYPE (type_decl)((tree_check ((type_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1770, __FUNCTION__, (TYPE_DECL)))->decl_non_common.result
)
= gtype;
1771 }
1772
1773 if (packed != PACKED_STATIC || !known_stride
1774 || (as->corank && flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB))
1775 {
1776 /* For dummy arrays and automatic (heap allocated) arrays we
1777 want a pointer to the array. */
1778 type = build_pointer_type (type);
1779 if (restricted)
1780 type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
1781 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-types.c"
, 1781, __FUNCTION__))->type_common.lang_flag_2)
= 1;
1782 TYPE_LANG_SPECIFIC (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1782, __FUNCTION__))->type_with_lang_specific.lang_specific
)
= TYPE_LANG_SPECIFIC (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-types.c"
, 1782, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1782, __FUNCTION__))->type_with_lang_specific.lang_specific
)
;
1783 }
1784 return type;
1785}
1786
1787
1788/* Return or create the base type for an array descriptor. */
1789
1790static tree
1791gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
1792{
1793 tree fat_type, decl, arraytype, *chain = NULL__null;
1794 char name[16 + 2*GFC_RANK_DIGITS2 + 1 + 1];
1795 int idx;
1796
1797 /* Assumed-rank array. */
1798 if (dimen == -1)
1799 dimen = GFC_MAX_DIMENSIONS15;
1800
1801 idx = 2 * (codimen + dimen) + restricted;
1802
1803 gcc_assert (codimen + dimen >= 0 && codimen + dimen <= GFC_MAX_DIMENSIONS)((void)(!(codimen + dimen >= 0 && codimen + dimen <=
15) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1803, __FUNCTION__), 0 : 0))
;
1804
1805 if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB && codimen)
1806 {
1807 if (gfc_array_descriptor_base_caf[idx])
1808 return gfc_array_descriptor_base_caf[idx];
1809 }
1810 else if (gfc_array_descriptor_base[idx])
1811 return gfc_array_descriptor_base[idx];
1812
1813 /* Build the type node. */
1814 fat_type = make_node (RECORD_TYPE);
1815
1816 sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT"%02d", dimen + codimen);
1817 TYPE_NAME (fat_type)((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1817, __FUNCTION__))->type_common.name)
= get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
;
1818 TYPE_NAMELESS (fat_type)((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1818, __FUNCTION__))->base.u.bits.nameless_flag)
= 1;
1819
1820 /* Add the data member as the first element of the descriptor. */
1821 gfc_add_field_to_struct_1 (fat_type,
1822 get_identifier ("data")(__builtin_constant_p ("data") ? get_identifier_with_length (
("data"), strlen ("data")) : get_identifier ("data"))
,
1823 (restricted
1824 ? prvoid_type_node
1825 : ptr_type_nodeglobal_trees[TI_PTR_TYPE]), &chain);
1826
1827 /* Add the base component. */
1828 decl = gfc_add_field_to_struct_1 (fat_type,
1829 get_identifier ("offset")(__builtin_constant_p ("offset") ? get_identifier_with_length
(("offset"), strlen ("offset")) : get_identifier ("offset"))
,
1830 gfc_array_index_type, &chain);
1831 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1832
1833 /* Add the dtype component. */
1834 decl = gfc_add_field_to_struct_1 (fat_type,
1835 get_identifier ("dtype")(__builtin_constant_p ("dtype") ? get_identifier_with_length (
("dtype"), strlen ("dtype")) : get_identifier ("dtype"))
,
1836 get_dtype_type_node (), &chain);
1837 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1838
1839 /* Add the span component. */
1840 decl = gfc_add_field_to_struct_1 (fat_type,
1841 get_identifier ("span")(__builtin_constant_p ("span") ? get_identifier_with_length (
("span"), strlen ("span")) : get_identifier ("span"))
,
1842 gfc_array_index_type, &chain);
1843 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1844
1845 /* Build the array type for the stride and bound components. */
1846 if (dimen + codimen > 0)
1847 {
1848 arraytype =
1849 build_array_type (gfc_get_desc_dim_type (),
1850 build_range_type (gfc_array_index_type,
1851 gfc_index_zero_nodegfc_rank_cst[0],
1852 gfc_rank_cst[codimen + dimen - 1]));
1853
1854 decl = gfc_add_field_to_struct_1 (fat_type, get_identifier ("dim")(__builtin_constant_p ("dim") ? get_identifier_with_length ((
"dim"), strlen ("dim")) : get_identifier ("dim"))
,
1855 arraytype, &chain);
1856 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1857 }
1858
1859 if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB)
1860 {
1861 decl = gfc_add_field_to_struct_1 (fat_type,
1862 get_identifier ("token")(__builtin_constant_p ("token") ? get_identifier_with_length (
("token"), strlen ("token")) : get_identifier ("token"))
,
1863 prvoid_type_node, &chain);
1864 TREE_NO_WARNING (decl)((decl)->base.nowarning_flag) = 1;
1865 }
1866
1867 /* Finish off the type. */
1868 gfc_finish_type (fat_type);
1869 TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type))((tree_check (((((contains_struct_check (((tree_class_check (
(fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1869, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1869, __FUNCTION__))->common.chain))), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1869, __FUNCTION__, (TYPE_DECL)))->decl_common.decl_flag_1
)
= 1;
1870
1871 if (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB && codimen)
1872 gfc_array_descriptor_base_caf[idx] = fat_type;
1873 else
1874 gfc_array_descriptor_base[idx] = fat_type;
1875
1876 return fat_type;
1877}
1878
1879
1880/* Build an array (descriptor) type with given bounds. */
1881
1882tree
1883gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
1884 tree * ubound, int packed,
1885 enum gfc_array_kind akind, bool restricted)
1886{
1887 char name[8 + 2*GFC_RANK_DIGITS2 + 1 + GFC_MAX_SYMBOL_LEN63];
1888 tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype;
1889 const char *type_name;
1890 int n;
1891
1892 base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted);
1893 fat_type = build_distinct_type_copy (base_type);
1894 /* Unshare TYPE_FIELDs. */
1895 for (tree *tp = &TYPE_FIELDS (fat_type)((tree_check3 ((fat_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1895, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
; *tp; tp = &DECL_CHAIN (*tp)(((contains_struct_check (((contains_struct_check ((*tp), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1895, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1895, __FUNCTION__))->common.chain))
)
1896 {
1897 tree next = DECL_CHAIN (*tp)(((contains_struct_check (((contains_struct_check ((*tp), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1897, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1897, __FUNCTION__))->common.chain))
;
1898 *tp = copy_node (*tp);
1899 DECL_CONTEXT (*tp)((contains_struct_check ((*tp), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1899, __FUNCTION__))->decl_minimal.context)
= fat_type;
1900 DECL_CHAIN (*tp)(((contains_struct_check (((contains_struct_check ((*tp), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1900, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1900, __FUNCTION__))->common.chain))
= next;
1901 }
1902 /* Make sure that nontarget and target array type have the same canonical
1903 type (and same stub decl for debug info). */
1904 base_type = gfc_get_array_descriptor_base (dimen, codimen, false);
1905 TYPE_CANONICAL (fat_type)((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1905, __FUNCTION__))->type_common.canonical)
= base_type;
1906 TYPE_STUB_DECL (fat_type)(((contains_struct_check (((tree_class_check ((fat_type), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1906, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1906, __FUNCTION__))->common.chain))
= TYPE_STUB_DECL (base_type)(((contains_struct_check (((tree_class_check ((base_type), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1906, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1906, __FUNCTION__))->common.chain))
;
1907 /* Arrays of unknown type must alias with all array descriptors. */
1908 TYPE_TYPELESS_STORAGE (base_type)((tree_check4 ((base_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1908, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
), (ARRAY_TYPE)))->type_common.typeless_storage)
= 1;
1909 TYPE_TYPELESS_STORAGE (fat_type)((tree_check4 ((fat_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1909, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
), (ARRAY_TYPE)))->type_common.typeless_storage)
= 1;
1910 gcc_checking_assert (!get_alias_set (base_type) && !get_alias_set (fat_type))((void)(!(!get_alias_set (base_type) && !get_alias_set
(fat_type)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1910, __FUNCTION__), 0 : 0))
;
1911
1912 tmp = TYPE_NAME (etype)((tree_class_check ((etype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1912, __FUNCTION__))->type_common.name)
;
1913 if (tmp && TREE_CODE (tmp)((enum tree_code) (tmp)->base.code) == TYPE_DECL)
1914 tmp = DECL_NAME (tmp)((contains_struct_check ((tmp), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1914, __FUNCTION__))->decl_minimal.name)
;
1915 if (tmp)
1916 type_name = IDENTIFIER_POINTER (tmp)((const char *) (tree_check ((tmp), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1916, __FUNCTION__, (IDENTIFIER_NODE)))->identifier.id.str
)
;
1917 else
1918 type_name = "unknown";
1919 sprintf (name, "array" GFC_RANK_PRINTF_FORMAT"%02d" "_%.*s", dimen + codimen,
1920 GFC_MAX_SYMBOL_LEN63, type_name);
1921 TYPE_NAME (fat_type)((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1921, __FUNCTION__))->type_common.name)
= get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
;
1922 TYPE_NAMELESS (fat_type)((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1922, __FUNCTION__))->base.u.bits.nameless_flag)
= 1;
1923
1924 GFC_DESCRIPTOR_TYPE_P (fat_type)((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1924, __FUNCTION__))->type_common.lang_flag_1)
= 1;
1925 TYPE_LANG_SPECIFIC (fat_type)((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1925, __FUNCTION__))->type_with_lang_specific.lang_specific
)
= ggc_cleared_alloc<struct lang_type> ();
1926
1927 GFC_TYPE_ARRAY_RANK (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1927, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
= dimen;
1928 GFC_TYPE_ARRAY_CORANK (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1928, __FUNCTION__))->type_with_lang_specific.lang_specific
)->corank)
= codimen;
1929 GFC_TYPE_ARRAY_DTYPE (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1929, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dtype)
= NULL_TREE(tree) __null;
1930 GFC_TYPE_ARRAY_AKIND (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1930, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
= akind;
1931
1932 /* Build an array descriptor record type. */
1933 if (packed != 0)
1934 stride = gfc_index_one_nodegfc_rank_cst[1];
1935 else
1936 stride = NULL_TREE(tree) __null;
1937 for (n = 0; n < dimen + codimen; n++)
1938 {
1939 if (n < dimen)
1940 GFC_TYPE_ARRAY_STRIDE (fat_type, n)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1940, __FUNCTION__))->type_with_lang_specific.lang_specific
)->stride[n])
= stride;
1941
1942 if (lbound)
1943 lower = lbound[n];
1944 else
1945 lower = NULL_TREE(tree) __null;
1946
1947 if (lower != NULL_TREE(tree) __null)
1948 {
1949 if (INTEGER_CST_P (lower)(((enum tree_code) (lower)->base.code) == INTEGER_CST))
1950 GFC_TYPE_ARRAY_LBOUND (fat_type, n)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1950, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[n])
= lower;
1951 else
1952 lower = NULL_TREE(tree) __null;
1953 }
1954
1955 if (codimen && n == dimen + codimen - 1)
1956 break;
1957
1958 upper = ubound[n];
1959 if (upper != NULL_TREE(tree) __null)
1960 {
1961 if (INTEGER_CST_P (upper)(((enum tree_code) (upper)->base.code) == INTEGER_CST))
1962 GFC_TYPE_ARRAY_UBOUND (fat_type, n)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1962, __FUNCTION__))->type_with_lang_specific.lang_specific
)->ubound[n])
= upper;
1963 else
1964 upper = NULL_TREE(tree) __null;
1965 }
1966
1967 if (n >= dimen)
1968 continue;
1969
1970 if (upper != NULL_TREE(tree) __null && lower != NULL_TREE(tree) __null && stride != NULL_TREE(tree) __null)
1971 {
1972 tmp = fold_build2_loc (input_location, MINUS_EXPR,
1973 gfc_array_index_type, upper, lower);
1974 tmp = fold_build2_loc (input_location, PLUS_EXPR,
1975 gfc_array_index_type, tmp,
1976 gfc_index_one_nodegfc_rank_cst[1]);
1977 stride = fold_build2_loc (input_location, MULT_EXPR,
1978 gfc_array_index_type, tmp, stride);
1979 /* Check the folding worked. */
1980 gcc_assert (INTEGER_CST_P (stride))((void)(!((((enum tree_code) (stride)->base.code) == INTEGER_CST
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1980, __FUNCTION__), 0 : 0))
;
1981 }
1982 else
1983 stride = NULL_TREE(tree) __null;
1984 }
1985 GFC_TYPE_ARRAY_SIZE (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1985, __FUNCTION__))->type_with_lang_specific.lang_specific
)->size)
= stride;
1986
1987 /* TODO: known offsets for descriptors. */
1988 GFC_TYPE_ARRAY_OFFSET (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1988, __FUNCTION__))->type_with_lang_specific.lang_specific
)->offset)
= NULL_TREE(tree) __null;
1989
1990 if (dimen == 0)
1991 {
1992 arraytype = build_pointer_type (etype);
1993 if (restricted)
1994 arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
1995
1996 GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 1996, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
= arraytype;
1997 return fat_type;
1998 }
1999
2000 /* We define data as an array with the correct size if possible.
2001 Much better than doing pointer arithmetic. */
2002 if (stride)
2003 rtype = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
2004 int_const_binop (MINUS_EXPR, stride,
2005 build_int_cst (TREE_TYPE (stride)((contains_struct_check ((stride), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2005, __FUNCTION__))->typed.type)
, 1)));
2006 else
2007 rtype = gfc_array_range_type;
2008 arraytype = build_array_type (etype, rtype);
2009 arraytype = build_pointer_type (arraytype);
2010 if (restricted)
2011 arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
2012 GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type)(((tree_class_check ((fat_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2012, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
= arraytype;
2013
2014 /* This will generate the base declarations we need to emit debug
2015 information for this type. FIXME: there must be a better way to
2016 avoid divergence between compilations with and without debug
2017 information. */
2018 {
2019 struct array_descr_info info;
2020 gfc_get_array_descr_info (fat_type, &info);
2021 gfc_get_array_descr_info (build_pointer_type (fat_type), &info);
2022 }
2023
2024 return fat_type;
2025}
2026
2027/* Build a pointer type. This function is called from gfc_sym_type(). */
2028
2029static tree
2030gfc_build_pointer_type (gfc_symbol * sym, tree type)
2031{
2032 /* Array pointer types aren't actually pointers. */
2033 if (sym->attr.dimension)
2034 return type;
2035 else
2036 return build_pointer_type (type);
2037}
2038
2039static tree gfc_nonrestricted_type (tree t);
2040/* Given two record or union type nodes TO and FROM, ensure
2041 that all fields in FROM have a corresponding field in TO,
2042 their type being nonrestrict variants. This accepts a TO
2043 node that already has a prefix of the fields in FROM. */
2044static void
2045mirror_fields (tree to, tree from)
2046{
2047 tree fto, ffrom;
2048 tree *chain;
2049
2050 /* Forward to the end of TOs fields. */
2051 fto = TYPE_FIELDS (to)((tree_check3 ((to), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2051, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
;
2052 ffrom = TYPE_FIELDS (from)((tree_check3 ((from), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2052, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
;
2053 chain = &TYPE_FIELDS (to)((tree_check3 ((to), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2053, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
;
2054 while (fto)
2055 {
2056 gcc_assert (ffrom && DECL_NAME (fto) == DECL_NAME (ffrom))((void)(!(ffrom && ((contains_struct_check ((fto), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2056, __FUNCTION__))->decl_minimal.name) == ((contains_struct_check
((ffrom), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2056, __FUNCTION__))->decl_minimal.name)) ? fancy_abort (
"/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2056, __FUNCTION__), 0 : 0))
;
2057 chain = &DECL_CHAIN (fto)(((contains_struct_check (((contains_struct_check ((fto), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2057, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2057, __FUNCTION__))->common.chain))
;
2058 fto = DECL_CHAIN (fto)(((contains_struct_check (((contains_struct_check ((fto), (TS_DECL_MINIMAL
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2058, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2058, __FUNCTION__))->common.chain))
;
2059 ffrom = DECL_CHAIN (ffrom)(((contains_struct_check (((contains_struct_check ((ffrom), (
TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2059, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2059, __FUNCTION__))->common.chain))
;
2060 }
2061
2062 /* Now add all fields remaining in FROM (starting with ffrom). */
2063 for (; ffrom; ffrom = DECL_CHAIN (ffrom)(((contains_struct_check (((contains_struct_check ((ffrom), (
TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2063, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2063, __FUNCTION__))->common.chain))
)
2064 {
2065 tree newfield = copy_node (ffrom);
2066 DECL_CONTEXT (newfield)((contains_struct_check ((newfield), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2066, __FUNCTION__))->decl_minimal.context)
= to;
2067 /* The store to DECL_CHAIN might seem redundant with the
2068 stores to *chain, but not clearing it here would mean
2069 leaving a chain into the old fields. If ever
2070 our called functions would look at them confusion
2071 will arise. */
2072 DECL_CHAIN (newfield)(((contains_struct_check (((contains_struct_check ((newfield)
, (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2072, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2072, __FUNCTION__))->common.chain))
= NULL_TREE(tree) __null;
2073 *chain = newfield;
2074 chain = &DECL_CHAIN (newfield)(((contains_struct_check (((contains_struct_check ((newfield)
, (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2074, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2074, __FUNCTION__))->common.chain))
;
2075
2076 if (TREE_CODE (ffrom)((enum tree_code) (ffrom)->base.code) == FIELD_DECL)
2077 {
2078 tree elemtype = gfc_nonrestricted_type (TREE_TYPE (ffrom)((contains_struct_check ((ffrom), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2078, __FUNCTION__))->typed.type)
);
2079 TREE_TYPE (newfield)((contains_struct_check ((newfield), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2079, __FUNCTION__))->typed.type)
= elemtype;
2080 }
2081 }
2082 *chain = NULL_TREE(tree) __null;
2083}
2084
2085/* Given a type T, returns a different type of the same structure,
2086 except that all types it refers to (recursively) are always
2087 non-restrict qualified types. */
2088static tree
2089gfc_nonrestricted_type (tree t)
2090{
2091 tree ret = t;
2092
2093 /* If the type isn't laid out yet, don't copy it. If something
2094 needs it for real it should wait until the type got finished. */
2095 if (!TYPE_SIZE (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2095, __FUNCTION__))->type_common.size)
)
2096 return t;
2097
2098 if (!TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2098, __FUNCTION__))->type_with_lang_specific.lang_specific
)
)
2099 TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2099, __FUNCTION__))->type_with_lang_specific.lang_specific
)
= ggc_cleared_alloc<struct lang_type> ();
2100 /* If we're dealing with this very node already further up
2101 the call chain (recursion via pointers and struct members)
2102 we haven't yet determined if we really need a new type node.
2103 Assume we don't, return T itself. */
2104 if (TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2104, __FUNCTION__))->type_with_lang_specific.lang_specific
)
->nonrestricted_type == error_mark_nodeglobal_trees[TI_ERROR_MARK])
2105 return t;
2106
2107 /* If we have calculated this all already, just return it. */
2108 if (TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2108, __FUNCTION__))->type_with_lang_specific.lang_specific
)
->nonrestricted_type)
2109 return TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2109, __FUNCTION__))->type_with_lang_specific.lang_specific
)
->nonrestricted_type;
2110
2111 /* Mark this type. */
2112 TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2112, __FUNCTION__))->type_with_lang_specific.lang_specific
)
->nonrestricted_type = error_mark_nodeglobal_trees[TI_ERROR_MARK];
2113
2114 switch (TREE_CODE (t)((enum tree_code) (t)->base.code))
2115 {
2116 default:
2117 break;
2118
2119 case POINTER_TYPE:
2120 case REFERENCE_TYPE:
2121 {
2122 tree totype = gfc_nonrestricted_type (TREE_TYPE (t)((contains_struct_check ((t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2122, __FUNCTION__))->typed.type)
);
2123 if (totype == TREE_TYPE (t)((contains_struct_check ((t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2123, __FUNCTION__))->typed.type)
)
2124 ret = t;
2125 else if (TREE_CODE (t)((enum tree_code) (t)->base.code) == POINTER_TYPE)
2126 ret = build_pointer_type (totype);
2127 else
2128 ret = build_reference_type (totype);
2129 ret = build_qualified_type (ret,
2130 TYPE_QUALS (t)((int) ((((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2130, __FUNCTION__))->base.readonly_flag) * TYPE_QUAL_CONST
) | (((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2130, __FUNCTION__))->base.volatile_flag) * TYPE_QUAL_VOLATILE
) | (((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2130, __FUNCTION__))->base.u.bits.atomic_flag) * TYPE_QUAL_ATOMIC
) | (((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2130, __FUNCTION__))->type_common.restrict_flag) * TYPE_QUAL_RESTRICT
) | (((((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2130, __FUNCTION__))->base.u.bits.address_space) & 0xFF
) << 8))))
& ~TYPE_QUAL_RESTRICT);
2131 }
2132 break;
2133
2134 case ARRAY_TYPE:
2135 {
2136 tree elemtype = gfc_nonrestricted_type (TREE_TYPE (t)((contains_struct_check ((t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2136, __FUNCTION__))->typed.type)
);
2137 if (elemtype == TREE_TYPE (t)((contains_struct_check ((t), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2137, __FUNCTION__))->typed.type)
)
2138 ret = t;
2139 else
2140 {
2141 ret = build_variant_type_copy (t);
2142 TREE_TYPE (ret)((contains_struct_check ((ret), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2142, __FUNCTION__))->typed.type)
= elemtype;
2143 if (TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2143, __FUNCTION__))->type_with_lang_specific.lang_specific
)
2144 && GFC_TYPE_ARRAY_DATAPTR_TYPE (t)(((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2144, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
)
2145 {
2146 tree dataptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (t)(((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2146, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
;
2147 dataptr_type = gfc_nonrestricted_type (dataptr_type);
2148 if (dataptr_type != GFC_TYPE_ARRAY_DATAPTR_TYPE (t)(((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2148, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
)
2149 {
2150 TYPE_LANG_SPECIFIC (ret)((tree_class_check ((ret), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2150, __FUNCTION__))->type_with_lang_specific.lang_specific
)
2151 = ggc_cleared_alloc<struct lang_type> ();
2152 *TYPE_LANG_SPECIFIC (ret)((tree_class_check ((ret), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2152, __FUNCTION__))->type_with_lang_specific.lang_specific
)
= *TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2152, __FUNCTION__))->type_with_lang_specific.lang_specific
)
;
2153 GFC_TYPE_ARRAY_DATAPTR_TYPE (ret)(((tree_class_check ((ret), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2153, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
= dataptr_type;
2154 }
2155 }
2156 }
2157 }
2158 break;
2159
2160 case RECORD_TYPE:
2161 case UNION_TYPE:
2162 case QUAL_UNION_TYPE:
2163 {
2164 tree field;
2165 /* First determine if we need a new type at all.
2166 Careful, the two calls to gfc_nonrestricted_type per field
2167 might return different values. That happens exactly when
2168 one of the fields reaches back to this very record type
2169 (via pointers). The first calls will assume that we don't
2170 need to copy T (see the error_mark_node marking). If there
2171 are any reasons for copying T apart from having to copy T,
2172 we'll indeed copy it, and the second calls to
2173 gfc_nonrestricted_type will use that new node if they
2174 reach back to T. */
2175 for (field = TYPE_FIELDS (t)((tree_check3 ((t), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2175, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
; 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-types.c"
, 2175, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2175, __FUNCTION__))->common.chain))
)
2176 if (TREE_CODE (field)((enum tree_code) (field)->base.code) == FIELD_DECL)
2177 {
2178 tree elemtype = gfc_nonrestricted_type (TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2178, __FUNCTION__))->typed.type)
);
2179 if (elemtype != TREE_TYPE (field)((contains_struct_check ((field), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2179, __FUNCTION__))->typed.type)
)
2180 break;
2181 }
2182 if (!field)
2183 break;
2184 ret = build_variant_type_copy (t);
2185 TYPE_FIELDS (ret)((tree_check3 ((ret), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2185, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
= NULL_TREE(tree) __null;
2186
2187 /* Here we make sure that as soon as we know we have to copy
2188 T, that also fields reaching back to us will use the new
2189 copy. It's okay if that copy still contains the old fields,
2190 we won't look at them. */
2191 TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2191, __FUNCTION__))->type_with_lang_specific.lang_specific
)
->nonrestricted_type = ret;
2192 mirror_fields (ret, t);
2193 }
2194 break;
2195 }
2196
2197 TYPE_LANG_SPECIFIC (t)((tree_class_check ((t), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2197, __FUNCTION__))->type_with_lang_specific.lang_specific
)
->nonrestricted_type = ret;
2198 return ret;
2199}
2200
2201
2202/* Return the type for a symbol. Special handling is required for character
2203 types to get the correct level of indirection.
2204 For functions return the return type.
2205 For subroutines return void_type_node.
2206 Calling this multiple times for the same symbol should be avoided,
2207 especially for character and array types. */
2208
2209tree
2210gfc_sym_type (gfc_symbol * sym)
2211{
2212 tree type;
2213 int byref;
2214 bool restricted;
2215
2216 /* Procedure Pointers inside COMMON blocks. */
2217 if (sym->attr.proc_pointer && sym->attr.in_common)
27
Assuming field 'proc_pointer' is not equal to 0
28
Assuming field 'in_common' is not equal to 0
29
Taking true branch
2218 {
2219 /* Unset proc_pointer as gfc_get_function_type calls gfc_sym_type. */
2220 sym->attr.proc_pointer = 0;
2221 type = build_pointer_type (gfc_get_function_type (sym));
30
Value assigned to field 'deferred', which participates in a condition later
2222 sym->attr.proc_pointer = 1;
2223 return type;
2224 }
2225
2226 if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function)
2227 return void_type_nodeglobal_trees[TI_VOID_TYPE];
2228
2229 /* In the case of a function the fake result variable may have a
2230 type different from the function type, so don't return early in
2231 that case. */
2232 if (sym->backend_decl && !sym->attr.function)
2233 return 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-types.c"
, 2233, __FUNCTION__))->typed.type)
;
2234
2235 if (sym->attr.result
2236 && sym->ts.type == BT_CHARACTER
2237 && sym->ts.u.cl->backend_decl == NULL_TREE(tree) __null
2238 && sym->ns->proc_name
2239 && sym->ns->proc_name->ts.u.cl
2240 && sym->ns->proc_name->ts.u.cl->backend_decl != NULL_TREE(tree) __null)
2241 sym->ts.u.cl->backend_decl = sym->ns->proc_name->ts.u.cl->backend_decl;
2242
2243 if (sym->ts.type == BT_CHARACTER
2244 && ((sym->attr.function && sym->attr.is_bind_c)
2245 || (sym->attr.result
2246 && sym->ns->proc_name
2247 && sym->ns->proc_name->attr.is_bind_c)
2248 || (sym->ts.deferred && (!sym->ts.u.cl
2249 || !sym->ts.u.cl->backend_decl))))
2250 type = gfc_character1_type_node;
2251 else
2252 type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension);
2253
2254 if (sym->attr.dummy && !sym->attr.function && !sym->attr.value
2255 && !sym->pass_as_value)
2256 byref = 1;
2257 else
2258 byref = 0;
2259
2260 restricted = !sym->attr.target && !sym->attr.pointer
2261 && !sym->attr.proc_pointer && !sym->attr.cray_pointee;
2262 if (!restricted)
2263 type = gfc_nonrestricted_type (type);
2264
2265 if (sym->attr.dimension || sym->attr.codimension)
2266 {
2267 if (gfc_is_nodesc_array (sym))
2268 {
2269 /* If this is a character argument of unknown length, just use the
2270 base type. */
2271 if (sym->ts.type != BT_CHARACTER
2272 || !(sym->attr.dummy || sym->attr.function)
2273 || sym->ts.u.cl->backend_decl)
2274 {
2275 type = gfc_get_nodesc_array_type (type, sym->as,
2276 byref ? PACKED_FULL
2277 : PACKED_STATIC,
2278 restricted);
2279 byref = 0;
2280 }
2281 }
2282 else
2283 {
2284 enum gfc_array_kind akind = GFC_ARRAY_UNKNOWN;
2285 if (sym->attr.pointer)
2286 akind = sym->attr.contiguous ? GFC_ARRAY_POINTER_CONT
2287 : GFC_ARRAY_POINTER;
2288 else if (sym->attr.allocatable)
2289 akind = GFC_ARRAY_ALLOCATABLE;
2290 type = gfc_build_array_type (type, sym->as, akind, restricted,
2291 sym->attr.contiguous, false);
2292 }
2293 }
2294 else
2295 {
2296 if (sym->attr.allocatable || sym->attr.pointer
2297 || gfc_is_associate_pointer (sym))
2298 type = gfc_build_pointer_type (sym, type);
2299 }
2300
2301 /* We currently pass all parameters by reference.
2302 See f95_get_function_decl. For dummy function parameters return the
2303 function type. */
2304 if (byref)
2305 {
2306 /* We must use pointer types for potentially absent variables. The
2307 optimizers assume a reference type argument is never NULL. */
2308 if (sym->attr.optional
2309 || (sym->ns->proc_name && sym->ns->proc_name->attr.entry_master))
2310 type = build_pointer_type (type);
2311 else
2312 {
2313 type = build_reference_type (type);
2314 if (restricted)
2315 type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
2316 }
2317 }
2318
2319 return (type);
2320}
2321
2322/* Layout and output debug info for a record type. */
2323
2324void
2325gfc_finish_type (tree type)
2326{
2327 tree decl;
2328
2329 decl = build_decl (input_location,
2330 TYPE_DECL, NULL_TREE(tree) __null, type);
2331 TYPE_STUB_DECL (type)(((contains_struct_check (((tree_class_check ((type), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2331, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2331, __FUNCTION__))->common.chain))
= decl;
2332 layout_type (type);
2333 rest_of_type_compilation (type, 1);
2334 rest_of_decl_compilation (decl, 1, 0);
2335}
2336
2337/* Add a field of given NAME and TYPE to the context of a UNION_TYPE
2338 or RECORD_TYPE pointed to by CONTEXT. The new field is chained
2339 to the end of the field list pointed to by *CHAIN.
2340
2341 Returns a pointer to the new field. */
2342
2343static tree
2344gfc_add_field_to_struct_1 (tree context, tree name, tree type, tree **chain)
2345{
2346 tree decl = build_decl (input_location, FIELD_DECL, name, type);
2347
2348 DECL_CONTEXT (decl)((contains_struct_check ((decl), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2348, __FUNCTION__))->decl_minimal.context)
= context;
2349 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-types.c"
, 2349, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2349, __FUNCTION__))->common.chain))
= NULL_TREE(tree) __null;
2350 if (TYPE_FIELDS (context)((tree_check3 ((context), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2350, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
== NULL_TREE(tree) __null)
2351 TYPE_FIELDS (context)((tree_check3 ((context), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2351, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
= decl;
2352 if (chain != NULL__null)
2353 {
2354 if (*chain != NULL__null)
2355 **chain = decl;
2356 *chain = &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-types.c"
, 2356, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2356, __FUNCTION__))->common.chain))
;
2357 }
2358
2359 return decl;
2360}
2361
2362/* Like `gfc_add_field_to_struct_1', but adds alignment
2363 information. */
2364
2365tree
2366gfc_add_field_to_struct (tree context, tree name, tree type, tree **chain)
2367{
2368 tree decl = gfc_add_field_to_struct_1 (context, name, type, chain);
2369
2370 DECL_INITIAL (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2370, __FUNCTION__))->decl_common.initial)
= 0;
2371 SET_DECL_ALIGN (decl, 0)(((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2371, __FUNCTION__))->decl_common.align) = ffs_hwi (0))
;
2372 DECL_USER_ALIGN (decl)((contains_struct_check ((decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2372, __FUNCTION__))->base.u.bits.user_align)
= 0;
2373
2374 return decl;
2375}
2376
2377
2378/* Copy the backend_decl and component backend_decls if
2379 the two derived type symbols are "equal", as described
2380 in 4.4.2 and resolved by gfc_compare_derived_types. */
2381
2382int
2383gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to,
2384 bool from_gsym)
2385{
2386 gfc_component *to_cm;
2387 gfc_component *from_cm;
2388
2389 if (from == to)
2390 return 1;
2391
2392 if (from->backend_decl == NULL__null
2393 || !gfc_compare_derived_types (from, to))
2394 return 0;
2395
2396 to->backend_decl = from->backend_decl;
2397
2398 to_cm = to->components;
2399 from_cm = from->components;
2400
2401 /* Copy the component declarations. If a component is itself
2402 a derived type, we need a copy of its component declarations.
2403 This is done by recursing into gfc_get_derived_type and
2404 ensures that the component's component declarations have
2405 been built. If it is a character, we need the character
2406 length, as well. */
2407 for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next)
2408 {
2409 to_cm->backend_decl = from_cm->backend_decl;
2410 to_cm->caf_token = from_cm->caf_token;
2411 if (from_cm->ts.type == BT_UNION)
2412 gfc_get_union_type (to_cm->ts.u.derived);
2413 else if (from_cm->ts.type == BT_DERIVED
2414 && (!from_cm->attr.pointer || from_gsym))
2415 gfc_get_derived_type (to_cm->ts.u.derived);
2416 else if (from_cm->ts.type == BT_CLASS
2417 && (!CLASS_DATA (from_cm)from_cm->ts.u.derived->components->attr.class_pointer || from_gsym))
2418 gfc_get_derived_type (to_cm->ts.u.derived);
2419 else if (from_cm->ts.type == BT_CHARACTER)
2420 to_cm->ts.u.cl->backend_decl = from_cm->ts.u.cl->backend_decl;
2421 }
2422
2423 return 1;
2424}
2425
2426
2427/* Build a tree node for a procedure pointer component. */
2428
2429tree
2430gfc_get_ppc_type (gfc_component* c)
2431{
2432 tree t;
2433
2434 /* Explicit interface. */
2435 if (c->attr.if_source != IFSRC_UNKNOWN && c->ts.interface)
2436 return build_pointer_type (gfc_get_function_type (c->ts.interface));
2437
2438 /* Implicit interface (only return value may be known). */
2439 if (c->attr.function && !c->attr.dimension && c->ts.type != BT_CHARACTER)
2440 t = gfc_typenode_for_spec (&c->ts);
2441 else
2442 t = void_type_nodeglobal_trees[TI_VOID_TYPE];
2443
2444 /* FIXME: it would be better to provide explicit interfaces in all
2445 cases, since they should be known by the compiler. */
2446 return build_pointer_type (build_function_type (t, NULL_TREE(tree) __null));
2447}
2448
2449
2450/* Build a tree node for a union type. Requires building each map
2451 structure which is an element of the union. */
2452
2453tree
2454gfc_get_union_type (gfc_symbol *un)
2455{
2456 gfc_component *map = NULL__null;
2457 tree typenode = NULL__null, map_type = NULL__null, map_field = NULL__null;
2458 tree *chain = NULL__null;
2459
2460 if (un->backend_decl)
2461 {
2462 if (TYPE_FIELDS (un->backend_decl)((tree_check3 ((un->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2462, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
|| un->attr.proc_pointer_comp)
2463 return un->backend_decl;
2464 else
2465 typenode = un->backend_decl;
2466 }
2467 else
2468 {
2469 typenode = make_node (UNION_TYPE);
2470 TYPE_NAME (typenode)((tree_class_check ((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2470, __FUNCTION__))->type_common.name)
= get_identifier (un->name)(__builtin_constant_p (un->name) ? get_identifier_with_length
((un->name), strlen (un->name)) : get_identifier (un->
name))
;
2471 }
2472
2473 /* Add each contained MAP as a field. */
2474 for (map = un->components; map; map = map->next)
2475 {
2476 gcc_assert (map->ts.type == BT_DERIVED)((void)(!(map->ts.type == BT_DERIVED) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2476, __FUNCTION__), 0 : 0))
;
2477
2478 /* The map's type node, which is defined within this union's context. */
2479 map_type = gfc_get_derived_type (map->ts.u.derived);
2480 TYPE_CONTEXT (map_type)((tree_class_check ((map_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2480, __FUNCTION__))->type_common.context)
= typenode;
2481
2482 /* The map field's declaration. */
2483 map_field = gfc_add_field_to_struct(typenode, get_identifier(map->name)(__builtin_constant_p (map->name) ? get_identifier_with_length
((map->name), strlen (map->name)) : get_identifier (map
->name))
,
2484 map_type, &chain);
2485 if (map->loc.lb)
2486 gfc_set_decl_location (map_field, &map->loc);
2487 else if (un->declared_at.lb)
2488 gfc_set_decl_location (map_field, &un->declared_at);
2489
2490 DECL_PACKED (map_field)((tree_check ((map_field), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2490, __FUNCTION__, (FIELD_DECL)))->base.u.bits.packed_flag
)
|= TYPE_PACKED (typenode)((tree_class_check ((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2490, __FUNCTION__))->base.u.bits.packed_flag)
;
2491 DECL_NAMELESS(map_field)((contains_struct_check ((map_field), (TS_DECL_MINIMAL), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2491, __FUNCTION__))->base.u.bits.nameless_flag)
= true;
2492
2493 /* We should never clobber another backend declaration for this map,
2494 because each map component is unique. */
2495 if (!map->backend_decl)
2496 map->backend_decl = map_field;
2497 }
2498
2499 un->backend_decl = typenode;
2500 gfc_finish_type (typenode);
2501
2502 return typenode;
2503}
2504
2505
2506/* Build a tree node for a derived type. If there are equal
2507 derived types, with different local names, these are built
2508 at the same time. If an equal derived type has been built
2509 in a parent namespace, this is used. */
2510
2511tree
2512gfc_get_derived_type (gfc_symbol * derived, int codimen)
2513{
2514 tree typenode = NULL__null, field = NULL__null, field_type = NULL__null;
2515 tree canonical = NULL_TREE(tree) __null;
2516 tree *chain = NULL__null;
2517 bool got_canonical = false;
2518 bool unlimited_entity = false;
2519 gfc_component *c;
2520 gfc_namespace *ns;
2521 tree tmp;
2522 bool coarray_flag;
2523
2524 coarray_flag = flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
2525 && derived->module && !derived->attr.vtype;
2526
2527 gcc_assert (!derived->attr.pdt_template)((void)(!(!derived->attr.pdt_template) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2527, __FUNCTION__), 0 : 0))
;
2528
2529 if (derived->attr.unlimited_polymorphic
2530 || (flag_coarrayglobal_options.x_flag_coarray == GFC_FCOARRAY_LIB
2531 && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
2532 && (derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
2533 || derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
2534 || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE)))
2535 return ptr_type_nodeglobal_trees[TI_PTR_TYPE];
2536
2537 if (flag_coarrayglobal_options.x_flag_coarray != GFC_FCOARRAY_LIB
2538 && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
2539 && (derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
2540 || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE))
2541 return gfc_get_int_type (gfc_default_integer_kind);
2542
2543 if (derived && derived->attr.flavor == FL_PROCEDURE
2544 && derived->attr.generic)
2545 derived = gfc_find_dt_in_generic (derived);
2546
2547 /* See if it's one of the iso_c_binding derived types. */
2548 if (derived->attr.is_iso_c == 1 || derived->ts.f90_type == BT_VOID)
2549 {
2550 if (derived->backend_decl)
2551 return derived->backend_decl;
2552
2553 if (derived->intmod_sym_id == ISOCBINDING_PTR)
2554 derived->backend_decl = ptr_type_nodeglobal_trees[TI_PTR_TYPE];
2555 else
2556 derived->backend_decl = pfunc_type_node;
2557
2558 derived->ts.kind = gfc_index_integer_kind;
2559 derived->ts.type = BT_INTEGER;
2560 /* Set the f90_type to BT_VOID as a way to recognize something of type
2561 BT_INTEGER that needs to fit a void * for the purpose of the
2562 iso_c_binding derived types. */
2563 derived->ts.f90_type = BT_VOID;
2564
2565 return derived->backend_decl;
2566 }
2567
2568 /* If use associated, use the module type for this one. */
2569 if (derived->backend_decl == NULL__null
2570 && (derived->attr.use_assoc || derived->attr.used_in_submodule)
2571 && derived->module
2572 && gfc_get_module_backend_decl (derived))
2573 goto copy_derived_types;
2574
2575 /* The derived types from an earlier namespace can be used as the
2576 canonical type. */
2577 if (derived->backend_decl == NULL__null
2578 && !derived->attr.use_assoc
2579 && !derived->attr.used_in_submodule
2580 && gfc_global_ns_list)
2581 {
2582 for (ns = gfc_global_ns_list;
2583 ns->translated && !got_canonical;
2584 ns = ns->sibling)
2585 {
2586 if (ns->derived_types)
2587 {
2588 for (gfc_symbol *dt = ns->derived_types; dt && !got_canonical;
2589 dt = dt->dt_next)
2590 {
2591 gfc_copy_dt_decls_ifequal (dt, derived, true);
2592 if (derived->backend_decl)
2593 got_canonical = true;
2594 if (dt->dt_next == ns->derived_types)
2595 break;
2596 }
2597 }
2598 }
2599 }
2600
2601 /* Store up the canonical type to be added to this one. */
2602 if (got_canonical)
2603 {
2604 if (TYPE_CANONICAL (derived->backend_decl)((tree_class_check ((derived->backend_decl), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2604, __FUNCTION__))->type_common.canonical)
)
2605 canonical = TYPE_CANONICAL (derived->backend_decl)((tree_class_check ((derived->backend_decl), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2605, __FUNCTION__))->type_common.canonical)
;
2606 else
2607 canonical = derived->backend_decl;
2608
2609 derived->backend_decl = NULL_TREE(tree) __null;
2610 }
2611
2612 /* derived->backend_decl != 0 means we saw it before, but its
2613 components' backend_decl may have not been built. */
2614 if (derived->backend_decl)
2615 {
2616 /* Its components' backend_decl have been built or we are
2617 seeing recursion through the formal arglist of a procedure
2618 pointer component. */
2619 if (TYPE_FIELDS (derived->backend_decl)((tree_check3 ((derived->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2619, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
)
2620 return derived->backend_decl;
2621 else if (derived->attr.abstract
2622 && derived->attr.proc_pointer_comp)
2623 {
2624 /* If an abstract derived type with procedure pointer
2625 components has no other type of component, return the
2626 backend_decl. Otherwise build the components if any of the
2627 non-procedure pointer components have no backend_decl. */
2628 for (c = derived->components; c; c = c->next)
2629 {
2630 bool same_alloc_type = c->attr.allocatable
2631 && derived == c->ts.u.derived;
2632 if (!c->attr.proc_pointer
2633 && !same_alloc_type
2634 && c->backend_decl == NULL__null)
2635 break;
2636 else if (c->next == NULL__null)
2637 return derived->backend_decl;
2638 }
2639 typenode = derived->backend_decl;
2640 }
2641 else
2642 typenode = derived->backend_decl;
2643 }
2644 else
2645 {
2646 /* We see this derived type first time, so build the type node. */
2647 typenode = make_node (RECORD_TYPE);
2648 TYPE_NAME (typenode)((tree_class_check ((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2648, __FUNCTION__))->type_common.name)
= get_identifier (derived->name)(__builtin_constant_p (derived->name) ? get_identifier_with_length
((derived->name), strlen (derived->name)) : get_identifier
(derived->name))
;
2649 TYPE_PACKED (typenode)((tree_class_check ((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2649, __FUNCTION__))->base.u.bits.packed_flag)
= flag_pack_derivedglobal_options.x_flag_pack_derived;
2650 derived->backend_decl = typenode;
2651 }
2652
2653 if (derived->components
2654 && derived->components->ts.type == BT_DERIVED
2655 && strcmp (derived->components->name, "_data") == 0
2656 && derived->components->ts.u.derived->attr.unlimited_polymorphic)
2657 unlimited_entity = true;
2658
2659 /* Go through the derived type components, building them as
2660 necessary. The reason for doing this now is that it is
2661 possible to recurse back to this derived type through a
2662 pointer component (PR24092). If this happens, the fields
2663 will be built and so we can return the type. */
2664 for (c = derived->components; c; c = c->next)
2665 {
2666 bool same_alloc_type = c->attr.allocatable
2667 && derived == c->ts.u.derived;
2668
2669 if (c->ts.type == BT_UNION && c->ts.u.derived->backend_decl == NULL__null)
2670 c->ts.u.derived->backend_decl = gfc_get_union_type (c->ts.u.derived);
2671
2672 if (c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS)
2673 continue;
2674
2675 if ((!c->attr.pointer && !c->attr.proc_pointer
2676 && !same_alloc_type)
2677 || c->ts.u.derived->backend_decl == NULL__null)
2678 {
2679 int local_codim = c->attr.codimension ? c->as->corank: codimen;
2680 c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived,
2681 local_codim);
2682 }
2683
2684 if (c->ts.u.derived->attr.is_iso_c)
2685 {
2686 /* Need to copy the modified ts from the derived type. The
2687 typespec was modified because C_PTR/C_FUNPTR are translated
2688 into (void *) from derived types. */
2689 c->ts.type = c->ts.u.derived->ts.type;
2690 c->ts.kind = c->ts.u.derived->ts.kind;
2691 c->ts.f90_type = c->ts.u.derived->ts.f90_type;
2692 if (c->initializer)
2693 {
2694 c->initializer->ts.type = c->ts.type;
2695 c->initializer->ts.kind = c->ts.kind;
2696 c->initializer->ts.f90_type = c->ts.f90_type;
2697 c->initializer->expr_type = EXPR_NULL;
2698 }
2699 }
2700 }
2701
2702 if (TYPE_FIELDS (derived->backend_decl)((tree_check3 ((derived->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2702, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
)
2703 return derived->backend_decl;
2704
2705 /* Build the type member list. Install the newly created RECORD_TYPE
2706 node as DECL_CONTEXT of each FIELD_DECL. In this case we must go
2707 through only the top-level linked list of components so we correctly
2708 build UNION_TYPE nodes for BT_UNION components. MAPs and other nested
2709 types are built as part of gfc_get_union_type. */
2710 for (c = derived->components; c; c = c->next)
2711 {
2712 bool same_alloc_type = c->attr.allocatable
2713 && derived == c->ts.u.derived;
2714 /* Prevent infinite recursion, when the procedure pointer type is
2715 the same as derived, by forcing the procedure pointer component to
2716 be built as if the explicit interface does not exist. */
2717 if (c->attr.proc_pointer
2718 && (c->ts.type != BT_DERIVED || (c->ts.u.derived
2719 && !gfc_compare_derived_types (derived, c->ts.u.derived)))
2720 && (c->ts.type != BT_CLASS || (CLASS_DATA (c)c->ts.u.derived->components->ts.u.derived
2721 && !gfc_compare_derived_types (derived, CLASS_DATA (c)c->ts.u.derived->components->ts.u.derived))))
2722 field_type = gfc_get_ppc_type (c);
2723 else if (c->attr.proc_pointer && derived->backend_decl)
2724 {
2725 tmp = build_function_type (derived->backend_decl, NULL_TREE(tree) __null);
2726 field_type = build_pointer_type (tmp);
2727 }
2728 else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
2729 field_type = c->ts.u.derived->backend_decl;
2730 else if (c->attr.caf_token)
2731 field_type = pvoid_type_node;
2732 else
2733 {
2734 if (c->ts.type == BT_CHARACTER
2735 && !c->ts.deferred && !c->attr.pdt_string)
2736 {
2737 /* Evaluate the string length. */
2738 gfc_conv_const_charlen (c->ts.u.cl);
2739 gcc_assert (c->ts.u.cl->backend_decl)((void)(!(c->ts.u.cl->backend_decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2739, __FUNCTION__), 0 : 0))
;
2740 }
2741 else if (c->ts.type == BT_CHARACTER)
2742 c->ts.u.cl->backend_decl
2743 = build_int_cst (gfc_charlen_type_node, 0);
2744
2745 field_type = gfc_typenode_for_spec (&c->ts, codimen);
2746 }
2747
2748 /* This returns an array descriptor type. Initialization may be
2749 required. */
2750 if ((c->attr.dimension || c->attr.codimension) && !c->attr.proc_pointer )
2751 {
2752 if (c->attr.pointer || c->attr.allocatable || c->attr.pdt_array)
2753 {
2754 enum gfc_array_kind akind;
2755 if (c->attr.pointer)
2756 akind = c->attr.contiguous ? GFC_ARRAY_POINTER_CONT
2757 : GFC_ARRAY_POINTER;
2758 else
2759 akind = GFC_ARRAY_ALLOCATABLE;
2760 /* Pointers to arrays aren't actually pointer types. The
2761 descriptors are separate, but the data is common. */
2762 field_type = gfc_build_array_type (field_type, c->as, akind,
2763 !c->attr.target
2764 && !c->attr.pointer,
2765 c->attr.contiguous,
2766 codimen);
2767 }
2768 else
2769 field_type = gfc_get_nodesc_array_type (field_type, c->as,
2770 PACKED_STATIC,
2771 !c->attr.target);
2772 }
2773 else if ((c->attr.pointer || c->attr.allocatable || c->attr.pdt_string)
2774 && !c->attr.proc_pointer
2775 && !(unlimited_entity && c == derived->components))
2776 field_type = build_pointer_type (field_type);
2777
2778 if (c->attr.pointer || same_alloc_type)
2779 field_type = gfc_nonrestricted_type (field_type);
2780
2781 /* vtype fields can point to different types to the base type. */
2782 if (c->ts.type == BT_DERIVED
2783 && c->ts.u.derived && c->ts.u.derived->attr.vtype)
2784 field_type = build_pointer_type_for_mode (TREE_TYPE (field_type)((contains_struct_check ((field_type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2784, __FUNCTION__))->typed.type)
,
2785 ptr_mode, true);
2786
2787 /* Ensure that the CLASS language specific flag is set. */
2788 if (c->ts.type == BT_CLASS)
2789 {
2790 if (POINTER_TYPE_P (field_type)(((enum tree_code) (field_type)->base.code) == POINTER_TYPE
|| ((enum tree_code) (field_type)->base.code) == REFERENCE_TYPE
)
)
2791 GFC_CLASS_TYPE_P (TREE_TYPE (field_type))((tree_class_check ((((contains_struct_check ((field_type), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2791, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2791, __FUNCTION__))->type_common.lang_flag_4)
= 1;
2792 else
2793 GFC_CLASS_TYPE_P (field_type)((tree_class_check ((field_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2793, __FUNCTION__))->type_common.lang_flag_4)
= 1;
2794 }
2795
2796 field = gfc_add_field_to_struct (typenode,
2797 get_identifier (c->name)(__builtin_constant_p (c->name) ? get_identifier_with_length
((c->name), strlen (c->name)) : get_identifier (c->
name))
,
2798 field_type, &chain);
2799 if (c->loc.lb)
2800 gfc_set_decl_location (field, &c->loc);
2801 else if (derived->declared_at.lb)
2802 gfc_set_decl_location (field, &derived->declared_at);
2803
2804 gfc_finish_decl_attrs (field, &c->attr);
2805
2806 DECL_PACKED (field)((tree_check ((field), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2806, __FUNCTION__, (FIELD_DECL)))->base.u.bits.packed_flag
)
|= TYPE_PACKED (typenode)((tree_class_check ((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2806, __FUNCTION__))->base.u.bits.packed_flag)
;
2807
2808 gcc_assert (field)((void)(!(field) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2808, __FUNCTION__), 0 : 0))
;
2809 if (!c->backend_decl)
2810 c->backend_decl = field;
2811
2812 if (c->attr.pointer && c->attr.dimension
2813 && !(c->ts.type == BT_DERIVED
2814 && strcmp (c->name, "_data") == 0))
2815 GFC_DECL_PTR_ARRAY_P (c->backend_decl)((contains_struct_check ((c->backend_decl), (TS_DECL_COMMON
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2815, __FUNCTION__))->decl_common.lang_flag_6)
= 1;
2816 }
2817
2818 /* Now lay out the derived type, including the fields. */
2819 if (canonical)
2820 TYPE_CANONICAL (typenode)((tree_class_check ((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2820, __FUNCTION__))->type_common.canonical)
= canonical;
2821
2822 gfc_finish_type (typenode);
2823 gfc_set_decl_location (TYPE_STUB_DECL (typenode)(((contains_struct_check (((tree_class_check ((typenode), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2823, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2823, __FUNCTION__))->common.chain))
, &derived->declared_at);
2824 if (derived->module && derived->ns->proc_name
2825 && derived->ns->proc_name->attr.flavor == FL_MODULE)
2826 {
2827 if (derived->ns->proc_name->backend_decl
2828 && TREE_CODE (derived->ns->proc_name->backend_decl)((enum tree_code) (derived->ns->proc_name->backend_decl
)->base.code)
2829 == NAMESPACE_DECL)
2830 {
2831 TYPE_CONTEXT (typenode)((tree_class_check ((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2831, __FUNCTION__))->type_common.context)
= derived->ns->proc_name->backend_decl;
2832 DECL_CONTEXT (TYPE_STUB_DECL (typenode))((contains_struct_check (((((contains_struct_check (((tree_class_check
((typenode), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2832, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2832, __FUNCTION__))->common.chain))), (TS_DECL_MINIMAL)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2832, __FUNCTION__))->decl_minimal.context)
2833 = derived->ns->proc_name->backend_decl;
2834 }
2835 }
2836
2837 derived->backend_decl = typenode;
2838
2839copy_derived_types:
2840
2841 for (c = derived->components; c; c = c->next)
2842 {
2843 /* Do not add a caf_token field for class container components. */
2844 if ((codimen || coarray_flag)
2845 && !c->attr.dimension && !c->attr.codimension
2846 && (c->attr.allocatable || c->attr.pointer)
2847 && !derived->attr.is_class)
2848 {
2849 /* Provide sufficient space to hold "_caf_symbol". */
2850 char caf_name[GFC_MAX_SYMBOL_LEN63 + 6];
2851 gfc_component *token;
2852 snprintf (caf_name, sizeof (caf_name), "_caf_%s", c->name);
2853 token = gfc_find_component (derived, caf_name, true, true, NULL__null);
2854 gcc_assert (token)((void)(!(token) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2854, __FUNCTION__), 0 : 0))
;
2855 c->caf_token = token->backend_decl;
2856 TREE_NO_WARNING (c->caf_token)((c->caf_token)->base.nowarning_flag) = 1;
2857 }
2858 }
2859
2860 for (gfc_symbol *dt = gfc_derived_types; dt; dt = dt->dt_next)
2861 {
2862 gfc_copy_dt_decls_ifequal (derived, dt, false);
2863 if (dt->dt_next == gfc_derived_types)
2864 break;
2865 }
2866
2867 return derived->backend_decl;
2868}
2869
2870
2871int
2872gfc_return_by_reference (gfc_symbol * sym)
2873{
2874 if (!sym->attr.function)
13
Assuming field 'function' is not equal to 0
14
Taking false branch
2875 return 0;
2876
2877 if (sym->attr.dimension)
15
Assuming field 'dimension' is 0
16
Taking false branch
2878 return 1;
2879
2880 if (sym->ts.type
16.1
Field 'type' is not equal to BT_CHARACTER
16.1
Field 'type' is not equal to BT_CHARACTER
== BT_CHARACTER
2881 && !sym->attr.is_bind_c
2882 && (!sym->attr.result
2883 || !sym->ns->proc_name
2884 || !sym->ns->proc_name->attr.is_bind_c))
2885 return 1;
2886
2887 /* Possibly return complex numbers by reference for g77 compatibility.
2888 We don't do this for calls to intrinsics (as the library uses the
2889 -fno-f2c calling convention), nor for calls to functions which always
2890 require an explicit interface, as no compatibility problems can
2891 arise there. */
2892 if (flag_f2cglobal_options.x_flag_f2c && sym->ts.type == BT_COMPLEX
17
Assuming field 'x_flag_f2c' is not equal to 0
18
Assuming field 'type' is equal to BT_COMPLEX
21
Taking true branch
2893 && !sym->attr.intrinsic && !sym->attr.always_explicit)
19
Assuming field 'intrinsic' is 0
20
Assuming field 'always_explicit' is 0
2894 return 1;
22
Returning without writing to 'sym->ts.deferred', which participates in a condition later
23
Returning the value 1, which participates in a condition later
2895
2896 return 0;
2897}
2898
2899static tree
2900gfc_get_mixed_entry_union (gfc_namespace *ns)
2901{
2902 tree type;
2903 tree *chain = NULL__null;
2904 char name[GFC_MAX_SYMBOL_LEN63 + 1];
2905 gfc_entry_list *el, *el2;
2906
2907 gcc_assert (ns->proc_name->attr.mixed_entry_master)((void)(!(ns->proc_name->attr.mixed_entry_master) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2907, __FUNCTION__), 0 : 0))
;
2908 gcc_assert (memcmp (ns->proc_name->name, "master.", 7) == 0)((void)(!(memcmp (ns->proc_name->name, "master.", 7) ==
0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2908, __FUNCTION__), 0 : 0))
;
2909
2910 snprintf (name, GFC_MAX_SYMBOL_LEN63, "munion.%s", ns->proc_name->name + 7);
2911
2912 /* Build the type node. */
2913 type = make_node (UNION_TYPE);
2914
2915 TYPE_NAME (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2915, __FUNCTION__))->type_common.name)
= get_identifier (name)(__builtin_constant_p (name) ? get_identifier_with_length ((name
), strlen (name)) : get_identifier (name))
;
2916
2917 for (el = ns->entries; el; el = el->next)
2918 {
2919 /* Search for duplicates. */
2920 for (el2 = ns->entries; el2 != el; el2 = el2->next)
2921 if (el2->sym->result == el->sym->result)
2922 break;
2923
2924 if (el == el2)
2925 gfc_add_field_to_struct_1 (type,
2926 get_identifier (el->sym->result->name)(__builtin_constant_p (el->sym->result->name) ? get_identifier_with_length
((el->sym->result->name), strlen (el->sym->result
->name)) : get_identifier (el->sym->result->name)
)
,
2927 gfc_sym_type (el->sym->result), &chain);
2928 }
2929
2930 /* Finish off the type. */
2931 gfc_finish_type (type);
2932 TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (type))((tree_check (((((contains_struct_check (((tree_class_check (
(type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2932, __FUNCTION__))), (TS_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2932, __FUNCTION__))->common.chain))), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 2932, __FUNCTION__, (TYPE_DECL)))->decl_common.decl_flag_1
)
= 1;
2933 return type;
2934}
2935
2936/* Create a "fn spec" based on the formal arguments;
2937 cf. create_function_arglist. */
2938
2939static tree
2940create_fn_spec (gfc_symbol *sym, tree fntype)
2941{
2942 char spec[150];
2943 size_t spec_len;
2944 gfc_formal_arglist *f;
2945 tree tmp;
2946
2947 memset (&spec, 0, sizeof (spec));
2948 spec[0] = '.';
2949 spec[1] = ' ';
2950 spec_len = 2;
2951
2952 if (sym->attr.entry_master)
2953 {
2954 spec[spec_len++] = 'R';
2955 spec[spec_len++] = ' ';
2956 }
2957 if (gfc_return_by_reference (sym))
2958 {
2959 gfc_symbol *result = sym->result ? sym->result : sym;
2960
2961 if (result->attr.pointer || sym->attr.proc_pointer)
2962 {
2963 spec[spec_len++] = '.';
2964 spec[spec_len++] = ' ';
2965 }
2966 else
2967 {
2968 spec[spec_len++] = 'w';
2969 spec[spec_len++] = ' ';
2970 }
2971 if (sym->ts.type == BT_CHARACTER)
2972 {
2973 spec[spec_len++] = 'R';
2974 spec[spec_len++] = ' ';
2975 }
2976 }
2977
2978 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
2979 if (spec_len < sizeof (spec))
2980 {
2981 if (!f->sym || f->sym->attr.pointer || f->sym->attr.target
2982 || f->sym->attr.external || f->sym->attr.cray_pointer
2983 || (f->sym->ts.type == BT_DERIVED
2984 && (f->sym->ts.u.derived->attr.proc_pointer_comp
2985 || f->sym->ts.u.derived->attr.pointer_comp))
2986 || (f->sym->ts.type == BT_CLASS
2987 && (CLASS_DATA (f->sym)f->sym->ts.u.derived->components->ts.u.derived->attr.proc_pointer_comp
2988 || CLASS_DATA (f->sym)f->sym->ts.u.derived->components->ts.u.derived->attr.pointer_comp))
2989 || (f->sym->ts.type == BT_INTEGER && f->sym->ts.is_c_interop))
2990 {
2991 spec[spec_len++] = '.';
2992 spec[spec_len++] = ' ';
2993 }
2994 else if (f->sym->attr.intent == INTENT_IN)
2995 {
2996 spec[spec_len++] = 'r';
2997 spec[spec_len++] = ' ';
2998 }
2999 else if (f->sym)
3000 {
3001 spec[spec_len++] = 'w';
3002 spec[spec_len++] = ' ';
3003 }
3004 }
3005
3006 tmp = build_tree_list (NULL_TREE(tree) __null, build_string (spec_len, spec));
3007 tmp = tree_cons (get_identifier ("fn spec")(__builtin_constant_p ("fn spec") ? get_identifier_with_length
(("fn spec"), strlen ("fn spec")) : get_identifier ("fn spec"
))
, tmp, TYPE_ATTRIBUTES (fntype)((tree_class_check ((fntype), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3007, __FUNCTION__))->type_common.attributes)
);
3008 return build_type_attribute_variant (fntype, tmp);
3009}
3010
3011tree
3012gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
3013 const char *fnspec)
3014{
3015 tree type;
3016 vec<tree, va_gc> *typelist = NULL__null;
3017 gfc_formal_arglist *f;
3018 gfc_symbol *arg;
3019 int alternate_return = 0;
3020 bool is_varargs = true;
3021
3022 /* Make sure this symbol is a function, a subroutine or the main
3023 program. */
3024 gcc_assert (sym->attr.flavor == FL_PROCEDURE((void)(!(sym->attr.flavor == FL_PROCEDURE || sym->attr
.flavor == FL_PROGRAM) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3025, __FUNCTION__), 0 : 0))
1
Assuming field 'flavor' is not equal to FL_PROCEDURE
2
Assuming field 'flavor' is equal to FL_PROGRAM
3
'?' condition is false
3025 || sym->attr.flavor == FL_PROGRAM)((void)(!(sym->attr.flavor == FL_PROCEDURE || sym->attr
.flavor == FL_PROGRAM) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3025, __FUNCTION__), 0 : 0))
;
3026
3027 /* To avoid recursing infinitely on recursive types, we use error_mark_node
3028 so that they can be detected here and handled further down. */
3029 if (sym->backend_decl == NULL__null)
4
Assuming field 'backend_decl' is equal to NULL
5
Taking true branch
3030 sym->backend_decl = error_mark_nodeglobal_trees[TI_ERROR_MARK];
3031 else if (sym->backend_decl == error_mark_nodeglobal_trees[TI_ERROR_MARK])
3032 goto arg_type_list_done;
3033 else if (sym->attr.proc_pointer)
3034 return TREE_TYPE (TREE_TYPE (sym->backend_decl))((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-types.c"
, 3034, __FUNCTION__))->typed.type)), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3034, __FUNCTION__))->typed.type)
;
3035 else
3036 return 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-types.c"
, 3036, __FUNCTION__))->typed.type)
;
3037
3038 if (sym->attr.entry_master)
6
Assuming field 'entry_master' is 0
7
Taking false branch
3039 /* Additional parameter for selecting an entry point. */
3040 vec_safe_push (typelist, gfc_array_index_type);
3041
3042 if (sym->result)
8
Assuming field 'result' is null
9
Taking false branch
3043 arg = sym->result;
3044 else
3045 arg = sym;
3046
3047 if (arg->ts.type == BT_CHARACTER)
10
Assuming field 'type' is not equal to BT_CHARACTER
11
Taking false branch
3048 gfc_conv_const_charlen (arg->ts.u.cl);
3049
3050 /* Some functions we use an extra parameter for the return value. */
3051 if (gfc_return_by_reference (sym))
12
Calling 'gfc_return_by_reference'
24
Returning from 'gfc_return_by_reference'
25
Taking true branch
3052 {
3053 type = gfc_sym_type (arg);
26
Calling 'gfc_sym_type'
31
Returning from 'gfc_sym_type'
3054 if (arg->ts.type == BT_COMPLEX
32
Assuming field 'type' is not equal to BT_COMPLEX
3055 || arg->attr.dimension
33
Assuming field 'dimension' is not equal to 0
3056 || arg->ts.type == BT_CHARACTER)
3057 type = build_reference_type (type);
3058
3059 vec_safe_push (typelist, type);
34
Calling 'vec_safe_push<tree_node *, va_gc>'
55
Returning from 'vec_safe_push<tree_node *, va_gc>'
3060 if (arg->ts.type == BT_CHARACTER)
56
Assuming field 'type' is equal to BT_CHARACTER
57
Taking true branch
3061 {
3062 if (!arg->ts.deferred)
58
Assuming field 'deferred' is false
59
Taking true branch
3063 /* Transfer by value. */
3064 vec_safe_push (typelist, gfc_charlen_type_node);
60
Passing value via 1st parameter 'v'
61
Calling 'vec_safe_push<tree_node *, va_gc>'
3065 else
3066 /* Deferred character lengths are transferred by reference
3067 so that the value can be returned. */
3068 vec_safe_push (typelist, build_pointer_type(gfc_charlen_type_node));
3069 }
3070 }
3071 if (sym->backend_decl == error_mark_nodeglobal_trees[TI_ERROR_MARK] && actual_args != NULL__null
3072 && sym->formal == NULL__null && (sym->attr.proc == PROC_EXTERNAL
3073 || sym->attr.proc == PROC_UNKNOWN))
3074 gfc_get_formal_from_actual_arglist (sym, actual_args);
3075
3076 /* Build the argument types for the function. */
3077 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
3078 {
3079 arg = f->sym;
3080 if (arg)
3081 {
3082 /* Evaluate constant character lengths here so that they can be
3083 included in the type. */
3084 if (arg->ts.type == BT_CHARACTER)
3085 gfc_conv_const_charlen (arg->ts.u.cl);
3086
3087 if (arg->attr.flavor == FL_PROCEDURE)
3088 {
3089 type = gfc_get_function_type (arg);
3090 type = build_pointer_type (type);
3091 }
3092 else
3093 type = gfc_sym_type (arg);
3094
3095 /* Parameter Passing Convention
3096
3097 We currently pass all parameters by reference.
3098 Parameters with INTENT(IN) could be passed by value.
3099 The problem arises if a function is called via an implicit
3100 prototype. In this situation the INTENT is not known.
3101 For this reason all parameters to global functions must be
3102 passed by reference. Passing by value would potentially
3103 generate bad code. Worse there would be no way of telling that
3104 this code was bad, except that it would give incorrect results.
3105
3106 Contained procedures could pass by value as these are never
3107 used without an explicit interface, and cannot be passed as
3108 actual parameters for a dummy procedure. */
3109
3110 vec_safe_push (typelist, type);
3111 }
3112 else
3113 {
3114 if (sym->attr.subroutine)
3115 alternate_return = 1;
3116 }
3117 }
3118
3119 /* Add hidden string length parameters. */
3120 for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
3121 {
3122 arg = f->sym;
3123 if (arg && arg->ts.type == BT_CHARACTER && !sym->attr.is_bind_c)
3124 {
3125 if (!arg->ts.deferred)
3126 /* Transfer by value. */
3127 type = gfc_charlen_type_node;
3128 else
3129 /* Deferred character lengths are transferred by reference
3130 so that the value can be returned. */
3131 type = build_pointer_type (gfc_charlen_type_node);
3132
3133 vec_safe_push (typelist, type);
3134 }
3135 /* For noncharacter scalar intrinsic types, VALUE passes the value,
3136 hence, the optional status cannot be transferred via a NULL pointer.
3137 Thus, we will use a hidden argument in that case. */
3138 else if (arg
3139 && arg->attr.optional
3140 && arg->attr.value
3141 && !arg->attr.dimension
3142 && arg->ts.type != BT_CLASS
3143 && !gfc_bt_struct (arg->ts.type)((arg->ts.type) == BT_DERIVED || (arg->ts.type) == BT_UNION
)
)
3144 vec_safe_push (typelist, boolean_type_nodeglobal_trees[TI_BOOLEAN_TYPE]);
3145 }
3146
3147 if (!vec_safe_is_empty (typelist)
3148 || sym->attr.is_main_program
3149 || sym->attr.if_source != IFSRC_UNKNOWN)
3150 is_varargs = false;
3151
3152 if (sym->backend_decl == error_mark_nodeglobal_trees[TI_ERROR_MARK])
3153 sym->backend_decl = NULL_TREE(tree) __null;
3154
3155arg_type_list_done:
3156
3157 if (alternate_return)
3158 type = integer_type_nodeinteger_types[itk_int];
3159 else if (!sym->attr.function || gfc_return_by_reference (sym))
3160 type = void_type_nodeglobal_trees[TI_VOID_TYPE];
3161 else if (sym->attr.mixed_entry_master)
3162 type = gfc_get_mixed_entry_union (sym->ns);
3163 else if (flag_f2cglobal_options.x_flag_f2c && sym->ts.type == BT_REAL
3164 && sym->ts.kind == gfc_default_real_kind
3165 && !sym->attr.always_explicit)
3166 {
3167 /* Special case: f2c calling conventions require that (scalar)
3168 default REAL functions return the C type double instead. f2c
3169 compatibility is only an issue with functions that don't
3170 require an explicit interface, as only these could be
3171 implemented in Fortran 77. */
3172 sym->ts.kind = gfc_default_double_kind;
3173 type = gfc_typenode_for_spec (&sym->ts);
3174 sym->ts.kind = gfc_default_real_kind;
3175 }
3176 else if (sym->result && sym->result->attr.proc_pointer)
3177 /* Procedure pointer return values. */
3178 {
3179 if (sym->result->attr.result && strcmp (sym->name,"ppr@") != 0)
3180 {
3181 /* Unset proc_pointer as gfc_get_function_type
3182 is called recursively. */
3183 sym->result->attr.proc_pointer = 0;
3184 type = build_pointer_type (gfc_get_function_type (sym->result));
3185 sym->result->attr.proc_pointer = 1;
3186 }
3187 else
3188 type = gfc_sym_type (sym->result);
3189 }
3190 else
3191 type = gfc_sym_type (sym);
3192
3193 if (is_varargs)
3194 type = build_varargs_function_type_vec (type, typelist)build_varargs_function_type_array (type, vec_safe_length (typelist
), vec_safe_address (typelist))
;
3195 else
3196 type = build_function_type_vec (type, typelist)build_function_type_array (type, vec_safe_length (typelist), vec_safe_address
(typelist))
;
3197
3198 /* If we were passed an fn spec, add it here, otherwise determine it from
3199 the formal arguments. */
3200 if (fnspec)
3201 {
3202 tree tmp;
3203 int spec_len = strlen (fnspec);
3204 tmp = build_tree_list (NULL_TREE(tree) __null, build_string (spec_len, fnspec));
3205 tmp = tree_cons (get_identifier ("fn spec")(__builtin_constant_p ("fn spec") ? get_identifier_with_length
(("fn spec"), strlen ("fn spec")) : get_identifier ("fn spec"
))
, tmp, TYPE_ATTRIBUTES (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3205, __FUNCTION__))->type_common.attributes)
);
3206 type = build_type_attribute_variant (type, tmp);
3207 }
3208 else
3209 type = create_fn_spec (sym, type);
3210
3211 return type;
3212}
3213
3214/* Language hooks for middle-end access to type nodes. */
3215
3216/* Return an integer type with BITS bits of precision,
3217 that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
3218
3219tree
3220gfc_type_for_size (unsigned bits, int unsignedp)
3221{
3222 if (!unsignedp)
3223 {
3224 int i;
3225 for (i = 0; i <= MAX_INT_KINDS5; ++i)
3226 {
3227 tree type = gfc_integer_types[i];
3228 if (type && bits == TYPE_PRECISION (type)((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3228, __FUNCTION__))->type_common.precision)
)
3229 return type;
3230 }
3231
3232 /* Handle TImode as a special case because it is used by some backends
3233 (e.g. ARM) even though it is not available for normal use. */
3234#if HOST_BITS_PER_WIDE_INT64 >= 64
3235 if (bits == TYPE_PRECISION (intTI_type_node)((tree_class_check ((global_trees[TI_INTTI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3235, __FUNCTION__))->type_common.precision)
)
3236 return intTI_type_nodeglobal_trees[TI_INTTI_TYPE];
3237#endif
3238
3239 if (bits <= TYPE_PRECISION (intQI_type_node)((tree_class_check ((global_trees[TI_INTQI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3239, __FUNCTION__))->type_common.precision)
)
3240 return intQI_type_nodeglobal_trees[TI_INTQI_TYPE];
3241 if (bits <= TYPE_PRECISION (intHI_type_node)((tree_class_check ((global_trees[TI_INTHI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3241, __FUNCTION__))->type_common.precision)
)
3242 return intHI_type_nodeglobal_trees[TI_INTHI_TYPE];
3243 if (bits <= TYPE_PRECISION (intSI_type_node)((tree_class_check ((global_trees[TI_INTSI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3243, __FUNCTION__))->type_common.precision)
)
3244 return intSI_type_nodeglobal_trees[TI_INTSI_TYPE];
3245 if (bits <= TYPE_PRECISION (intDI_type_node)((tree_class_check ((global_trees[TI_INTDI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3245, __FUNCTION__))->type_common.precision)
)
3246 return intDI_type_nodeglobal_trees[TI_INTDI_TYPE];
3247 if (bits <= TYPE_PRECISION (intTI_type_node)((tree_class_check ((global_trees[TI_INTTI_TYPE]), (tcc_type)
, "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3247, __FUNCTION__))->type_common.precision)
)
3248 return intTI_type_nodeglobal_trees[TI_INTTI_TYPE];
3249 }
3250 else
3251 {
3252 if (bits <= TYPE_PRECISION (unsigned_intQI_type_node)((tree_class_check ((global_trees[TI_UINTQI_TYPE]), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3252, __FUNCTION__))->type_common.precision)
)
3253 return unsigned_intQI_type_nodeglobal_trees[TI_UINTQI_TYPE];
3254 if (bits <= TYPE_PRECISION (unsigned_intHI_type_node)((tree_class_check ((global_trees[TI_UINTHI_TYPE]), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3254, __FUNCTION__))->type_common.precision)
)
3255 return unsigned_intHI_type_nodeglobal_trees[TI_UINTHI_TYPE];
3256 if (bits <= TYPE_PRECISION (unsigned_intSI_type_node)((tree_class_check ((global_trees[TI_UINTSI_TYPE]), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3256, __FUNCTION__))->type_common.precision)
)
3257 return unsigned_intSI_type_nodeglobal_trees[TI_UINTSI_TYPE];
3258 if (bits <= TYPE_PRECISION (unsigned_intDI_type_node)((tree_class_check ((global_trees[TI_UINTDI_TYPE]), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3258, __FUNCTION__))->type_common.precision)
)
3259 return unsigned_intDI_type_nodeglobal_trees[TI_UINTDI_TYPE];
3260 if (bits <= TYPE_PRECISION (unsigned_intTI_type_node)((tree_class_check ((global_trees[TI_UINTTI_TYPE]), (tcc_type
), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3260, __FUNCTION__))->type_common.precision)
)
3261 return unsigned_intTI_type_nodeglobal_trees[TI_UINTTI_TYPE];
3262 }
3263
3264 return NULL_TREE(tree) __null;
3265}
3266
3267/* Return a data type that has machine mode MODE. If the mode is an
3268 integer, then UNSIGNEDP selects between signed and unsigned types. */
3269
3270tree
3271gfc_type_for_mode (machine_mode mode, int unsignedp)
3272{
3273 int i;
3274 tree *base;
3275 scalar_int_mode int_mode;
3276
3277 if (GET_MODE_CLASS (mode)((enum mode_class) mode_class[mode]) == MODE_FLOAT)
3278 base = gfc_real_types;
3279 else if (GET_MODE_CLASS (mode)((enum mode_class) mode_class[mode]) == MODE_COMPLEX_FLOAT)
3280 base = gfc_complex_types;
3281 else if (is_a <scalar_int_mode> (mode, &int_mode))
3282 {
3283 tree type = gfc_type_for_size (GET_MODE_PRECISION (int_mode), unsignedp);
3284 return type != NULL_TREE(tree) __null && mode == TYPE_MODE (type)((((enum tree_code) ((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3284, __FUNCTION__)))->base.code) == VECTOR_TYPE) ? vector_type_mode
(type) : (type)->type_common.mode)
? type : NULL_TREE(tree) __null;
3285 }
3286 else if (GET_MODE_CLASS (mode)((enum mode_class) mode_class[mode]) == MODE_VECTOR_BOOL
3287 && valid_vector_subparts_p (GET_MODE_NUNITS (mode)))
3288 {
3289 unsigned int elem_bits = vector_element_size (GET_MODE_BITSIZE (mode),(exact_div (GET_MODE_BITSIZE (mode), GET_MODE_NUNITS (mode)).
to_constant ())
3290 GET_MODE_NUNITS (mode))(exact_div (GET_MODE_BITSIZE (mode), GET_MODE_NUNITS (mode)).
to_constant ())
;
3291 tree bool_type = build_nonstandard_boolean_type (elem_bits);
3292 return build_vector_type_for_mode (bool_type, mode);
3293 }
3294 else if (VECTOR_MODE_P (mode)(((enum mode_class) mode_class[mode]) == MODE_VECTOR_BOOL || (
(enum mode_class) mode_class[mode]) == MODE_VECTOR_INT || ((enum
mode_class) mode_class[mode]) == MODE_VECTOR_FLOAT || ((enum
mode_class) mode_class[mode]) == MODE_VECTOR_FRACT || ((enum
mode_class) mode_class[mode]) == MODE_VECTOR_UFRACT || ((enum
mode_class) mode_class[mode]) == MODE_VECTOR_ACCUM || ((enum
mode_class) mode_class[mode]) == MODE_VECTOR_UACCUM)
3295 && valid_vector_subparts_p (GET_MODE_NUNITS (mode)))
3296 {
3297 machine_mode inner_mode = GET_MODE_INNER (mode)(mode_to_inner (mode));
3298 tree inner_type = gfc_type_for_mode (inner_mode, unsignedp);
3299 if (inner_type != NULL_TREE(tree) __null)
3300 return build_vector_type_for_mode (inner_type, mode);
3301 return NULL_TREE(tree) __null;
3302 }
3303 else
3304 return NULL_TREE(tree) __null;
3305
3306 for (i = 0; i <= MAX_REAL_KINDS5; ++i)
3307 {
3308 tree type = base[i];
3309 if (type && mode == TYPE_MODE (type)((((enum tree_code) ((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3309, __FUNCTION__)))->base.code) == VECTOR_TYPE) ? vector_type_mode
(type) : (type)->type_common.mode)
)
3310 return type;
3311 }
3312
3313 return NULL_TREE(tree) __null;
3314}
3315
3316/* Return TRUE if TYPE is a type with a hidden descriptor, fill in INFO
3317 in that case. */
3318
3319bool
3320gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
3321{
3322 int rank, dim;
3323 bool indirect = false;
3324 tree etype, ptype, t, base_decl;
3325 tree data_off, span_off, dim_off, dtype_off, dim_size, elem_size;
3326 tree lower_suboff, upper_suboff, stride_suboff;
3327 tree dtype, field, rank_off;
3328
3329 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-types.c"
, 3329, __FUNCTION__))->type_common.lang_flag_1)
)
3330 {
3331 if (! POINTER_TYPE_P (type)(((enum tree_code) (type)->base.code) == POINTER_TYPE || (
(enum tree_code) (type)->base.code) == REFERENCE_TYPE)
)
3332 return false;
3333 type = TREE_TYPE (type)((contains_struct_check ((type), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3333, __FUNCTION__))->typed.type)
;
3334 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-types.c"
, 3334, __FUNCTION__))->type_common.lang_flag_1)
)
3335 return false;
3336 indirect = true;
3337 }
3338
3339 rank = 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-types.c"
, 3339, __FUNCTION__))->type_with_lang_specific.lang_specific
)->rank)
;
3340 if (rank >= (int) (sizeof (info->dimen) / sizeof (info->dimen[0])))
3341 return false;
3342
3343 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-types.c"
, 3343, __FUNCTION__))->type_with_lang_specific.lang_specific
)->dataptr_type)
;
3344 gcc_assert (POINTER_TYPE_P (etype))((void)(!((((enum tree_code) (etype)->base.code) == POINTER_TYPE
|| ((enum tree_code) (etype)->base.code) == REFERENCE_TYPE
)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3344, __FUNCTION__), 0 : 0))
;
3345 etype = TREE_TYPE (etype)((contains_struct_check ((etype), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3345, __FUNCTION__))->typed.type)
;
3346
3347 /* If the type is not a scalar coarray. */
3348 if (TREE_CODE (etype)((enum tree_code) (etype)->base.code) == ARRAY_TYPE)
3349 etype = TREE_TYPE (etype)((contains_struct_check ((etype), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3349, __FUNCTION__))->typed.type)
;
3350
3351 /* Can't handle variable sized elements yet. */
3352 if (int_size_in_bytes (etype) <= 0)
3353 return false;
3354 /* Nor non-constant lower bounds in assumed shape arrays. */
3355 if (GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3355, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_SHAPE
3356 || GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3356, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_SHAPE_CONT)
3357 {
3358 for (dim = 0; dim < rank; dim++)
3359 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-types.c"
, 3359, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim])
== NULL_TREE(tree) __null
3360 || TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim))((enum tree_code) ((((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3360, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]))->base.code)
!= INTEGER_CST)
3361 return false;
3362 }
3363
3364 memset (info, '\0', sizeof (*info));
3365 info->ndimensions = rank;
3366 info->ordering = array_descr_ordering_column_major;
3367 info->element_type = etype;
3368 ptype = build_pointer_type (gfc_array_index_type);
3369 base_decl = GFC_TYPE_ARRAY_BASE_DECL (type, indirect)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3369, __FUNCTION__))->type_with_lang_specific.lang_specific
)->base_decl[(indirect)])
;
3370 if (!base_decl)
3371 {
3372 base_decl = make_node (DEBUG_EXPR_DECL);
3373 DECL_ARTIFICIAL (base_decl)((contains_struct_check ((base_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3373, __FUNCTION__))->decl_common.artificial_flag)
= 1;
3374 TREE_TYPE (base_decl)((contains_struct_check ((base_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3374, __FUNCTION__))->typed.type)
= indirect ? build_pointer_type (ptype) : ptype;
3375 SET_DECL_MODE (base_decl, TYPE_MODE (TREE_TYPE (base_decl)))((contains_struct_check ((base_decl), (TS_DECL_COMMON), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3375, __FUNCTION__))->decl_common.mode = (((((enum tree_code
) ((tree_class_check ((((contains_struct_check ((base_decl), (
TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3375, __FUNCTION__))->typed.type)), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3375, __FUNCTION__)))->base.code) == VECTOR_TYPE) ? vector_type_mode
(((contains_struct_check ((base_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3375, __FUNCTION__))->typed.type)) : (((contains_struct_check
((base_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3375, __FUNCTION__))->typed.type))->type_common.mode)
))
;
3376 GFC_TYPE_ARRAY_BASE_DECL (type, indirect)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3376, __FUNCTION__))->type_with_lang_specific.lang_specific
)->base_decl[(indirect)])
= base_decl;
3377 }
3378 info->base_decl = base_decl;
3379 if (indirect)
3380 base_decl = build1 (INDIRECT_REF, ptype, base_decl);
3381
3382 gfc_get_descriptor_offsets_for_info (type, &data_off, &dtype_off, &span_off,
3383 &dim_off, &dim_size, &stride_suboff,
3384 &lower_suboff, &upper_suboff);
3385
3386 t = fold_build_pointer_plus (base_decl, span_off)fold_build_pointer_plus_loc (((location_t) 0), base_decl, span_off
)
;
3387 elem_size = build1 (INDIRECT_REF, gfc_array_index_type, t);
3388
3389 t = base_decl;
3390 if (!integer_zerop (data_off))
3391 t = fold_build_pointer_plus (t, data_off)fold_build_pointer_plus_loc (((location_t) 0), t, data_off);
3392 t = build1 (NOP_EXPR, build_pointer_type (ptr_type_nodeglobal_trees[TI_PTR_TYPE]), t);
3393 info->data_location = build1 (INDIRECT_REF, ptr_type_nodeglobal_trees[TI_PTR_TYPE], t);
3394 if (GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3394, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ALLOCATABLE)
3395 info->allocated = build2 (NE_EXPR, logical_type_node,
3396 info->data_location, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
3397 else if (GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3397, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_POINTER
3398 || GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3398, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_POINTER_CONT)
3399 info->associated = build2 (NE_EXPR, logical_type_node,
3400 info->data_location, null_pointer_nodeglobal_trees[TI_NULL_POINTER]);
3401 if ((GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3401, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_RANK
3402 || GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3402, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_RANK_CONT)
3403 && dwarf_versionglobal_options.x_dwarf_version >= 5)
3404 {
3405 rank = 1;
3406 info->ndimensions = 1;
3407 t = base_decl;
3408 if (!integer_zerop (dtype_off))
3409 t = fold_build_pointer_plus (t, dtype_off)fold_build_pointer_plus_loc (((location_t) 0), t, dtype_off);
3410 dtype = TYPE_MAIN_VARIANT (get_dtype_type_node ())((tree_class_check ((get_dtype_type_node ()), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3410, __FUNCTION__))->type_common.main_variant)
;
3411 field = gfc_advance_chain (TYPE_FIELDS (dtype)((tree_check3 ((dtype), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3411, __FUNCTION__, (RECORD_TYPE), (UNION_TYPE), (QUAL_UNION_TYPE
)))->type_non_common.values)
, GFC_DTYPE_RANK2);
3412 rank_off = byte_position (field);
3413 if (!integer_zerop (dtype_off))
3414 t = fold_build_pointer_plus (t, rank_off)fold_build_pointer_plus_loc (((location_t) 0), t, rank_off);
3415
3416 t = build1 (NOP_EXPR, build_pointer_type (gfc_array_index_type), t);
3417 t = build1 (INDIRECT_REF, gfc_array_index_type, t);
3418 info->rank = t;
3419 t = build0 (PLACEHOLDER_EXPR, TREE_TYPE (dim_off)((contains_struct_check ((dim_off), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3419, __FUNCTION__))->typed.type)
);
3420 t = size_binop (MULT_EXPR, t, dim_size)size_binop_loc (((location_t) 0), MULT_EXPR, t, dim_size);
3421 dim_off = build2 (PLUS_EXPR, TREE_TYPE (dim_off)((contains_struct_check ((dim_off), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3421, __FUNCTION__))->typed.type)
, t, dim_off);
3422 }
3423
3424 for (dim = 0; dim < rank; dim++)
3425 {
3426 t = fold_build_pointer_plus (base_decl,fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, lower_suboff))
3427 size_binop (PLUS_EXPR,fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, lower_suboff))
3428 dim_off, lower_suboff))fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, lower_suboff))
;
3429 t = build1 (INDIRECT_REF, gfc_array_index_type, t);
3430 info->dimen[dim].lower_bound = t;
3431 t = fold_build_pointer_plus (base_decl,fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, upper_suboff))
3432 size_binop (PLUS_EXPR,fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, upper_suboff))
3433 dim_off, upper_suboff))fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, upper_suboff))
;
3434 t = build1 (INDIRECT_REF, gfc_array_index_type, t);
3435 info->dimen[dim].upper_bound = t;
3436 if (GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3436, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_SHAPE
3437 || GFC_TYPE_ARRAY_AKIND (type)(((tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3437, __FUNCTION__))->type_with_lang_specific.lang_specific
)->akind)
== GFC_ARRAY_ASSUMED_SHAPE_CONT)
3438 {
3439 /* Assumed shape arrays have known lower bounds. */
3440 info->dimen[dim].upper_bound
3441 = build2 (MINUS_EXPR, gfc_array_index_type,
3442 info->dimen[dim].upper_bound,
3443 info->dimen[dim].lower_bound);
3444 info->dimen[dim].lower_bound
3445 = fold_convert (gfc_array_index_type,fold_convert_loc (((location_t) 0), gfc_array_index_type, (((
tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3446, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]))
3446 GFC_TYPE_ARRAY_LBOUND (type, dim))fold_convert_loc (((location_t) 0), gfc_array_index_type, (((
tree_class_check ((type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3446, __FUNCTION__))->type_with_lang_specific.lang_specific
)->lbound[dim]))
;
3447 info->dimen[dim].upper_bound
3448 = build2 (PLUS_EXPR, gfc_array_index_type,
3449 info->dimen[dim].lower_bound,
3450 info->dimen[dim].upper_bound);
3451 }
3452 t = fold_build_pointer_plus (base_decl,fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, stride_suboff))
3453 size_binop (PLUS_EXPR,fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, stride_suboff))
3454 dim_off, stride_suboff))fold_build_pointer_plus_loc (((location_t) 0), base_decl, size_binop_loc
(((location_t) 0), PLUS_EXPR, dim_off, stride_suboff))
;
3455 t = build1 (INDIRECT_REF, gfc_array_index_type, t);
3456 t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size);
3457 info->dimen[dim].stride = t;
3458 if (dim + 1 < rank)
3459 dim_off = size_binop (PLUS_EXPR, dim_off, dim_size)size_binop_loc (((location_t) 0), PLUS_EXPR, dim_off, dim_size
)
;
3460 }
3461
3462 return true;
3463}
3464
3465
3466/* Create a type to handle vector subscripts for coarray library calls. It
3467 has the form:
3468 struct caf_vector_t {
3469 size_t nvec; // size of the vector
3470 union {
3471 struct {
3472 void *vector;
3473 int kind;
3474 } v;
3475 struct {
3476 ptrdiff_t lower_bound;
3477 ptrdiff_t upper_bound;
3478 ptrdiff_t stride;
3479 } triplet;
3480 } u;
3481 }
3482 where nvec == 0 for DIMEN_ELEMENT or DIMEN_RANGE and nvec being the vector
3483 size in case of DIMEN_VECTOR, where kind is the integer type of the vector. */
3484
3485tree
3486gfc_get_caf_vector_type (int dim)
3487{
3488 static tree vector_types[GFC_MAX_DIMENSIONS15];
3489 static tree vec_type = NULL_TREE(tree) __null;
3490 tree triplet_struct_type, vect_struct_type, union_type, tmp, *chain;
3491
3492 if (vector_types[dim-1] != NULL_TREE(tree) __null)
3493 return vector_types[dim-1];
3494
3495 if (vec_type == NULL_TREE(tree) __null)
3496 {
3497 chain = 0;
3498 vect_struct_type = make_node (RECORD_TYPE);
3499 tmp = gfc_add_field_to_struct_1 (vect_struct_type,
3500 get_identifier ("vector")(__builtin_constant_p ("vector") ? get_identifier_with_length
(("vector"), strlen ("vector")) : get_identifier ("vector"))
,
3501 pvoid_type_node, &chain);
3502 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3503 tmp = gfc_add_field_to_struct_1 (vect_struct_type,
3504 get_identifier ("kind")(__builtin_constant_p ("kind") ? get_identifier_with_length (
("kind"), strlen ("kind")) : get_identifier ("kind"))
,
3505 integer_type_nodeinteger_types[itk_int], &chain);
3506 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3507 gfc_finish_type (vect_struct_type);
3508
3509 chain = 0;
3510 triplet_struct_type = make_node (RECORD_TYPE);
3511 tmp = gfc_add_field_to_struct_1 (triplet_struct_type,
3512 get_identifier ("lower_bound")(__builtin_constant_p ("lower_bound") ? get_identifier_with_length
(("lower_bound"), strlen ("lower_bound")) : get_identifier (
"lower_bound"))
,
3513 gfc_array_index_type, &chain);
3514 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3515 tmp = gfc_add_field_to_struct_1 (triplet_struct_type,
3516 get_identifier ("upper_bound")(__builtin_constant_p ("upper_bound") ? get_identifier_with_length
(("upper_bound"), strlen ("upper_bound")) : get_identifier (
"upper_bound"))
,
3517 gfc_array_index_type, &chain);
3518 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3519 tmp = gfc_add_field_to_struct_1 (triplet_struct_type, get_identifier ("stride")(__builtin_constant_p ("stride") ? get_identifier_with_length
(("stride"), strlen ("stride")) : get_identifier ("stride"))
,
3520 gfc_array_index_type, &chain);
3521 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3522 gfc_finish_type (triplet_struct_type);
3523
3524 chain = 0;
3525 union_type = make_node (UNION_TYPE);
3526 tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v")(__builtin_constant_p ("v") ? get_identifier_with_length (("v"
), strlen ("v")) : get_identifier ("v"))
,
3527 vect_struct_type, &chain);
3528 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3529 tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("triplet")(__builtin_constant_p ("triplet") ? get_identifier_with_length
(("triplet"), strlen ("triplet")) : get_identifier ("triplet"
))
,
3530 triplet_struct_type, &chain);
3531 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3532 gfc_finish_type (union_type);
3533
3534 chain = 0;
3535 vec_type = make_node (RECORD_TYPE);
3536 tmp = gfc_add_field_to_struct_1 (vec_type, get_identifier ("nvec")(__builtin_constant_p ("nvec") ? get_identifier_with_length (
("nvec"), strlen ("nvec")) : get_identifier ("nvec"))
,
3537 size_type_nodeglobal_trees[TI_SIZE_TYPE], &chain);
3538 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3539 tmp = gfc_add_field_to_struct_1 (vec_type, get_identifier ("u")(__builtin_constant_p ("u") ? get_identifier_with_length (("u"
), strlen ("u")) : get_identifier ("u"))
,
3540 union_type, &chain);
3541 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3542 gfc_finish_type (vec_type);
3543 TYPE_NAME (vec_type)((tree_class_check ((vec_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3543, __FUNCTION__))->type_common.name)
= get_identifier ("caf_vector_t")(__builtin_constant_p ("caf_vector_t") ? get_identifier_with_length
(("caf_vector_t"), strlen ("caf_vector_t")) : get_identifier
("caf_vector_t"))
;
3544 }
3545
3546 tmp = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
3547 gfc_rank_cst[dim-1]);
3548 vector_types[dim-1] = build_array_type (vec_type, tmp);
3549 return vector_types[dim-1];
3550}
3551
3552
3553tree
3554gfc_get_caf_reference_type ()
3555{
3556 static tree reference_type = NULL_TREE(tree) __null;
3557 tree c_struct_type, s_struct_type, v_struct_type, union_type, dim_union_type,
3558 a_struct_type, u_union_type, tmp, *chain;
3559
3560 if (reference_type != NULL_TREE(tree) __null)
3561 return reference_type;
3562
3563 chain = 0;
3564 c_struct_type = make_node (RECORD_TYPE);
3565 tmp = gfc_add_field_to_struct_1 (c_struct_type,
3566 get_identifier ("offset")(__builtin_constant_p ("offset") ? get_identifier_with_length
(("offset"), strlen ("offset")) : get_identifier ("offset"))
,
3567 gfc_array_index_type, &chain);
3568 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3569 tmp = gfc_add_field_to_struct_1 (c_struct_type,
3570 get_identifier ("caf_token_offset")(__builtin_constant_p ("caf_token_offset") ? get_identifier_with_length
(("caf_token_offset"), strlen ("caf_token_offset")) : get_identifier
("caf_token_offset"))
,
3571 gfc_array_index_type, &chain);
3572 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3573 gfc_finish_type (c_struct_type);
3574
3575 chain = 0;
3576 s_struct_type = make_node (RECORD_TYPE);
3577 tmp = gfc_add_field_to_struct_1 (s_struct_type,
3578 get_identifier ("start")(__builtin_constant_p ("start") ? get_identifier_with_length (
("start"), strlen ("start")) : get_identifier ("start"))
,
3579 gfc_array_index_type, &chain);
3580 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3581 tmp = gfc_add_field_to_struct_1 (s_struct_type,
3582 get_identifier ("end")(__builtin_constant_p ("end") ? get_identifier_with_length ((
"end"), strlen ("end")) : get_identifier ("end"))
,
3583 gfc_array_index_type, &chain);
3584 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3585 tmp = gfc_add_field_to_struct_1 (s_struct_type,
3586 get_identifier ("stride")(__builtin_constant_p ("stride") ? get_identifier_with_length
(("stride"), strlen ("stride")) : get_identifier ("stride"))
,
3587 gfc_array_index_type, &chain);
3588 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3589 gfc_finish_type (s_struct_type);
3590
3591 chain = 0;
3592 v_struct_type = make_node (RECORD_TYPE);
3593 tmp = gfc_add_field_to_struct_1 (v_struct_type,
3594 get_identifier ("vector")(__builtin_constant_p ("vector") ? get_identifier_with_length
(("vector"), strlen ("vector")) : get_identifier ("vector"))
,
3595 pvoid_type_node, &chain);
3596 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3597 tmp = gfc_add_field_to_struct_1 (v_struct_type,
3598 get_identifier ("nvec")(__builtin_constant_p ("nvec") ? get_identifier_with_length (
("nvec"), strlen ("nvec")) : get_identifier ("nvec"))
,
3599 size_type_nodeglobal_trees[TI_SIZE_TYPE], &chain);
3600 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3601 tmp = gfc_add_field_to_struct_1 (v_struct_type,
3602 get_identifier ("kind")(__builtin_constant_p ("kind") ? get_identifier_with_length (
("kind"), strlen ("kind")) : get_identifier ("kind"))
,
3603 integer_type_nodeinteger_types[itk_int], &chain);
3604 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3605 gfc_finish_type (v_struct_type);
3606
3607 chain = 0;
3608 union_type = make_node (UNION_TYPE);
3609 tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("s")(__builtin_constant_p ("s") ? get_identifier_with_length (("s"
), strlen ("s")) : get_identifier ("s"))
,
3610 s_struct_type, &chain);
3611 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3612 tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v")(__builtin_constant_p ("v") ? get_identifier_with_length (("v"
), strlen ("v")) : get_identifier ("v"))
,
3613 v_struct_type, &chain);
3614 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3615 gfc_finish_type (union_type);
3616
3617 tmp = build_range_type (gfc_array_index_type, gfc_index_zero_nodegfc_rank_cst[0],
3618 gfc_rank_cst[GFC_MAX_DIMENSIONS15 - 1]);
3619 dim_union_type = build_array_type (union_type, tmp);
3620
3621 chain = 0;
3622 a_struct_type = make_node (RECORD_TYPE);
3623 tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("mode")(__builtin_constant_p ("mode") ? get_identifier_with_length (
("mode"), strlen ("mode")) : get_identifier ("mode"))
,
3624 build_array_type (unsigned_char_type_nodeinteger_types[itk_unsigned_char],
3625 build_range_type (gfc_array_index_type,
3626 gfc_index_zero_nodegfc_rank_cst[0],
3627 gfc_rank_cst[GFC_MAX_DIMENSIONS15 - 1])),
3628 &chain);
3629 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3630 tmp = gfc_add_field_to_struct_1 (a_struct_type,
3631 get_identifier ("static_array_type")(__builtin_constant_p ("static_array_type") ? get_identifier_with_length
(("static_array_type"), strlen ("static_array_type")) : get_identifier
("static_array_type"))
,
3632 integer_type_nodeinteger_types[itk_int], &chain);
3633 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3634 tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("dim")(__builtin_constant_p ("dim") ? get_identifier_with_length ((
"dim"), strlen ("dim")) : get_identifier ("dim"))
,
3635 dim_union_type, &chain);
3636 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3637 gfc_finish_type (a_struct_type);
3638
3639 chain = 0;
3640 u_union_type = make_node (UNION_TYPE);
3641 tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("c")(__builtin_constant_p ("c") ? get_identifier_with_length (("c"
), strlen ("c")) : get_identifier ("c"))
,
3642 c_struct_type, &chain);
3643 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3644 tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("a")(__builtin_constant_p ("a") ? get_identifier_with_length (("a"
), strlen ("a")) : get_identifier ("a"))
,
3645 a_struct_type, &chain);
3646 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3647 gfc_finish_type (u_union_type);
3648
3649 chain = 0;
3650 reference_type = make_node (RECORD_TYPE);
3651 tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("next")(__builtin_constant_p ("next") ? get_identifier_with_length (
("next"), strlen ("next")) : get_identifier ("next"))
,
3652 build_pointer_type (reference_type), &chain);
3653 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3654 tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("type")(__builtin_constant_p ("type") ? get_identifier_with_length (
("type"), strlen ("type")) : get_identifier ("type"))
,
3655 integer_type_nodeinteger_types[itk_int], &chain);
3656 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3657 tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("item_size")(__builtin_constant_p ("item_size") ? get_identifier_with_length
(("item_size"), strlen ("item_size")) : get_identifier ("item_size"
))
,
3658 size_type_nodeglobal_trees[TI_SIZE_TYPE], &chain);
3659 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3660 tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("u")(__builtin_constant_p ("u") ? get_identifier_with_length (("u"
), strlen ("u")) : get_identifier ("u"))
,
3661 u_union_type, &chain);
3662 TREE_NO_WARNING (tmp)((tmp)->base.nowarning_flag) = 1;
3663 gfc_finish_type (reference_type);
3664 TYPE_NAME (reference_type)((tree_class_check ((reference_type), (tcc_type), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/trans-types.c"
, 3664, __FUNCTION__))->type_common.name)
= get_identifier ("caf_reference_t")(__builtin_constant_p ("caf_reference_t") ? get_identifier_with_length
(("caf_reference_t"), strlen ("caf_reference_t")) : get_identifier
("caf_reference_t"))
;
3665
3666 return reference_type;
3667}
3668
3669#include "gt-fortran-trans-types.h"

/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h

1/* Vector API for GNU compiler.
2 Copyright (C) 2004-2021 Free Software Foundation, Inc.
3 Contributed by Nathan Sidwell <nathan@codesourcery.com>
4 Re-implemented in C++ by Diego Novillo <dnovillo@google.com>
5
6This file is part of GCC.
7
8GCC is free software; you can redistribute it and/or modify it under
9the terms of the GNU General Public License as published by the Free
10Software Foundation; either version 3, or (at your option) any later
11version.
12
13GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14WARRANTY; without even the implied warranty of MERCHANTABILITY or
15FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16for more details.
17
18You should have received a copy of the GNU General Public License
19along with GCC; see the file COPYING3. If not see
20<http://www.gnu.org/licenses/>. */
21
22#ifndef GCC_VEC_H
23#define GCC_VEC_H
24
25/* Some gen* file have no ggc support as the header file gtype-desc.h is
26 missing. Provide these definitions in case ggc.h has not been included.
27 This is not a problem because any code that runs before gengtype is built
28 will never need to use GC vectors.*/
29
30extern void ggc_free (void *);
31extern size_t ggc_round_alloc_size (size_t requested_size);
32extern void *ggc_realloc (void *, size_t MEM_STAT_DECL);
33
34/* Templated vector type and associated interfaces.
35
36 The interface functions are typesafe and use inline functions,
37 sometimes backed by out-of-line generic functions. The vectors are
38 designed to interoperate with the GTY machinery.
39
40 There are both 'index' and 'iterate' accessors. The index accessor
41 is implemented by operator[]. The iterator returns a boolean
42 iteration condition and updates the iteration variable passed by
43 reference. Because the iterator will be inlined, the address-of
44 can be optimized away.
45
46 Each operation that increases the number of active elements is
47 available in 'quick' and 'safe' variants. The former presumes that
48 there is sufficient allocated space for the operation to succeed
49 (it dies if there is not). The latter will reallocate the
50 vector, if needed. Reallocation causes an exponential increase in
51 vector size. If you know you will be adding N elements, it would
52 be more efficient to use the reserve operation before adding the
53 elements with the 'quick' operation. This will ensure there are at
54 least as many elements as you ask for, it will exponentially
55 increase if there are too few spare slots. If you want reserve a
56 specific number of slots, but do not want the exponential increase
57 (for instance, you know this is the last allocation), use the
58 reserve_exact operation. You can also create a vector of a
59 specific size from the get go.
60
61 You should prefer the push and pop operations, as they append and
62 remove from the end of the vector. If you need to remove several
63 items in one go, use the truncate operation. The insert and remove
64 operations allow you to change elements in the middle of the
65 vector. There are two remove operations, one which preserves the
66 element ordering 'ordered_remove', and one which does not
67 'unordered_remove'. The latter function copies the end element
68 into the removed slot, rather than invoke a memmove operation. The
69 'lower_bound' function will determine where to place an item in the
70 array using insert that will maintain sorted order.
71
72 Vectors are template types with three arguments: the type of the
73 elements in the vector, the allocation strategy, and the physical
74 layout to use
75
76 Four allocation strategies are supported:
77
78 - Heap: allocation is done using malloc/free. This is the
79 default allocation strategy.
80
81 - GC: allocation is done using ggc_alloc/ggc_free.
82
83 - GC atomic: same as GC with the exception that the elements
84 themselves are assumed to be of an atomic type that does
85 not need to be garbage collected. This means that marking
86 routines do not need to traverse the array marking the
87 individual elements. This increases the performance of
88 GC activities.
89
90 Two physical layouts are supported:
91
92 - Embedded: The vector is structured using the trailing array
93 idiom. The last member of the structure is an array of size
94 1. When the vector is initially allocated, a single memory
95 block is created to hold the vector's control data and the
96 array of elements. These vectors cannot grow without
97 reallocation (see discussion on embeddable vectors below).
98
99 - Space efficient: The vector is structured as a pointer to an
100 embedded vector. This is the default layout. It means that
101 vectors occupy a single word of storage before initial
102 allocation. Vectors are allowed to grow (the internal
103 pointer is reallocated but the main vector instance does not
104 need to relocate).
105
106 The type, allocation and layout are specified when the vector is
107 declared.
108
109 If you need to directly manipulate a vector, then the 'address'
110 accessor will return the address of the start of the vector. Also
111 the 'space' predicate will tell you whether there is spare capacity
112 in the vector. You will not normally need to use these two functions.
113
114 Notes on the different layout strategies
115
116 * Embeddable vectors (vec<T, A, vl_embed>)
117
118 These vectors are suitable to be embedded in other data
119 structures so that they can be pre-allocated in a contiguous
120 memory block.
121
122 Embeddable vectors are implemented using the trailing array
123 idiom, thus they are not resizeable without changing the address
124 of the vector object itself. This means you cannot have
125 variables or fields of embeddable vector type -- always use a
126 pointer to a vector. The one exception is the final field of a
127 structure, which could be a vector type.
128
129 You will have to use the embedded_size & embedded_init calls to
130 create such objects, and they will not be resizeable (so the
131 'safe' allocation variants are not available).
132
133 Properties of embeddable vectors:
134
135 - The whole vector and control data are allocated in a single
136 contiguous block. It uses the trailing-vector idiom, so
137 allocation must reserve enough space for all the elements
138 in the vector plus its control data.
139 - The vector cannot be re-allocated.
140 - The vector cannot grow nor shrink.
141 - No indirections needed for access/manipulation.
142 - It requires 2 words of storage (prior to vector allocation).
143
144
145 * Space efficient vector (vec<T, A, vl_ptr>)
146
147 These vectors can grow dynamically and are allocated together
148 with their control data. They are suited to be included in data
149 structures. Prior to initial allocation, they only take a single
150 word of storage.
151
152 These vectors are implemented as a pointer to embeddable vectors.
153 The semantics allow for this pointer to be NULL to represent
154 empty vectors. This way, empty vectors occupy minimal space in
155 the structure containing them.
156
157 Properties:
158
159 - The whole vector and control data are allocated in a single
160 contiguous block.
161 - The whole vector may be re-allocated.
162 - Vector data may grow and shrink.
163 - Access and manipulation requires a pointer test and
164 indirection.
165 - It requires 1 word of storage (prior to vector allocation).
166
167 An example of their use would be,
168
169 struct my_struct {
170 // A space-efficient vector of tree pointers in GC memory.
171 vec<tree, va_gc, vl_ptr> v;
172 };
173
174 struct my_struct *s;
175
176 if (s->v.length ()) { we have some contents }
177 s->v.safe_push (decl); // append some decl onto the end
178 for (ix = 0; s->v.iterate (ix, &elt); ix++)
179 { do something with elt }
180*/
181
182/* Support function for statistics. */
183extern void dump_vec_loc_statistics (void);
184
185/* Hashtable mapping vec addresses to descriptors. */
186extern htab_t vec_mem_usage_hash;
187
188/* Control data for vectors. This contains the number of allocated
189 and used slots inside a vector. */
190
191struct vec_prefix
192{
193 /* FIXME - These fields should be private, but we need to cater to
194 compilers that have stricter notions of PODness for types. */
195
196 /* Memory allocation support routines in vec.c. */
197 void register_overhead (void *, size_t, size_t CXX_MEM_STAT_INFO);
198 void release_overhead (void *, size_t, size_t, bool CXX_MEM_STAT_INFO);
199 static unsigned calculate_allocation (vec_prefix *, unsigned, bool);
200 static unsigned calculate_allocation_1 (unsigned, unsigned);
201
202 /* Note that vec_prefix should be a base class for vec, but we use
203 offsetof() on vector fields of tree structures (e.g.,
204 tree_binfo::base_binfos), and offsetof only supports base types.
205
206 To compensate, we make vec_prefix a field inside vec and make
207 vec a friend class of vec_prefix so it can access its fields. */
208 template <typename, typename, typename> friend struct vec;
209
210 /* The allocator types also need access to our internals. */
211 friend struct va_gc;
212 friend struct va_gc_atomic;
213 friend struct va_heap;
214
215 unsigned m_alloc : 31;
216 unsigned m_using_auto_storage : 1;
217 unsigned m_num;
218};
219
220/* Calculate the number of slots to reserve a vector, making sure that
221 RESERVE slots are free. If EXACT grow exactly, otherwise grow
222 exponentially. PFX is the control data for the vector. */
223
224inline unsigned
225vec_prefix::calculate_allocation (vec_prefix *pfx, unsigned reserve,
226 bool exact)
227{
228 if (exact
44.1
'exact' is false
44.1
'exact' is false
)
45
Taking false branch
229 return (pfx ? pfx->m_num : 0) + reserve;
230 else if (!pfx
45.1
'pfx' is null
45.1
'pfx' is null
)
46
Taking true branch
231 return MAX (4, reserve)((4) > (reserve) ? (4) : (reserve));
47
'?' condition is true
48
Returning the value 4, which participates in a condition later
232 return calculate_allocation_1 (pfx->m_alloc, pfx->m_num + reserve);
233}
234
235template<typename, typename, typename> struct vec;
236
237/* Valid vector layouts
238
239 vl_embed - Embeddable vector that uses the trailing array idiom.
240 vl_ptr - Space efficient vector that uses a pointer to an
241 embeddable vector. */
242struct vl_embed { };
243struct vl_ptr { };
244
245
246/* Types of supported allocations
247
248 va_heap - Allocation uses malloc/free.
249 va_gc - Allocation uses ggc_alloc.
250 va_gc_atomic - Same as GC, but individual elements of the array
251 do not need to be marked during collection. */
252
253/* Allocator type for heap vectors. */
254struct va_heap
255{
256 /* Heap vectors are frequently regular instances, so use the vl_ptr
257 layout for them. */
258 typedef vl_ptr default_layout;
259
260 template<typename T>
261 static void reserve (vec<T, va_heap, vl_embed> *&, unsigned, bool
262 CXX_MEM_STAT_INFO);
263
264 template<typename T>
265 static void release (vec<T, va_heap, vl_embed> *&);
266};
267
268
269/* Allocator for heap memory. Ensure there are at least RESERVE free
270 slots in V. If EXACT is true, grow exactly, else grow
271 exponentially. As a special case, if the vector had not been
272 allocated and RESERVE is 0, no vector will be created. */
273
274template<typename T>
275inline void
276va_heap::reserve (vec<T, va_heap, vl_embed> *&v, unsigned reserve, bool exact
277 MEM_STAT_DECL)
278{
279 size_t elt_size = sizeof (T);
280 unsigned alloc
281 = vec_prefix::calculate_allocation (v ? &v->m_vecpfx : 0, reserve, exact);
282 gcc_checking_assert (alloc)((void)(!(alloc) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 282, __FUNCTION__), 0 : 0))
;
283
284 if (GATHER_STATISTICS0 && v)
285 v->m_vecpfx.release_overhead (v, elt_size * v->allocated (),
286 v->allocated (), false);
287
288 size_t size = vec<T, va_heap, vl_embed>::embedded_size (alloc);
289 unsigned nelem = v ? v->length () : 0;
290 v = static_cast <vec<T, va_heap, vl_embed> *> (xrealloc (v, size));
291 v->embedded_init (alloc, nelem);
292
293 if (GATHER_STATISTICS0)
294 v->m_vecpfx.register_overhead (v, alloc, elt_size PASS_MEM_STAT);
295}
296
297
298#if GCC_VERSION(4 * 1000 + 2) >= 4007
299#pragma GCC diagnostic push
300#pragma GCC diagnostic ignored "-Wfree-nonheap-object"
301#endif
302
303/* Free the heap space allocated for vector V. */
304
305template<typename T>
306void
307va_heap::release (vec<T, va_heap, vl_embed> *&v)
308{
309 size_t elt_size = sizeof (T);
310 if (v == NULL__null)
311 return;
312
313 if (GATHER_STATISTICS0)
314 v->m_vecpfx.release_overhead (v, elt_size * v->allocated (),
315 v->allocated (), true);
316 ::free (v);
317 v = NULL__null;
318}
319
320#if GCC_VERSION(4 * 1000 + 2) >= 4007
321#pragma GCC diagnostic pop
322#endif
323
324/* Allocator type for GC vectors. Notice that we need the structure
325 declaration even if GC is not enabled. */
326
327struct va_gc
328{
329 /* Use vl_embed as the default layout for GC vectors. Due to GTY
330 limitations, GC vectors must always be pointers, so it is more
331 efficient to use a pointer to the vl_embed layout, rather than
332 using a pointer to a pointer as would be the case with vl_ptr. */
333 typedef vl_embed default_layout;
334
335 template<typename T, typename A>
336 static void reserve (vec<T, A, vl_embed> *&, unsigned, bool
337 CXX_MEM_STAT_INFO);
338
339 template<typename T, typename A>
340 static void release (vec<T, A, vl_embed> *&v);
341};
342
343
344/* Free GC memory used by V and reset V to NULL. */
345
346template<typename T, typename A>
347inline void
348va_gc::release (vec<T, A, vl_embed> *&v)
349{
350 if (v)
351 ::ggc_free (v);
352 v = NULL__null;
353}
354
355
356/* Allocator for GC memory. Ensure there are at least RESERVE free
357 slots in V. If EXACT is true, grow exactly, else grow
358 exponentially. As a special case, if the vector had not been
359 allocated and RESERVE is 0, no vector will be created. */
360
361template<typename T, typename A>
362void
363va_gc::reserve (vec<T, A, vl_embed> *&v, unsigned reserve, bool exact
364 MEM_STAT_DECL)
365{
366 unsigned alloc
367 = vec_prefix::calculate_allocation (v
42.1
'v' is null
66.1
'v' is non-null
42.1
'v' is null
66.1
'v' is non-null
? &v->m_vecpfx : 0, reserve, exact)
;
43
'?' condition is false
44
Calling 'vec_prefix::calculate_allocation'
49
Returning from 'vec_prefix::calculate_allocation'
67
'?' condition is true
368 if (!alloc
49.1
'alloc' is 4
49.1
'alloc' is 4
)
50
Taking false branch
68
Assuming 'alloc' is 0
69
Taking true branch
369 {
370 ::ggc_free (v);
371 v = NULL__null;
70
Null pointer value stored to 'typelist'
372 return;
373 }
374
375 /* Calculate the amount of space we want. */
376 size_t size = vec<T, A, vl_embed>::embedded_size (alloc);
377
378 /* Ask the allocator how much space it will really give us. */
379 size = ::ggc_round_alloc_size (size);
380
381 /* Adjust the number of slots accordingly. */
382 size_t vec_offset = sizeof (vec_prefix);
383 size_t elt_size = sizeof (T);
384 alloc = (size - vec_offset) / elt_size;
385
386 /* And finally, recalculate the amount of space we ask for. */
387 size = vec_offset + alloc * elt_size;
388
389 unsigned nelem = v
50.1
'v' is null
50.1
'v' is null
? v->length () : 0;
51
'?' condition is false
390 v = static_cast <vec<T, A, vl_embed> *> (::ggc_realloc (v, size
52
Value assigned to 'typelist'
391 PASS_MEM_STAT));
392 v->embedded_init (alloc, nelem);
393}
394
395
396/* Allocator type for GC vectors. This is for vectors of types
397 atomics w.r.t. collection, so allocation and deallocation is
398 completely inherited from va_gc. */
399struct va_gc_atomic : va_gc
400{
401};
402
403
404/* Generic vector template. Default values for A and L indicate the
405 most commonly used strategies.
406
407 FIXME - Ideally, they would all be vl_ptr to encourage using regular
408 instances for vectors, but the existing GTY machinery is limited
409 in that it can only deal with GC objects that are pointers
410 themselves.
411
412 This means that vector operations that need to deal with
413 potentially NULL pointers, must be provided as free
414 functions (see the vec_safe_* functions above). */
415template<typename T,
416 typename A = va_heap,
417 typename L = typename A::default_layout>
418struct GTY((user)) vec
419{
420};
421
422/* Allow C++11 range-based 'for' to work directly on vec<T>*. */
423template<typename T, typename A, typename L>
424T* begin (vec<T,A,L> *v) { return v ? v->begin () : nullptr; }
425template<typename T, typename A, typename L>
426T* end (vec<T,A,L> *v) { return v ? v->end () : nullptr; }
427template<typename T, typename A, typename L>
428const T* begin (const vec<T,A,L> *v) { return v ? v->begin () : nullptr; }
429template<typename T, typename A, typename L>
430const T* end (const vec<T,A,L> *v) { return v ? v->end () : nullptr; }
431
432/* Generic vec<> debug helpers.
433
434 These need to be instantiated for each vec<TYPE> used throughout
435 the compiler like this:
436
437 DEFINE_DEBUG_VEC (TYPE)
438
439 The reason we have a debug_helper() is because GDB can't
440 disambiguate a plain call to debug(some_vec), and it must be called
441 like debug<TYPE>(some_vec). */
442
443template<typename T>
444void
445debug_helper (vec<T> &ref)
446{
447 unsigned i;
448 for (i = 0; i < ref.length (); ++i)
449 {
450 fprintf (stderrstderr, "[%d] = ", i);
451 debug_slim (ref[i]);
452 fputc ('\n', stderrstderr);
453 }
454}
455
456/* We need a separate va_gc variant here because default template
457 argument for functions cannot be used in c++-98. Once this
458 restriction is removed, those variant should be folded with the
459 above debug_helper. */
460
461template<typename T>
462void
463debug_helper (vec<T, va_gc> &ref)
464{
465 unsigned i;
466 for (i = 0; i < ref.length (); ++i)
467 {
468 fprintf (stderrstderr, "[%d] = ", i);
469 debug_slim (ref[i]);
470 fputc ('\n', stderrstderr);
471 }
472}
473
474/* Macro to define debug(vec<T>) and debug(vec<T, va_gc>) helper
475 functions for a type T. */
476
477#define DEFINE_DEBUG_VEC(T)template void debug_helper (vec<T> &); template void
debug_helper (vec<T, va_gc> &); __attribute__ ((__used__
)) void debug (vec<T> &ref) { debug_helper <T>
(ref); } __attribute__ ((__used__)) void debug (vec<T>
*ptr) { if (ptr) debug (*ptr); else fprintf (stderr, "<nil>\n"
); } __attribute__ ((__used__)) void debug (vec<T, va_gc>
&ref) { debug_helper <T> (ref); } __attribute__ ((
__used__)) void debug (vec<T, va_gc> *ptr) { if (ptr) debug
(*ptr); else fprintf (stderr, "<nil>\n"); }
\
478 template void debug_helper (vec<T> &); \
479 template void debug_helper (vec<T, va_gc> &); \
480 /* Define the vec<T> debug functions. */ \
481 DEBUG_FUNCTION__attribute__ ((__used__)) void \
482 debug (vec<T> &ref) \
483 { \
484 debug_helper <T> (ref); \
485 } \
486 DEBUG_FUNCTION__attribute__ ((__used__)) void \
487 debug (vec<T> *ptr) \
488 { \
489 if (ptr) \
490 debug (*ptr); \
491 else \
492 fprintf (stderrstderr, "<nil>\n"); \
493 } \
494 /* Define the vec<T, va_gc> debug functions. */ \
495 DEBUG_FUNCTION__attribute__ ((__used__)) void \
496 debug (vec<T, va_gc> &ref) \
497 { \
498 debug_helper <T> (ref); \
499 } \
500 DEBUG_FUNCTION__attribute__ ((__used__)) void \
501 debug (vec<T, va_gc> *ptr) \
502 { \
503 if (ptr) \
504 debug (*ptr); \
505 else \
506 fprintf (stderrstderr, "<nil>\n"); \
507 }
508
509/* Default-construct N elements in DST. */
510
511template <typename T>
512inline void
513vec_default_construct (T *dst, unsigned n)
514{
515#ifdef BROKEN_VALUE_INITIALIZATION
516 /* Versions of GCC before 4.4 sometimes leave certain objects
517 uninitialized when value initialized, though if the type has
518 user defined default ctor, that ctor is invoked. As a workaround
519 perform clearing first and then the value initialization, which
520 fixes the case when value initialization doesn't initialize due to
521 the bugs and should initialize to all zeros, but still allows
522 vectors for types with user defined default ctor that initializes
523 some or all elements to non-zero. If T has no user defined
524 default ctor and some non-static data members have user defined
525 default ctors that initialize to non-zero the workaround will
526 still not work properly; in that case we just need to provide
527 user defined default ctor. */
528 memset (dst, '\0', sizeof (T) * n);
529#endif
530 for ( ; n; ++dst, --n)
531 ::new (static_cast<void*>(dst)) T ();
532}
533
534/* Copy-construct N elements in DST from *SRC. */
535
536template <typename T>
537inline void
538vec_copy_construct (T *dst, const T *src, unsigned n)
539{
540 for ( ; n; ++dst, ++src, --n)
541 ::new (static_cast<void*>(dst)) T (*src);
542}
543
544/* Type to provide NULL values for vec<T, A, L>. This is used to
545 provide nil initializers for vec instances. Since vec must be
546 a POD, we cannot have proper ctor/dtor for it. To initialize
547 a vec instance, you can assign it the value vNULL. This isn't
548 needed for file-scope and function-local static vectors, which
549 are zero-initialized by default. */
550struct vnull
551{
552 template <typename T, typename A, typename L>
553 CONSTEXPRconstexpr operator vec<T, A, L> () const { return vec<T, A, L>(); }
554};
555extern vnull vNULL;
556
557
558/* Embeddable vector. These vectors are suitable to be embedded
559 in other data structures so that they can be pre-allocated in a
560 contiguous memory block.
561
562 Embeddable vectors are implemented using the trailing array idiom,
563 thus they are not resizeable without changing the address of the
564 vector object itself. This means you cannot have variables or
565 fields of embeddable vector type -- always use a pointer to a
566 vector. The one exception is the final field of a structure, which
567 could be a vector type.
568
569 You will have to use the embedded_size & embedded_init calls to
570 create such objects, and they will not be resizeable (so the 'safe'
571 allocation variants are not available).
572
573 Properties:
574
575 - The whole vector and control data are allocated in a single
576 contiguous block. It uses the trailing-vector idiom, so
577 allocation must reserve enough space for all the elements
578 in the vector plus its control data.
579 - The vector cannot be re-allocated.
580 - The vector cannot grow nor shrink.
581 - No indirections needed for access/manipulation.
582 - It requires 2 words of storage (prior to vector allocation). */
583
584template<typename T, typename A>
585struct GTY((user)) vec<T, A, vl_embed>
586{
587public:
588 unsigned allocated (void) const { return m_vecpfx.m_alloc; }
589 unsigned length (void) const { return m_vecpfx.m_num; }
590 bool is_empty (void) const { return m_vecpfx.m_num == 0; }
591 T *address (void) { return m_vecdata; }
592 const T *address (void) const { return m_vecdata; }
593 T *begin () { return address (); }
594 const T *begin () const { return address (); }
595 T *end () { return address () + length (); }
596 const T *end () const { return address () + length (); }
597 const T &operator[] (unsigned) const;
598 T &operator[] (unsigned);
599 T &last (void);
600 bool space (unsigned) const;
601 bool iterate (unsigned, T *) const;
602 bool iterate (unsigned, T **) const;
603 vec *copy (ALONE_CXX_MEM_STAT_INFO) const;
604 void splice (const vec &);
605 void splice (const vec *src);
606 T *quick_push (const T &);
607 T &pop (void);
608 void truncate (unsigned);
609 void quick_insert (unsigned, const T &);
610 void ordered_remove (unsigned);
611 void unordered_remove (unsigned);
612 void block_remove (unsigned, unsigned);
613 void qsort (int (*) (const void *, const void *))qsort (int (*) (const void *, const void *));
614 void sort (int (*) (const void *, const void *, void *), void *);
615 T *bsearch (const void *key, int (*compar)(const void *, const void *));
616 T *bsearch (const void *key,
617 int (*compar)(const void *, const void *, void *), void *);
618 unsigned lower_bound (T, bool (*)(const T &, const T &)) const;
619 bool contains (const T &search) const;
620 static size_t embedded_size (unsigned);
621 void embedded_init (unsigned, unsigned = 0, unsigned = 0);
622 void quick_grow (unsigned len);
623 void quick_grow_cleared (unsigned len);
624
625 /* vec class can access our internal data and functions. */
626 template <typename, typename, typename> friend struct vec;
627
628 /* The allocator types also need access to our internals. */
629 friend struct va_gc;
630 friend struct va_gc_atomic;
631 friend struct va_heap;
632
633 /* FIXME - These fields should be private, but we need to cater to
634 compilers that have stricter notions of PODness for types. */
635 vec_prefix m_vecpfx;
636 T m_vecdata[1];
637};
638
639
640/* Convenience wrapper functions to use when dealing with pointers to
641 embedded vectors. Some functionality for these vectors must be
642 provided via free functions for these reasons:
643
644 1- The pointer may be NULL (e.g., before initial allocation).
645
646 2- When the vector needs to grow, it must be reallocated, so
647 the pointer will change its value.
648
649 Because of limitations with the current GC machinery, all vectors
650 in GC memory *must* be pointers. */
651
652
653/* If V contains no room for NELEMS elements, return false. Otherwise,
654 return true. */
655template<typename T, typename A>
656inline bool
657vec_safe_space (const vec<T, A, vl_embed> *v, unsigned nelems)
658{
659 return v
37.1
'v' is null
37.1
'v' is null
? v->space (nelems) : nelems == 0
;
38
'?' condition is false
39
Returning zero, which participates in a condition later
660}
661
662
663/* If V is NULL, return 0. Otherwise, return V->length(). */
664template<typename T, typename A>
665inline unsigned
666vec_safe_length (const vec<T, A, vl_embed> *v)
667{
668 return v ? v->length () : 0;
669}
670
671
672/* If V is NULL, return NULL. Otherwise, return V->address(). */
673template<typename T, typename A>
674inline T *
675vec_safe_address (vec<T, A, vl_embed> *v)
676{
677 return v ? v->address () : NULL__null;
678}
679
680
681/* If V is NULL, return true. Otherwise, return V->is_empty(). */
682template<typename T, typename A>
683inline bool
684vec_safe_is_empty (vec<T, A, vl_embed> *v)
685{
686 return v ? v->is_empty () : true;
687}
688
689/* If V does not have space for NELEMS elements, call
690 V->reserve(NELEMS, EXACT). */
691template<typename T, typename A>
692inline bool
693vec_safe_reserve (vec<T, A, vl_embed> *&v, unsigned nelems, bool exact = false
694 CXX_MEM_STAT_INFO)
695{
696 bool extend = nelems
35.1
'nelems' is 1
62.1
'nelems' is 1
35.1
'nelems' is 1
62.1
'nelems' is 1
? !vec_safe_space (v, nelems) : false;
36
'?' condition is true
37
Calling 'vec_safe_space<tree_node *, va_gc>'
40
Returning from 'vec_safe_space<tree_node *, va_gc>'
63
'?' condition is true
64
Assuming the condition is true
697 if (extend
40.1
'extend' is true
64.1
'extend' is true
40.1
'extend' is true
64.1
'extend' is true
)
41
Taking true branch
65
Taking true branch
698 A::reserve (v, nelems, exact PASS_MEM_STAT);
42
Calling 'va_gc::reserve'
53
Returning from 'va_gc::reserve'
66
Calling 'va_gc::reserve'
71
Returning from 'va_gc::reserve'
699 return extend;
700}
701
702template<typename T, typename A>
703inline bool
704vec_safe_reserve_exact (vec<T, A, vl_embed> *&v, unsigned nelems
705 CXX_MEM_STAT_INFO)
706{
707 return vec_safe_reserve (v, nelems, true PASS_MEM_STAT);
708}
709
710
711/* Allocate GC memory for V with space for NELEMS slots. If NELEMS
712 is 0, V is initialized to NULL. */
713
714template<typename T, typename A>
715inline void
716vec_alloc (vec<T, A, vl_embed> *&v, unsigned nelems CXX_MEM_STAT_INFO)
717{
718 v = NULL__null;
719 vec_safe_reserve (v, nelems, false PASS_MEM_STAT);
720}
721
722
723/* Free the GC memory allocated by vector V and set it to NULL. */
724
725template<typename T, typename A>
726inline void
727vec_free (vec<T, A, vl_embed> *&v)
728{
729 A::release (v);
730}
731
732
733/* Grow V to length LEN. Allocate it, if necessary. */
734template<typename T, typename A>
735inline void
736vec_safe_grow (vec<T, A, vl_embed> *&v, unsigned len,
737 bool exact = false CXX_MEM_STAT_INFO)
738{
739 unsigned oldlen = vec_safe_length (v);
740 gcc_checking_assert (len >= oldlen)((void)(!(len >= oldlen) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 740, __FUNCTION__), 0 : 0))
;
741 vec_safe_reserve (v, len - oldlen, exact PASS_MEM_STAT);
742 v->quick_grow (len);
743}
744
745
746/* If V is NULL, allocate it. Call V->safe_grow_cleared(LEN). */
747template<typename T, typename A>
748inline void
749vec_safe_grow_cleared (vec<T, A, vl_embed> *&v, unsigned len,
750 bool exact = false CXX_MEM_STAT_INFO)
751{
752 unsigned oldlen = vec_safe_length (v);
753 vec_safe_grow (v, len, exact PASS_MEM_STAT);
754 vec_default_construct (v->address () + oldlen, len - oldlen);
755}
756
757
758/* Assume V is not NULL. */
759
760template<typename T>
761inline void
762vec_safe_grow_cleared (vec<T, va_heap, vl_ptr> *&v,
763 unsigned len, bool exact = false CXX_MEM_STAT_INFO)
764{
765 v->safe_grow_cleared (len, exact PASS_MEM_STAT);
766}
767
768/* If V does not have space for NELEMS elements, call
769 V->reserve(NELEMS, EXACT). */
770
771template<typename T>
772inline bool
773vec_safe_reserve (vec<T, va_heap, vl_ptr> *&v, unsigned nelems, bool exact = false
774 CXX_MEM_STAT_INFO)
775{
776 return v->reserve (nelems, exact);
777}
778
779
780/* If V is NULL return false, otherwise return V->iterate(IX, PTR). */
781template<typename T, typename A>
782inline bool
783vec_safe_iterate (const vec<T, A, vl_embed> *v, unsigned ix, T **ptr)
784{
785 if (v)
786 return v->iterate (ix, ptr);
787 else
788 {
789 *ptr = 0;
790 return false;
791 }
792}
793
794template<typename T, typename A>
795inline bool
796vec_safe_iterate (const vec<T, A, vl_embed> *v, unsigned ix, T *ptr)
797{
798 if (v)
799 return v->iterate (ix, ptr);
800 else
801 {
802 *ptr = 0;
803 return false;
804 }
805}
806
807
808/* If V has no room for one more element, reallocate it. Then call
809 V->quick_push(OBJ). */
810template<typename T, typename A>
811inline T *
812vec_safe_push (vec<T, A, vl_embed> *&v, const T &obj CXX_MEM_STAT_INFO)
813{
814 vec_safe_reserve (v, 1, false PASS_MEM_STAT);
35
Calling 'vec_safe_reserve<tree_node *, va_gc>'
54
Returning from 'vec_safe_reserve<tree_node *, va_gc>'
62
Calling 'vec_safe_reserve<tree_node *, va_gc>'
72
Returning from 'vec_safe_reserve<tree_node *, va_gc>'
815 return v->quick_push (obj);
73
Called C++ object pointer is null
816}
817
818
819/* if V has no room for one more element, reallocate it. Then call
820 V->quick_insert(IX, OBJ). */
821template<typename T, typename A>
822inline void
823vec_safe_insert (vec<T, A, vl_embed> *&v, unsigned ix, const T &obj
824 CXX_MEM_STAT_INFO)
825{
826 vec_safe_reserve (v, 1, false PASS_MEM_STAT);
827 v->quick_insert (ix, obj);
828}
829
830
831/* If V is NULL, do nothing. Otherwise, call V->truncate(SIZE). */
832template<typename T, typename A>
833inline void
834vec_safe_truncate (vec<T, A, vl_embed> *v, unsigned size)
835{
836 if (v)
837 v->truncate (size);
838}
839
840
841/* If SRC is not NULL, return a pointer to a copy of it. */
842template<typename T, typename A>
843inline vec<T, A, vl_embed> *
844vec_safe_copy (vec<T, A, vl_embed> *src CXX_MEM_STAT_INFO)
845{
846 return src ? src->copy (ALONE_PASS_MEM_STAT) : NULL__null;
847}
848
849/* Copy the elements from SRC to the end of DST as if by memcpy.
850 Reallocate DST, if necessary. */
851template<typename T, typename A>
852inline void
853vec_safe_splice (vec<T, A, vl_embed> *&dst, const vec<T, A, vl_embed> *src
854 CXX_MEM_STAT_INFO)
855{
856 unsigned src_len = vec_safe_length (src);
857 if (src_len)
858 {
859 vec_safe_reserve_exact (dst, vec_safe_length (dst) + src_len
860 PASS_MEM_STAT);
861 dst->splice (*src);
862 }
863}
864
865/* Return true if SEARCH is an element of V. Note that this is O(N) in the
866 size of the vector and so should be used with care. */
867
868template<typename T, typename A>
869inline bool
870vec_safe_contains (vec<T, A, vl_embed> *v, const T &search)
871{
872 return v ? v->contains (search) : false;
873}
874
875/* Index into vector. Return the IX'th element. IX must be in the
876 domain of the vector. */
877
878template<typename T, typename A>
879inline const T &
880vec<T, A, vl_embed>::operator[] (unsigned ix) const
881{
882 gcc_checking_assert (ix < m_vecpfx.m_num)((void)(!(ix < m_vecpfx.m_num) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 882, __FUNCTION__), 0 : 0))
;
883 return m_vecdata[ix];
884}
885
886template<typename T, typename A>
887inline T &
888vec<T, A, vl_embed>::operator[] (unsigned ix)
889{
890 gcc_checking_assert (ix < m_vecpfx.m_num)((void)(!(ix < m_vecpfx.m_num) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 890, __FUNCTION__), 0 : 0))
;
891 return m_vecdata[ix];
892}
893
894
895/* Get the final element of the vector, which must not be empty. */
896
897template<typename T, typename A>
898inline T &
899vec<T, A, vl_embed>::last (void)
900{
901 gcc_checking_assert (m_vecpfx.m_num > 0)((void)(!(m_vecpfx.m_num > 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 901, __FUNCTION__), 0 : 0))
;
902 return (*this)[m_vecpfx.m_num - 1];
903}
904
905
906/* If this vector has space for NELEMS additional entries, return
907 true. You usually only need to use this if you are doing your
908 own vector reallocation, for instance on an embedded vector. This
909 returns true in exactly the same circumstances that vec::reserve
910 will. */
911
912template<typename T, typename A>
913inline bool
914vec<T, A, vl_embed>::space (unsigned nelems) const
915{
916 return m_vecpfx.m_alloc - m_vecpfx.m_num >= nelems;
917}
918
919
920/* Return iteration condition and update PTR to point to the IX'th
921 element of this vector. Use this to iterate over the elements of a
922 vector as follows,
923
924 for (ix = 0; vec<T, A>::iterate (v, ix, &ptr); ix++)
925 continue; */
926
927template<typename T, typename A>
928inline bool
929vec<T, A, vl_embed>::iterate (unsigned ix, T *ptr) const
930{
931 if (ix < m_vecpfx.m_num)
932 {
933 *ptr = m_vecdata[ix];
934 return true;
935 }
936 else
937 {
938 *ptr = 0;
939 return false;
940 }
941}
942
943
944/* Return iteration condition and update *PTR to point to the
945 IX'th element of this vector. Use this to iterate over the
946 elements of a vector as follows,
947
948 for (ix = 0; v->iterate (ix, &ptr); ix++)
949 continue;
950
951 This variant is for vectors of objects. */
952
953template<typename T, typename A>
954inline bool
955vec<T, A, vl_embed>::iterate (unsigned ix, T **ptr) const
956{
957 if (ix < m_vecpfx.m_num)
958 {
959 *ptr = CONST_CAST (T *, &m_vecdata[ix])(const_cast<T *> ((&m_vecdata[ix])));
960 return true;
961 }
962 else
963 {
964 *ptr = 0;
965 return false;
966 }
967}
968
969
970/* Return a pointer to a copy of this vector. */
971
972template<typename T, typename A>
973inline vec<T, A, vl_embed> *
974vec<T, A, vl_embed>::copy (ALONE_MEM_STAT_DECLvoid) const
975{
976 vec<T, A, vl_embed> *new_vec = NULL__null;
977 unsigned len = length ();
978 if (len)
979 {
980 vec_alloc (new_vec, len PASS_MEM_STAT);
981 new_vec->embedded_init (len, len);
982 vec_copy_construct (new_vec->address (), m_vecdata, len);
983 }
984 return new_vec;
985}
986
987
988/* Copy the elements from SRC to the end of this vector as if by memcpy.
989 The vector must have sufficient headroom available. */
990
991template<typename T, typename A>
992inline void
993vec<T, A, vl_embed>::splice (const vec<T, A, vl_embed> &src)
994{
995 unsigned len = src.length ();
996 if (len)
997 {
998 gcc_checking_assert (space (len))((void)(!(space (len)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 998, __FUNCTION__), 0 : 0))
;
999 vec_copy_construct (end (), src.address (), len);
1000 m_vecpfx.m_num += len;
1001 }
1002}
1003
1004template<typename T, typename A>
1005inline void
1006vec<T, A, vl_embed>::splice (const vec<T, A, vl_embed> *src)
1007{
1008 if (src)
1009 splice (*src);
1010}
1011
1012
1013/* Push OBJ (a new element) onto the end of the vector. There must be
1014 sufficient space in the vector. Return a pointer to the slot
1015 where OBJ was inserted. */
1016
1017template<typename T, typename A>
1018inline T *
1019vec<T, A, vl_embed>::quick_push (const T &obj)
1020{
1021 gcc_checking_assert (space (1))((void)(!(space (1)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1021, __FUNCTION__), 0 : 0))
;
1022 T *slot = &m_vecdata[m_vecpfx.m_num++];
1023 *slot = obj;
1024 return slot;
1025}
1026
1027
1028/* Pop and return the last element off the end of the vector. */
1029
1030template<typename T, typename A>
1031inline T &
1032vec<T, A, vl_embed>::pop (void)
1033{
1034 gcc_checking_assert (length () > 0)((void)(!(length () > 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1034, __FUNCTION__), 0 : 0))
;
1035 return m_vecdata[--m_vecpfx.m_num];
1036}
1037
1038
1039/* Set the length of the vector to SIZE. The new length must be less
1040 than or equal to the current length. This is an O(1) operation. */
1041
1042template<typename T, typename A>
1043inline void
1044vec<T, A, vl_embed>::truncate (unsigned size)
1045{
1046 gcc_checking_assert (length () >= size)((void)(!(length () >= size) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1046, __FUNCTION__), 0 : 0))
;
1047 m_vecpfx.m_num = size;
1048}
1049
1050
1051/* Insert an element, OBJ, at the IXth position of this vector. There
1052 must be sufficient space. */
1053
1054template<typename T, typename A>
1055inline void
1056vec<T, A, vl_embed>::quick_insert (unsigned ix, const T &obj)
1057{
1058 gcc_checking_assert (length () < allocated ())((void)(!(length () < allocated ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1058, __FUNCTION__), 0 : 0))
;
1059 gcc_checking_assert (ix <= length ())((void)(!(ix <= length ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1059, __FUNCTION__), 0 : 0))
;
1060 T *slot = &m_vecdata[ix];
1061 memmove (slot + 1, slot, (m_vecpfx.m_num++ - ix) * sizeof (T));
1062 *slot = obj;
1063}
1064
1065
1066/* Remove an element from the IXth position of this vector. Ordering of
1067 remaining elements is preserved. This is an O(N) operation due to
1068 memmove. */
1069
1070template<typename T, typename A>
1071inline void
1072vec<T, A, vl_embed>::ordered_remove (unsigned ix)
1073{
1074 gcc_checking_assert (ix < length ())((void)(!(ix < length ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1074, __FUNCTION__), 0 : 0))
;
1075 T *slot = &m_vecdata[ix];
1076 memmove (slot, slot + 1, (--m_vecpfx.m_num - ix) * sizeof (T));
1077}
1078
1079
1080/* Remove elements in [START, END) from VEC for which COND holds. Ordering of
1081 remaining elements is preserved. This is an O(N) operation. */
1082
1083#define VEC_ORDERED_REMOVE_IF_FROM_TO(vec, read_index, write_index, \{ ((void)(!((end) <= (vec).length ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1084, __FUNCTION__), 0 : 0)); for (read_index = write_index
= (start); read_index < (end); ++read_index) { elem_ptr =
&(vec)[read_index]; bool remove_p = (cond); if (remove_p
) continue; if (read_index != write_index) (vec)[write_index]
= (vec)[read_index]; write_index++; } if (read_index - write_index
> 0) (vec).block_remove (write_index, read_index - write_index
); }
1084 elem_ptr, start, end, cond){ ((void)(!((end) <= (vec).length ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1084, __FUNCTION__), 0 : 0)); for (read_index = write_index
= (start); read_index < (end); ++read_index) { elem_ptr =
&(vec)[read_index]; bool remove_p = (cond); if (remove_p
) continue; if (read_index != write_index) (vec)[write_index]
= (vec)[read_index]; write_index++; } if (read_index - write_index
> 0) (vec).block_remove (write_index, read_index - write_index
); }
\
1085 { \
1086 gcc_assert ((end) <= (vec).length ())((void)(!((end) <= (vec).length ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1086, __FUNCTION__), 0 : 0))
; \
1087 for (read_index = write_index = (start); read_index < (end); \
1088 ++read_index) \
1089 { \
1090 elem_ptr = &(vec)[read_index]; \
1091 bool remove_p = (cond); \
1092 if (remove_p) \
1093 continue; \
1094 \
1095 if (read_index != write_index) \
1096 (vec)[write_index] = (vec)[read_index]; \
1097 \
1098 write_index++; \
1099 } \
1100 \
1101 if (read_index - write_index > 0) \
1102 (vec).block_remove (write_index, read_index - write_index); \
1103 }
1104
1105
1106/* Remove elements from VEC for which COND holds. Ordering of remaining
1107 elements is preserved. This is an O(N) operation. */
1108
1109#define VEC_ORDERED_REMOVE_IF(vec, read_index, write_index, elem_ptr, \{ ((void)(!(((vec).length ()) <= ((vec)).length ()) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1110, __FUNCTION__), 0 : 0)); for (read_index = write_index
= (0); read_index < ((vec).length ()); ++read_index) { elem_ptr
= &((vec))[read_index]; bool remove_p = ((cond)); if (remove_p
) continue; if (read_index != write_index) ((vec))[write_index
] = ((vec))[read_index]; write_index++; } if (read_index - write_index
> 0) ((vec)).block_remove (write_index, read_index - write_index
); }
1110 cond){ ((void)(!(((vec).length ()) <= ((vec)).length ()) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1110, __FUNCTION__), 0 : 0)); for (read_index = write_index
= (0); read_index < ((vec).length ()); ++read_index) { elem_ptr
= &((vec))[read_index]; bool remove_p = ((cond)); if (remove_p
) continue; if (read_index != write_index) ((vec))[write_index
] = ((vec))[read_index]; write_index++; } if (read_index - write_index
> 0) ((vec)).block_remove (write_index, read_index - write_index
); }
\
1111 VEC_ORDERED_REMOVE_IF_FROM_TO ((vec), read_index, write_index, \{ ((void)(!(((vec).length ()) <= ((vec)).length ()) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1112, __FUNCTION__), 0 : 0)); for (read_index = write_index
= (0); read_index < ((vec).length ()); ++read_index) { elem_ptr
= &((vec))[read_index]; bool remove_p = ((cond)); if (remove_p
) continue; if (read_index != write_index) ((vec))[write_index
] = ((vec))[read_index]; write_index++; } if (read_index - write_index
> 0) ((vec)).block_remove (write_index, read_index - write_index
); }
1112 elem_ptr, 0, (vec).length (), (cond)){ ((void)(!(((vec).length ()) <= ((vec)).length ()) ? fancy_abort
("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1112, __FUNCTION__), 0 : 0)); for (read_index = write_index
= (0); read_index < ((vec).length ()); ++read_index) { elem_ptr
= &((vec))[read_index]; bool remove_p = ((cond)); if (remove_p
) continue; if (read_index != write_index) ((vec))[write_index
] = ((vec))[read_index]; write_index++; } if (read_index - write_index
> 0) ((vec)).block_remove (write_index, read_index - write_index
); }
1113
1114/* Remove an element from the IXth position of this vector. Ordering of
1115 remaining elements is destroyed. This is an O(1) operation. */
1116
1117template<typename T, typename A>
1118inline void
1119vec<T, A, vl_embed>::unordered_remove (unsigned ix)
1120{
1121 gcc_checking_assert (ix < length ())((void)(!(ix < length ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1121, __FUNCTION__), 0 : 0))
;
1122 m_vecdata[ix] = m_vecdata[--m_vecpfx.m_num];
1123}
1124
1125
1126/* Remove LEN elements starting at the IXth. Ordering is retained.
1127 This is an O(N) operation due to memmove. */
1128
1129template<typename T, typename A>
1130inline void
1131vec<T, A, vl_embed>::block_remove (unsigned ix, unsigned len)
1132{
1133 gcc_checking_assert (ix + len <= length ())((void)(!(ix + len <= length ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1133, __FUNCTION__), 0 : 0))
;
1134 T *slot = &m_vecdata[ix];
1135 m_vecpfx.m_num -= len;
1136 memmove (slot, slot + len, (m_vecpfx.m_num - ix) * sizeof (T));
1137}
1138
1139
1140/* Sort the contents of this vector with qsort. CMP is the comparison
1141 function to pass to qsort. */
1142
1143template<typename T, typename A>
1144inline void
1145vec<T, A, vl_embed>::qsort (int (*cmp) (const void *, const void *))qsort (int (*cmp) (const void *, const void *))
1146{
1147 if (length () > 1)
1148 gcc_qsort (address (), length (), sizeof (T), cmp);
1149}
1150
1151/* Sort the contents of this vector with qsort. CMP is the comparison
1152 function to pass to qsort. */
1153
1154template<typename T, typename A>
1155inline void
1156vec<T, A, vl_embed>::sort (int (*cmp) (const void *, const void *, void *),
1157 void *data)
1158{
1159 if (length () > 1)
1160 gcc_sort_r (address (), length (), sizeof (T), cmp, data);
1161}
1162
1163
1164/* Search the contents of the sorted vector with a binary search.
1165 CMP is the comparison function to pass to bsearch. */
1166
1167template<typename T, typename A>
1168inline T *
1169vec<T, A, vl_embed>::bsearch (const void *key,
1170 int (*compar) (const void *, const void *))
1171{
1172 const void *base = this->address ();
1173 size_t nmemb = this->length ();
1174 size_t size = sizeof (T);
1175 /* The following is a copy of glibc stdlib-bsearch.h. */
1176 size_t l, u, idx;
1177 const void *p;
1178 int comparison;
1179
1180 l = 0;
1181 u = nmemb;
1182 while (l < u)
1183 {
1184 idx = (l + u) / 2;
1185 p = (const void *) (((const char *) base) + (idx * size));
1186 comparison = (*compar) (key, p);
1187 if (comparison < 0)
1188 u = idx;
1189 else if (comparison > 0)
1190 l = idx + 1;
1191 else
1192 return (T *)const_cast<void *>(p);
1193 }
1194
1195 return NULL__null;
1196}
1197
1198/* Search the contents of the sorted vector with a binary search.
1199 CMP is the comparison function to pass to bsearch. */
1200
1201template<typename T, typename A>
1202inline T *
1203vec<T, A, vl_embed>::bsearch (const void *key,
1204 int (*compar) (const void *, const void *,
1205 void *), void *data)
1206{
1207 const void *base = this->address ();
1208 size_t nmemb = this->length ();
1209 size_t size = sizeof (T);
1210 /* The following is a copy of glibc stdlib-bsearch.h. */
1211 size_t l, u, idx;
1212 const void *p;
1213 int comparison;
1214
1215 l = 0;
1216 u = nmemb;
1217 while (l < u)
1218 {
1219 idx = (l + u) / 2;
1220 p = (const void *) (((const char *) base) + (idx * size));
1221 comparison = (*compar) (key, p, data);
1222 if (comparison < 0)
1223 u = idx;
1224 else if (comparison > 0)
1225 l = idx + 1;
1226 else
1227 return (T *)const_cast<void *>(p);
1228 }
1229
1230 return NULL__null;
1231}
1232
1233/* Return true if SEARCH is an element of V. Note that this is O(N) in the
1234 size of the vector and so should be used with care. */
1235
1236template<typename T, typename A>
1237inline bool
1238vec<T, A, vl_embed>::contains (const T &search) const
1239{
1240 unsigned int len = length ();
1241 for (unsigned int i = 0; i < len; i++)
1242 if ((*this)[i] == search)
1243 return true;
1244
1245 return false;
1246}
1247
1248/* Find and return the first position in which OBJ could be inserted
1249 without changing the ordering of this vector. LESSTHAN is a
1250 function that returns true if the first argument is strictly less
1251 than the second. */
1252
1253template<typename T, typename A>
1254unsigned
1255vec<T, A, vl_embed>::lower_bound (T obj, bool (*lessthan)(const T &, const T &))
1256 const
1257{
1258 unsigned int len = length ();
1259 unsigned int half, middle;
1260 unsigned int first = 0;
1261 while (len > 0)
1262 {
1263 half = len / 2;
1264 middle = first;
1265 middle += half;
1266 T middle_elem = (*this)[middle];
1267 if (lessthan (middle_elem, obj))
1268 {
1269 first = middle;
1270 ++first;
1271 len = len - half - 1;
1272 }
1273 else
1274 len = half;
1275 }
1276 return first;
1277}
1278
1279
1280/* Return the number of bytes needed to embed an instance of an
1281 embeddable vec inside another data structure.
1282
1283 Use these methods to determine the required size and initialization
1284 of a vector V of type T embedded within another structure (as the
1285 final member):
1286
1287 size_t vec<T, A, vl_embed>::embedded_size (unsigned alloc);
1288 void v->embedded_init (unsigned alloc, unsigned num);
1289
1290 These allow the caller to perform the memory allocation. */
1291
1292template<typename T, typename A>
1293inline size_t
1294vec<T, A, vl_embed>::embedded_size (unsigned alloc)
1295{
1296 struct alignas (T) U { char data[sizeof (T)]; };
1297 typedef vec<U, A, vl_embed> vec_embedded;
1298 typedef typename std::conditional<std::is_standard_layout<T>::value,
1299 vec, vec_embedded>::type vec_stdlayout;
1300 static_assert (sizeof (vec_stdlayout) == sizeof (vec), "");
1301 static_assert (alignof (vec_stdlayout) == alignof (vec), "");
1302 return offsetof (vec_stdlayout, m_vecdata)__builtin_offsetof(vec_stdlayout, m_vecdata) + alloc * sizeof (T);
1303}
1304
1305
1306/* Initialize the vector to contain room for ALLOC elements and
1307 NUM active elements. */
1308
1309template<typename T, typename A>
1310inline void
1311vec<T, A, vl_embed>::embedded_init (unsigned alloc, unsigned num, unsigned aut)
1312{
1313 m_vecpfx.m_alloc = alloc;
1314 m_vecpfx.m_using_auto_storage = aut;
1315 m_vecpfx.m_num = num;
1316}
1317
1318
1319/* Grow the vector to a specific length. LEN must be as long or longer than
1320 the current length. The new elements are uninitialized. */
1321
1322template<typename T, typename A>
1323inline void
1324vec<T, A, vl_embed>::quick_grow (unsigned len)
1325{
1326 gcc_checking_assert (length () <= len && len <= m_vecpfx.m_alloc)((void)(!(length () <= len && len <= m_vecpfx.m_alloc
) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1326, __FUNCTION__), 0 : 0))
;
1327 m_vecpfx.m_num = len;
1328}
1329
1330
1331/* Grow the vector to a specific length. LEN must be as long or longer than
1332 the current length. The new elements are initialized to zero. */
1333
1334template<typename T, typename A>
1335inline void
1336vec<T, A, vl_embed>::quick_grow_cleared (unsigned len)
1337{
1338 unsigned oldlen = length ();
1339 size_t growby = len - oldlen;
1340 quick_grow (len);
1341 if (growby != 0)
1342 vec_default_construct (address () + oldlen, growby);
1343}
1344
1345/* Garbage collection support for vec<T, A, vl_embed>. */
1346
1347template<typename T>
1348void
1349gt_ggc_mx (vec<T, va_gc> *v)
1350{
1351 extern void gt_ggc_mx (T &);
1352 for (unsigned i = 0; i < v->length (); i++)
1353 gt_ggc_mx ((*v)[i]);
1354}
1355
1356template<typename T>
1357void
1358gt_ggc_mx (vec<T, va_gc_atomic, vl_embed> *v ATTRIBUTE_UNUSED__attribute__ ((__unused__)))
1359{
1360 /* Nothing to do. Vectors of atomic types wrt GC do not need to
1361 be traversed. */
1362}
1363
1364
1365/* PCH support for vec<T, A, vl_embed>. */
1366
1367template<typename T, typename A>
1368void
1369gt_pch_nx (vec<T, A, vl_embed> *v)
1370{
1371 extern void gt_pch_nx (T &);
1372 for (unsigned i = 0; i < v->length (); i++)
1373 gt_pch_nx ((*v)[i]);
1374}
1375
1376template<typename T, typename A>
1377void
1378gt_pch_nx (vec<T *, A, vl_embed> *v, gt_pointer_operator op, void *cookie)
1379{
1380 for (unsigned i = 0; i < v->length (); i++)
1381 op (&((*v)[i]), cookie);
1382}
1383
1384template<typename T, typename A>
1385void
1386gt_pch_nx (vec<T, A, vl_embed> *v, gt_pointer_operator op, void *cookie)
1387{
1388 extern void gt_pch_nx (T *, gt_pointer_operator, void *);
1389 for (unsigned i = 0; i < v->length (); i++)
1390 gt_pch_nx (&((*v)[i]), op, cookie);
1391}
1392
1393
1394/* Space efficient vector. These vectors can grow dynamically and are
1395 allocated together with their control data. They are suited to be
1396 included in data structures. Prior to initial allocation, they
1397 only take a single word of storage.
1398
1399 These vectors are implemented as a pointer to an embeddable vector.
1400 The semantics allow for this pointer to be NULL to represent empty
1401 vectors. This way, empty vectors occupy minimal space in the
1402 structure containing them.
1403
1404 Properties:
1405
1406 - The whole vector and control data are allocated in a single
1407 contiguous block.
1408 - The whole vector may be re-allocated.
1409 - Vector data may grow and shrink.
1410 - Access and manipulation requires a pointer test and
1411 indirection.
1412 - It requires 1 word of storage (prior to vector allocation).
1413
1414
1415 Limitations:
1416
1417 These vectors must be PODs because they are stored in unions.
1418 (http://en.wikipedia.org/wiki/Plain_old_data_structures).
1419 As long as we use C++03, we cannot have constructors nor
1420 destructors in classes that are stored in unions. */
1421
1422template<typename T>
1423struct vec<T, va_heap, vl_ptr>
1424{
1425public:
1426 /* Memory allocation and deallocation for the embedded vector.
1427 Needed because we cannot have proper ctors/dtors defined. */
1428 void create (unsigned nelems CXX_MEM_STAT_INFO);
1429 void release (void);
1430
1431 /* Vector operations. */
1432 bool exists (void) const
1433 { return m_vec != NULL__null; }
1434
1435 bool is_empty (void) const
1436 { return m_vec ? m_vec->is_empty () : true; }
1437
1438 unsigned length (void) const
1439 { return m_vec ? m_vec->length () : 0; }
1440
1441 T *address (void)
1442 { return m_vec ? m_vec->m_vecdata : NULL__null; }
1443
1444 const T *address (void) const
1445 { return m_vec ? m_vec->m_vecdata : NULL__null; }
1446
1447 T *begin () { return address (); }
1448 const T *begin () const { return address (); }
1449 T *end () { return begin () + length (); }
1450 const T *end () const { return begin () + length (); }
1451 const T &operator[] (unsigned ix) const
1452 { return (*m_vec)[ix]; }
1453
1454 bool operator!=(const vec &other) const
1455 { return !(*this == other); }
1456
1457 bool operator==(const vec &other) const
1458 { return address () == other.address (); }
1459
1460 T &operator[] (unsigned ix)
1461 { return (*m_vec)[ix]; }
1462
1463 T &last (void)
1464 { return m_vec->last (); }
1465
1466 bool space (int nelems) const
1467 { return m_vec ? m_vec->space (nelems) : nelems == 0; }
1468
1469 bool iterate (unsigned ix, T *p) const;
1470 bool iterate (unsigned ix, T **p) const;
1471 vec copy (ALONE_CXX_MEM_STAT_INFO) const;
1472 bool reserve (unsigned, bool = false CXX_MEM_STAT_INFO);
1473 bool reserve_exact (unsigned CXX_MEM_STAT_INFO);
1474 void splice (const vec &);
1475 void safe_splice (const vec & CXX_MEM_STAT_INFO);
1476 T *quick_push (const T &);
1477 T *safe_push (const T &CXX_MEM_STAT_INFO);
1478 T &pop (void);
1479 void truncate (unsigned);
1480 void safe_grow (unsigned, bool = false CXX_MEM_STAT_INFO);
1481 void safe_grow_cleared (unsigned, bool = false CXX_MEM_STAT_INFO);
1482 void quick_grow (unsigned);
1483 void quick_grow_cleared (unsigned);
1484 void quick_insert (unsigned, const T &);
1485 void safe_insert (unsigned, const T & CXX_MEM_STAT_INFO);
1486 void ordered_remove (unsigned);
1487 void unordered_remove (unsigned);
1488 void block_remove (unsigned, unsigned);
1489 void qsort (int (*) (const void *, const void *))qsort (int (*) (const void *, const void *));
1490 void sort (int (*) (const void *, const void *, void *), void *);
1491 T *bsearch (const void *key, int (*compar)(const void *, const void *));
1492 T *bsearch (const void *key,
1493 int (*compar)(const void *, const void *, void *), void *);
1494 unsigned lower_bound (T, bool (*)(const T &, const T &)) const;
1495 bool contains (const T &search) const;
1496 void reverse (void);
1497
1498 bool using_auto_storage () const;
1499
1500 /* FIXME - This field should be private, but we need to cater to
1501 compilers that have stricter notions of PODness for types. */
1502 vec<T, va_heap, vl_embed> *m_vec;
1503};
1504
1505
1506/* auto_vec is a subclass of vec that automatically manages creating and
1507 releasing the internal vector. If N is non zero then it has N elements of
1508 internal storage. The default is no internal storage, and you probably only
1509 want to ask for internal storage for vectors on the stack because if the
1510 size of the vector is larger than the internal storage that space is wasted.
1511 */
1512template<typename T, size_t N = 0>
1513class auto_vec : public vec<T, va_heap>
1514{
1515public:
1516 auto_vec ()
1517 {
1518 m_auto.embedded_init (MAX (N, 2)((N) > (2) ? (N) : (2)), 0, 1);
1519 this->m_vec = &m_auto;
1520 }
1521
1522 auto_vec (size_t s)
1523 {
1524 if (s > N)
1525 {
1526 this->create (s);
1527 return;
1528 }
1529
1530 m_auto.embedded_init (MAX (N, 2)((N) > (2) ? (N) : (2)), 0, 1);
1531 this->m_vec = &m_auto;
1532 }
1533
1534 ~auto_vec ()
1535 {
1536 this->release ();
1537 }
1538
1539private:
1540 vec<T, va_heap, vl_embed> m_auto;
1541 T m_data[MAX (N - 1, 1)((N - 1) > (1) ? (N - 1) : (1))];
1542};
1543
1544/* auto_vec is a sub class of vec whose storage is released when it is
1545 destroyed. */
1546template<typename T>
1547class auto_vec<T, 0> : public vec<T, va_heap>
1548{
1549public:
1550 auto_vec () { this->m_vec = NULL__null; }
1551 auto_vec (size_t n) { this->create (n); }
1552 ~auto_vec () { this->release (); }
1553
1554 auto_vec (vec<T, va_heap>&& r)
1555 {
1556 gcc_assert (!r.using_auto_storage ())((void)(!(!r.using_auto_storage ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1556, __FUNCTION__), 0 : 0))
;
1557 this->m_vec = r.m_vec;
1558 r.m_vec = NULL__null;
1559 }
1560 auto_vec& operator= (vec<T, va_heap>&& r)
1561 {
1562 gcc_assert (!r.using_auto_storage ())((void)(!(!r.using_auto_storage ()) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/vec.h"
, 1562, __FUNCTION__), 0 : 0))
;
1563 this->release ();
1564 this->m_vec = r.m_vec;
1565 r.m_vec = NULL__null;
1566 return *this;
1567 }
1568};
1569
1570
1571/* Allocate heap memory for pointer V and create the internal vector
1572 with space for NELEMS elements. If NELEMS is 0, the internal
1573 vector is initialized to empty. */
1574
1575template<typename T>
1576inline void
1577vec_alloc (vec<T> *&v, unsigned nelems CXX_MEM_STAT_INFO)
1578{
1579 v = new vec<T>;
1580 v->create (nelems PASS_MEM_STAT);
1581}
1582
1583
1584/* A subclass of auto_vec <char *> that frees all of its elements on
1585 deletion. */
1586
1587class auto_string_vec : public auto_vec <char *>
1588{
1589 public:
1590 ~auto_string_vec ();
1591};
1592
1593/* A subclass of auto_vec <T *> that deletes all of its elements on
1594 destruction.
1595
1596 This is a crude way for a vec to "own" the objects it points to
1597 and clean up automatically.
1598
1599 For example, no attempt is made to delete elements when an item
1600 within the vec is overwritten.
1601
1602 We can't rely on gnu::unique_ptr within a container,
1603 since we can't rely on move semantics in C++98. */
1604
1605template <typename T>
1606class auto_delete_vec : public auto_vec <T *>
1607{
1608 public:
1609 auto_delete_vec () {}
1610 auto_delete_vec (size_t s) : auto_vec <T *> (s) {}
1611
1612 ~auto_delete_vec ();
1613
1614private:
1615 DISABLE_COPY_AND_ASSIGN(auto_delete_vec)auto_delete_vec (const auto_delete_vec&) = delete; void operator
= (const auto_delete_vec &) = delete
;
1616};
1617
1618/* Conditionally allocate heap memory for VEC and its internal vector. */
1619
1620template<typename T>
1621inline void
1622vec_check_alloc (vec<T, va_heap> *&vec, unsigned nelems CXX_MEM_STAT_INFO)
1623{
1624 if (!vec)
1625 vec_alloc (vec, nelems PASS_MEM_STAT);
1626}
1627
1628
1629/* Free the heap memory allocated by vector V and set it to NULL. */
1630
1631template<typename T>
1632inline void
1633vec_free (vec<T> *&v)
1634{
1635 if (v == NULL__null)
1636 return;
1637
1638 v->release ();
1639 delete v;
1640 v = NULL__null;
1641}
1642
1643
1644/* Return iteration condition and update PTR to point to the IX'th
1645 element of this vector. Use this to iterate over the elements of a
1646 vector as follows,
1647
1648 for (ix = 0; v.iterate (ix, &ptr); ix++)
1649 continue; */
1650
1651template<typename T>
1652inline bool
1653vec<T, va_heap, vl_ptr>::iterate (unsigned ix, T *ptr) const
1654{
1655 if (m_vec)
1656 return m_vec->iterate (ix, ptr);
1657 else
1658 {
1659 *ptr = 0;
1660 return false;
1661 }
1662}
1663
1664
1665/* Return iteration condition and update *PTR to point to the
1666 IX'th element of this vector. Use this to iterate over the
1667 elements of a vector as follows,
1668
1669 for (ix = 0; v->iterate (ix, &ptr); ix++)
1670 continue;
1671
1672 This variant is for vectors of objects. */
1673
1674template<typename T>
1675inline bool
1676vec<T, va_heap, vl_ptr>::iterate (unsigned ix, T **ptr) const
1677{
1678 if (m_vec)
1679 return m_vec->iterate (ix, ptr);
1680 else
1681 {
1682 *ptr = 0;
1683 return false;
1684 }
1685}
1686
1687
1688/* Convenience macro for forward iteration. */
1689#define FOR_EACH_VEC_ELT(V, I, P)for (I = 0; (V).iterate ((I), &(P)); ++(I)) \
1690 for (I = 0; (V).iterate ((I), &(P)); ++(I))
1691
1692#define FOR_EACH_VEC_SAFE_ELT(V, I, P)for (I = 0; vec_safe_iterate ((V), (I), &(P)); ++(I)) \
1693 for (I = 0; vec_safe_iterate ((V), (I), &(P)); ++(I))
1694
1695/* Likewise, but start from FROM rather than 0. */
1696#define FOR_EACH_VEC_ELT_FROM(V, I, P, FROM)for (I = (FROM); (V).iterate ((I), &(P)); ++(I)) \
1697 for (I = (FROM); (V).iterate ((I), &(P)); ++(I))
1698
1699/* Convenience macro for reverse iteration. */
1700#define FOR_EACH_VEC_ELT_REVERSE(V, I, P)for (I = (V).length () - 1; (V).iterate ((I), &(P)); (I)--
)
\
1701 for (I = (V).length () - 1; \
1702 (V).iterate ((I), &(P)); \
1703 (I)--)
1704
1705#define FOR_EACH_VEC_SAFE_ELT_REVERSE(V, I, P)for (I = vec_safe_length (V) - 1; vec_safe_iterate ((V), (I),
&(P)); (I)--)
\
1706 for (I = vec_safe_length (V) - 1; \
1707 vec_safe_iterate ((V), (I), &(P)); \
1708 (I)--)
1709
1710/* auto_string_vec's dtor, freeing all contained strings, automatically
1711 chaining up to ~auto_vec <char *>, which frees the internal buffer. */
1712
1713inline
1714auto_string_vec::~auto_string_vec ()
1715{
1716 int i;
1717 char *str;
1718 FOR_EACH_VEC_ELT (*this, i, str)for (i = 0; (*this).iterate ((i), &(str)); ++(i))
1719 free (str);
1720}
1721
1722/* auto_delete_vec's dtor, deleting all contained items, automatically
1723 chaining up to ~auto_vec <T*>, which frees the internal buffer. */
1724
1725template <typename T>
1726inline
1727auto_delete_vec<T>::~auto_delete_vec ()
1728{
1729 int i;
1730 T *item;
1731 FOR_EACH_VEC_ELT (*this, i, item)for (i = 0; (*this).iterate ((i), &(item)); ++(i))
1732 delete item;
1733}
1734
1735
1736/* Return a copy of this vector. */
1737
1738template<typename T>
1739inline vec<T, va_heap, vl_ptr>
1740vec<T, va_heap, vl_ptr>::copy (ALONE_MEM_STAT_DECLvoid) const
1741{
1742 vec<T, va_heap, vl_ptr> new_vec = vNULL;
1743 if (length ())
1744 new_vec.m_vec = m_vec->copy (ALONE_PASS_MEM_STAT);
1745 return new_vec;
1746}
1747
1748
1749/* Ensure that the vector has at least RESERVE slots available (if
1750 EXACT is false), or exactly RESERVE slots available (if EXACT is
1751 true).
1752
1753 This may create additional headroom if EXACT is false.
1754
1755 Note that this can cause the embedded vector to be reallocated.
1756 Returns true iff reallocation actually occurred. */
1757
1758template<typename T>
1759inline bool
1760vec<T, va_heap, vl_ptr>::reserve (unsigned nelems, bool exact MEM_STAT_DECL)
1761{
1762 if (space (nelems))
1763 return false;
1764
1765 /* For now play a game with va_heap::reserve to hide our auto storage if any,
1766 this is necessary because it doesn't have enough information to know the
1767 embedded vector is in auto storage, and so should not be freed. */
1768 vec<T, va_heap, vl_embed> *oldvec = m_vec;
1769 unsigned int oldsize = 0;
1770 bool handle_auto_vec = m_vec && using_auto_storage ();
1771 if (handle_auto_vec)
1772 {
1773 m_vec = NULL__null;
1774 oldsize = oldvec->length ();
1775 nelems += oldsize;
1776 }
1777
1778 va_heap::reserve (m_vec, nelems, exact PASS_MEM_STAT);
1779 if (handle_auto_vec)
1780 {
1781 vec_copy_construct (m_vec->address (), oldvec->address (), oldsize);
1782 m_vec->m_vecpfx.m_num = oldsize;
1783 }
1784
1785 return true;
1786}
1787
1788
1789/* Ensure that this vector has exactly NELEMS slots available. This
1790 will not create additional headroom. Note this can cause the
1791 embedded vector to be reallocated. Returns true iff reallocation
1792 actually occurred. */
1793
1794template<typename T>
1795inline bool
1796vec<T, va_heap, vl_ptr>::reserve_exact (unsigned nelems MEM_STAT_DECL)
1797{
1798 return reserve (nelems, true PASS_MEM_STAT);
1799}
1800
1801
1802/* Create the internal vector and reserve NELEMS for it. This is
1803 exactly like vec::reserve, but the internal vector is
1804 unconditionally allocated from scratch. The old one, if it
1805 existed, is lost. */
1806
1807template<typename T>
1808inline void
1809vec<T, va_heap, vl_ptr>::create (unsigned nelems MEM_STAT_DECL)
1810{
1811 m_vec = NULL__null;
1812 if (nelems > 0)
1813 reserve_exact (nelems PASS_MEM_STAT);
1814}
1815
1816
1817/* Free the memory occupied by the embedded vector. */
1818
1819template<typename T>
1820inline void
1821vec<T, va_heap, vl_ptr>::release (void)
1822{
1823 if (!m_vec)
1824 return;
1825