Bug Summary

File:build/gcc/fortran/target-memory.cc
Warning:line 707, column 32
The left operand of '!=' is a garbage value due to array index out of bounds

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-suse-linux -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name target-memory.cc -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=cplusplus -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -analyzer-config-compatibility-mode=true -mrelocation-model static -mframe-pointer=none -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -resource-dir /usr/lib64/clang/15.0.7 -D IN_GCC_FRONTEND -D IN_GCC -D HAVE_CONFIG_H -I . -I fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcpp/include -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libcody -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libdecnumber/bid -I ../libdecnumber -I /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/../libbacktrace -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13 -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/x86_64-suse-linux -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../include/c++/13/backward -internal-isystem /usr/lib64/clang/15.0.7/include -internal-isystem /usr/local/include -internal-isystem /usr/bin/../lib64/gcc/x86_64-suse-linux/13/../../../../x86_64-suse-linux/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O2 -Wno-narrowing -Wwrite-strings -Wno-long-long -Wno-variadic-macros -Wno-overlength-strings -fdeprecated-macro -fdebug-compilation-dir=/buildworker/marxinbox-gcc-clang-static-analyzer/objdir/gcc -ferror-limit 19 -fno-rtti -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -analyzer-output=plist-html -analyzer-config silence-checkers=core.NullDereference -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /buildworker/marxinbox-gcc-clang-static-analyzer/objdir/clang-static-analyzer/2023-03-27-141847-20772-1/report-N4hGee.plist -x c++ /buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc
1/* Simulate storage of variables into target memory.
2 Copyright (C) 2007-2023 Free Software Foundation, Inc.
3 Contributed by Paul Thomas and Brooks Moses
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along with GCC; see the file COPYING3. If not see
19<http://www.gnu.org/licenses/>. */
20
21#include "config.h"
22#include "system.h"
23#include "coretypes.h"
24#include "tree.h"
25#include "gfortran.h"
26#include "trans.h"
27#include "fold-const.h"
28#include "stor-layout.h"
29#include "arith.h"
30#include "constructor.h"
31#include "trans-const.h"
32#include "trans-types.h"
33#include "target-memory.h"
34
35/* --------------------------------------------------------------- */
36/* Calculate the size of an expression. */
37
38
39static size_t
40size_integer (int kind)
41{
42 return GET_MODE_SIZE (SCALAR_INT_TYPE_MODE (gfc_get_int_type (kind))(as_a <scalar_int_mode> ((tree_class_check ((gfc_get_int_type
(kind)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 42, __FUNCTION__))->type_common.mode)));
43}
44
45
46static size_t
47size_float (int kind)
48{
49 return GET_MODE_SIZE (SCALAR_FLOAT_TYPE_MODE (gfc_get_real_type (kind))(as_a <scalar_float_mode> ((tree_class_check ((gfc_get_real_type
(kind)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 49, __FUNCTION__))->type_common.mode)));
50}
51
52
53static size_t
54size_complex (int kind)
55{
56 return 2 * size_float (kind);
57}
58
59
60static size_t
61size_logical (int kind)
62{
63 return GET_MODE_SIZE (SCALAR_INT_TYPE_MODE (gfc_get_logical_type (kind))(as_a <scalar_int_mode> ((tree_class_check ((gfc_get_logical_type
(kind)), (tcc_type), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 63, __FUNCTION__))->type_common.mode)));
64}
65
66
67static size_t
68size_character (gfc_charlen_t length, int kind)
69{
70 int i = gfc_validate_kind (BT_CHARACTER, kind, false);
71 return length * gfc_character_kinds[i].bit_size / 8;
72}
73
74
75/* Return the size of a single element of the given expression.
76 Equivalent to gfc_target_expr_size for scalars. */
77
78bool
79gfc_element_size (gfc_expr *e, size_t *siz)
80{
81 tree type;
82
83 switch (e->ts.type)
84 {
85 case BT_INTEGER:
86 *siz = size_integer (e->ts.kind);
87 return true;
88 case BT_REAL:
89 *siz = size_float (e->ts.kind);
90 return true;
91 case BT_COMPLEX:
92 *siz = size_complex (e->ts.kind);
93 return true;
94 case BT_LOGICAL:
95 *siz = size_logical (e->ts.kind);
96 return true;
97 case BT_CHARACTER:
98 if (e->expr_type == EXPR_CONSTANT)
99 *siz = size_character (e->value.character.length, e->ts.kind);
100 else if (e->ts.u.cl != NULL__null && e->ts.u.cl->length != NULL__null
101 && e->ts.u.cl->length->expr_type == EXPR_CONSTANT
102 && e->ts.u.cl->length->ts.type == BT_INTEGER)
103 {
104 HOST_WIDE_INTlong length;
105
106 gfc_extract_hwi (e->ts.u.cl->length, &length);
107 *siz = size_character (length, e->ts.kind);
108 }
109 else
110 {
111 *siz = 0;
112 return false;
113 }
114 return true;
115
116 case BT_HOLLERITH:
117 *siz = e->representation.length;
118 return true;
119 case BT_DERIVED:
120 case BT_CLASS:
121 case BT_VOID:
122 case BT_ASSUMED:
123 case BT_PROCEDURE:
124 {
125 /* Determine type size without clobbering the typespec for ISO C
126 binding types. */
127 gfc_typespec ts;
128 HOST_WIDE_INTlong size;
129 ts = e->ts;
130 type = gfc_typenode_for_spec (&ts);
131 size = int_size_in_bytes (type);
132 gcc_assert (size >= 0)((void)(!(size >= 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 132, __FUNCTION__), 0 : 0));
133 *siz = size;
134 }
135 return true;
136 default:
137 gfc_internal_error ("Invalid expression in gfc_element_size.");
138 *siz = 0;
139 return false;
140 }
141}
142
143
144/* Return the size of an expression in its target representation. */
145
146bool
147gfc_target_expr_size (gfc_expr *e, size_t *size)
148{
149 mpz_t tmp;
150 size_t asz, el_size;
151
152 gcc_assert (e != NULL)((void)(!(e != __null) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 152, __FUNCTION__), 0 : 0));
153
154 *size = 0;
155 if (e->rank)
156 {
157 if (gfc_array_size (e, &tmp))
158 asz = mpz_get_ui__gmpz_get_ui (tmp);
159 else
160 return false;
161 }
162 else
163 asz = 1;
164
165 if (!gfc_element_size (e, &el_size))
166 return false;
167 *size = asz * el_size;
168 return true;
169}
170
171
172/* The encode_* functions export a value into a buffer, and
173 return the number of bytes of the buffer that have been
174 used. */
175
176static unsigned HOST_WIDE_INTlong
177encode_array (gfc_expr *expr, unsigned char *buffer, size_t buffer_size)
178{
179 mpz_t array_size;
180 int i;
181 int ptr = 0;
182
183 gfc_constructor_base ctor = expr->value.constructor;
184
185 gfc_array_size (expr, &array_size);
186 for (i = 0; i < (int)mpz_get_ui__gmpz_get_ui (array_size); i++)
187 {
188 ptr += gfc_target_encode_expr (gfc_constructor_lookup_expr (ctor, i),
189 &buffer[ptr], buffer_size - ptr);
190 }
191
192 mpz_clear__gmpz_clear (array_size);
193 return ptr;
194}
195
196
197static int
198encode_integer (int kind, mpz_t integer, unsigned char *buffer,
199 size_t buffer_size)
200{
201 return native_encode_expr (gfc_conv_mpz_to_tree (integer, kind),
202 buffer, buffer_size);
203}
204
205
206static int
207encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
208{
209 return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind, 0), buffer,
210 buffer_size);
211}
212
213
214static int
215encode_complex (int kind, mpc_t cmplx,
216 unsigned char *buffer, size_t buffer_size)
217{
218 int size;
219 size = encode_float (kind, mpc_realref (cmplx)((cmplx)->re), &buffer[0], buffer_size);
220 size += encode_float (kind, mpc_imagref (cmplx)((cmplx)->im),
221 &buffer[size], buffer_size - size);
222 return size;
223}
224
225
226static int
227encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size)
228{
229 return native_encode_expr (build_int_cst (gfc_get_logical_type (kind),
230 logical),
231 buffer, buffer_size);
232}
233
234
235size_t
236gfc_encode_character (int kind, size_t length, const gfc_char_t *string,
237 unsigned char *buffer, size_t buffer_size)
238{
239 size_t elsize = size_character (1, kind);
240 tree type = gfc_get_char_type (kind);
241
242 gcc_assert (buffer_size >= size_character (length, kind))((void)(!(buffer_size >= size_character (length, kind)) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 242, __FUNCTION__), 0 : 0));
243
244 for (size_t i = 0; i < length; i++)
245 native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
246 elsize);
247
248 return length;
249}
250
251
252static unsigned HOST_WIDE_INTlong
253encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size)
254{
255 gfc_constructor *c;
256 gfc_component *cmp;
257 int ptr;
258 tree type;
259 HOST_WIDE_INTlong size;
260
261 type = gfc_typenode_for_spec (&source->ts);
262
263 for (c = gfc_constructor_first (source->value.constructor),
18
←
Loop condition is false. Execution continues on line 285
→
264 cmp = source->ts.u.derived->components;
265 c;
266 c = gfc_constructor_next (c), cmp = cmp->next)
267 {
268 gcc_assert (cmp)((void)(!(cmp) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 268, __FUNCTION__), 0 : 0));
269 if (!c->expr)
270 continue;
271 ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp
->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 271, __FUNCTION__, (FIELD_DECL)))->field_decl.offset)), (
0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 271, __FUNCTION__)))
272 + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp
->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 272, __FUNCTION__, (FIELD_DECL)))->field_decl.bit_offset
)), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 272, __FUNCTION__)))/8;
273
274 if (c->expr->expr_type == EXPR_NULL)
275 {
276 size = int_size_in_bytes (TREE_TYPE (cmp->backend_decl)((contains_struct_check ((cmp->backend_decl), (TS_TYPED), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 276, __FUNCTION__))->typed.type));
277 gcc_assert (size >= 0)((void)(!(size >= 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 277, __FUNCTION__), 0 : 0));
278 memset (&buffer[ptr], 0, size);
279 }
280 else
281 gfc_target_encode_expr (c->expr, &buffer[ptr],
282 buffer_size - ptr);
283 }
284
285 size = int_size_in_bytes (type);
286 gcc_assert (size >= 0)((void)(!(size >= 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 286, __FUNCTION__), 0 : 0));
19
←
Assuming 'size' is >= 0
→
20
←
'?' condition is false
→
287 return size;
21
←
Returning without writing to '*buffer'
→
288}
289
290
291/* Write a constant expression in binary form to a buffer. */
292unsigned HOST_WIDE_INTlong
293gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
294 size_t buffer_size)
295{
296 if (source
6.1
'source' is not equal to NULL
 == NULL__null)
7
←
Taking false branch
→
297 return 0;
298
299 if (source->expr_type == EXPR_ARRAY)
8
←
Assuming field 'expr_type' is not equal to EXPR_ARRAY
→
300 return encode_array (source, buffer, buffer_size);
301
302 gcc_assert (source->expr_type == EXPR_CONSTANT((void)(!(source->expr_type == EXPR_CONSTANT || source->
expr_type == EXPR_STRUCTURE || source->expr_type == EXPR_SUBSTRING
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 304, __FUNCTION__), 0 : 0))
9
←
Taking false branch
→
10
←
Assuming field 'expr_type' is equal to EXPR_CONSTANT
→
11
←
'?' condition is false
→
303 || source->expr_type == EXPR_STRUCTURE((void)(!(source->expr_type == EXPR_CONSTANT || source->
expr_type == EXPR_STRUCTURE || source->expr_type == EXPR_SUBSTRING
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 304, __FUNCTION__), 0 : 0))
304 || source->expr_type == EXPR_SUBSTRING)((void)(!(source->expr_type == EXPR_CONSTANT || source->
expr_type == EXPR_STRUCTURE || source->expr_type == EXPR_SUBSTRING
) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 304, __FUNCTION__), 0 : 0));
305
306 /* If we already have a target-memory representation, we use that rather
307 than recreating one. */
308 if (source->representation.string)
12
←
Assuming field 'string' is null
→
13
←
Taking false branch
→
309 {
310 memcpy (buffer, source->representation.string,
311 source->representation.length);
312 return source->representation.length;
313 }
314
315 switch (source->ts.type)
14
←
Control jumps to 'case BT_DERIVED:' at line 347
→
316 {
317 case BT_INTEGER:
318 return encode_integer (source->ts.kind, source->value.integer, buffer,
319 buffer_size);
320 case BT_REAL:
321 return encode_float (source->ts.kind, source->value.real, buffer,
322 buffer_size);
323 case BT_COMPLEX:
324 return encode_complex (source->ts.kind, source->value.complex,
325 buffer, buffer_size);
326 case BT_LOGICAL:
327 return encode_logical (source->ts.kind, source->value.logical, buffer,
328 buffer_size);
329 case BT_CHARACTER:
330 if (source->expr_type == EXPR_CONSTANT || source->ref == NULL__null)
331 return gfc_encode_character (source->ts.kind,
332 source->value.character.length,
333 source->value.character.string,
334 buffer, buffer_size);
335 else
336 {
337 HOST_WIDE_INTlong start, end;
338
339 gcc_assert (source->expr_type == EXPR_SUBSTRING)((void)(!(source->expr_type == EXPR_SUBSTRING) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 339, __FUNCTION__), 0 : 0));
340 gfc_extract_hwi (source->ref->u.ss.start, &start);
341 gfc_extract_hwi (source->ref->u.ss.end, &end);
342 return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0)((end - start + 1) > (0) ? (end - start + 1) : (0)),
343 &source->value.character.string[start-1],
344 buffer, buffer_size);
345 }
346
347 case BT_DERIVED:
348 if (source->ts.u.derived->ts.f90_type == BT_VOID)
15
←
Assuming field 'f90_type' is not equal to BT_VOID
→
16
←
Taking false branch
→
349 {
350 gfc_constructor *c;
351 gcc_assert (source->expr_type == EXPR_STRUCTURE)((void)(!(source->expr_type == EXPR_STRUCTURE) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 351, __FUNCTION__), 0 : 0));
352 c = gfc_constructor_first (source->value.constructor);
353 gcc_assert (c->expr->expr_type == EXPR_CONSTANT((void)(!(c->expr->expr_type == EXPR_CONSTANT &&
c->expr->ts.type == BT_INTEGER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 354, __FUNCTION__), 0 : 0))
354 && c->expr->ts.type == BT_INTEGER)((void)(!(c->expr->expr_type == EXPR_CONSTANT &&
c->expr->ts.type == BT_INTEGER) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 354, __FUNCTION__), 0 : 0));
355 return encode_integer (gfc_index_integer_kind, c->expr->value.integer,
356 buffer, buffer_size);
357 }
358
359 return encode_derived (source, buffer, buffer_size);
17
←
Calling 'encode_derived'
→
22
←
Returning from 'encode_derived'
→
23
←
Returning without writing to '*buffer'
→
360 default:
361 gfc_internal_error ("Invalid expression in gfc_target_encode_expr.");
362 return 0;
363 }
364}
365
366
367static size_t
368interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result,
369 bool convert_widechar)
370{
371 gfc_constructor_base base = NULL__null;
372 size_t array_size = 1;
373 size_t ptr = 0;
374
375 /* Calculate array size from its shape and rank. */
376 gcc_assert (result->rank > 0 && result->shape)((void)(!(result->rank > 0 && result->shape)
? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 376, __FUNCTION__), 0 : 0));
377
378 for (int i = 0; i < result->rank; i++)
379 array_size *= mpz_get_ui__gmpz_get_ui (result->shape[i]);
380
381 /* Iterate over array elements, producing constructors. */
382 for (size_t i = 0; i < array_size; i++)
383 {
384 gfc_expr *e = gfc_get_constant_expr (result->ts.type, result->ts.kind,
385 &result->where);
386 e->ts = result->ts;
387
388 if (e->ts.type == BT_CHARACTER)
389 e->value.character.length = result->value.character.length;
390
391 gfc_constructor_append_expr (&base, e, &result->where);
392
393 ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e,
394 convert_widechar);
395 }
396
397 result->value.constructor = base;
398 return ptr;
399}
400
401
402int
403gfc_interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
404 mpz_t integer)
405{
406 mpz_init__gmpz_init (integer);
407 gfc_conv_tree_to_mpz (integer,
408 native_interpret_expr (gfc_get_int_type (kind),
409 buffer, buffer_size));
410 return size_integer (kind);
411}
412
413
414int
415gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
416 mpfr_t real)
417{
418 gfc_set_model_kind (kind);
419
420 tree source = native_interpret_expr (gfc_get_real_type (kind), buffer,
421 buffer_size);
422 if (!source)
423 return 0;
424
425 mpfr_init (real);
426 gfc_conv_tree_to_mpfr (real, source);
427 return size_float (kind);
428}
429
430
431int
432gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
433 mpc_t complex)
434{
435 int size;
436 size = gfc_interpret_float (kind, &buffer[0], buffer_size,
437 mpc_realref (complex)((complex)->re));
438 size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
439 mpc_imagref (complex)((complex)->im));
440 return size;
441}
442
443
444int
445gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
446 int *logical)
447{
448 tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer,
449 buffer_size);
450 *logical = wi::to_wide (t) == 0 ? 0 : 1;
451 return size_logical (kind);
452}
453
454
455size_t
456gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
457 gfc_expr *result)
458{
459 if (result->ts.u.cl && result->ts.u.cl->length)
460 result->value.character.length =
461 gfc_mpz_get_hwi (result->ts.u.cl->length->value.integer);
462
463 gcc_assert (buffer_size >= size_character (result->value.character.length,((void)(!(buffer_size >= size_character (result->value.
character.length, result->ts.kind)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 464, __FUNCTION__), 0 : 0))
464 result->ts.kind))((void)(!(buffer_size >= size_character (result->value.
character.length, result->ts.kind)) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 464, __FUNCTION__), 0 : 0));
465 result->value.character.string =
466 gfc_get_wide_string (result->value.character.length + 1)((gfc_char_t *) xcalloc ((result->value.character.length +
1), sizeof (gfc_char_t)));
467
468 if (result->ts.kind == gfc_default_character_kind)
469 for (size_t i = 0; i < (size_t) result->value.character.length; i++)
470 result->value.character.string[i] = (gfc_char_t) buffer[i];
471 else
472 {
473 mpz_t integer;
474 size_t bytes = size_character (1, result->ts.kind);
475 mpz_init__gmpz_init (integer);
476 gcc_assert (bytes <= sizeof (unsigned long))((void)(!(bytes <= sizeof (unsigned long)) ? fancy_abort (
"/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 476, __FUNCTION__), 0 : 0));
477
478 for (size_t i = 0; i < (size_t) result->value.character.length; i++)
479 {
480 gfc_conv_tree_to_mpz (integer,
481 native_interpret_expr (gfc_get_char_type (result->ts.kind),
482 &buffer[bytes*i], buffer_size-bytes*i));
483 result->value.character.string[i]
484 = (gfc_char_t) mpz_get_ui__gmpz_get_ui (integer);
485 }
486
487 mpz_clear__gmpz_clear (integer);
488 }
489
490 result->value.character.string[result->value.character.length] = '\0';
491
492 return size_character (result->value.character.length, result->ts.kind);
493}
494
495
496int
497gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
498{
499 gfc_component *cmp;
500 int ptr;
501 tree type;
502
503 /* The attributes of the derived type need to be bolted to the floor. */
504 result->expr_type = EXPR_STRUCTURE;
505
506 cmp = result->ts.u.derived->components;
507
508 if (result->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING
509 && (result->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
510 || result->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR))
511 {
512 gfc_constructor *c;
513 gfc_expr *e;
514 /* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec
515 sets this to BT_INTEGER. */
516 result->ts.type = BT_DERIVED;
517 e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where);
518 c = gfc_constructor_append_expr (&result->value.constructor, e, NULL__null);
519 c->n.component = cmp;
520 gfc_target_interpret_expr (buffer, buffer_size, e, true);
521 e->ts.is_iso_c = 1;
522 return int_size_in_bytes (ptr_type_nodeglobal_trees[TI_PTR_TYPE]);
523 }
524
525 type = gfc_typenode_for_spec (&result->ts);
526
527 /* Run through the derived type components. */
528 for (;cmp; cmp = cmp->next)
529 {
530 gfc_constructor *c;
531 gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind,
532 &result->where);
533 e->ts = cmp->ts;
534
535 /* Copy shape, if needed. */
536 if (cmp->as && cmp->as->rank)
537 {
538 int n;
539
540 if (cmp->as->type != AS_EXPLICIT)
541 return 0;
542
543 e->expr_type = EXPR_ARRAY;
544 e->rank = cmp->as->rank;
545
546 e->shape = gfc_get_shape (e->rank)(((mpz_t *) xcalloc (((e->rank)), sizeof (mpz_t))));
547 for (n = 0; n < e->rank; n++)
548 {
549 mpz_init_set_ui__gmpz_init_set_ui (e->shape[n], 1);
550 mpz_add__gmpz_add (e->shape[n], e->shape[n],
551 cmp->as->upper[n]->value.integer);
552 mpz_sub__gmpz_sub (e->shape[n], e->shape[n],
553 cmp->as->lower[n]->value.integer);
554 }
555 }
556
557 c = gfc_constructor_append_expr (&result->value.constructor, e, NULL__null);
558
559 /* The constructor points to the component. */
560 c->n.component = cmp;
561
562 /* Calculate the offset, which consists of the FIELD_OFFSET in
563 bytes, which appears in multiples of DECL_OFFSET_ALIGN-bit-sized,
564 and additional bits of FIELD_BIT_OFFSET. The code assumes that all
565 sizes of the components are multiples of BITS_PER_UNIT,
566 i.e. there are, e.g., no bit fields. */
567
568 gcc_assert (cmp->backend_decl)((void)(!(cmp->backend_decl) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 568, __FUNCTION__), 0 : 0));
569 ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp
->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 569, __FUNCTION__, (FIELD_DECL)))->field_decl.bit_offset
)), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 569, __FUNCTION__)));
570 gcc_assert (ptr % 8 == 0)((void)(!(ptr % 8 == 0) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 570, __FUNCTION__), 0 : 0));
571 ptr = ptr/8 + TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp
->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 571, __FUNCTION__, (FIELD_DECL)))->field_decl.offset)), (
0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 571, __FUNCTION__)));
572
573 gcc_assert (e->ts.type != BT_VOID || cmp->attr.caf_token)((void)(!(e->ts.type != BT_VOID || cmp->attr.caf_token)
? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 573, __FUNCTION__), 0 : 0));
574 gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e, true);
575 }
576
577 return int_size_in_bytes (type);
578}
579
580
581/* Read a binary buffer to a constant expression. */
582size_t
583gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
584 gfc_expr *result, bool convert_widechar)
585{
586 if (result->expr_type == EXPR_ARRAY)
587 return interpret_array (buffer, buffer_size, result, convert_widechar);
588
589 switch (result->ts.type)
590 {
591 case BT_INTEGER:
592 result->representation.length =
593 gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
594 result->value.integer);
595 break;
596
597 case BT_REAL:
598 result->representation.length =
599 gfc_interpret_float (result->ts.kind, buffer, buffer_size,
600 result->value.real);
601 break;
602
603 case BT_COMPLEX:
604 result->representation.length =
605 gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
606 result->value.complex);
607 break;
608
609 case BT_LOGICAL:
610 result->representation.length =
611 gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
612 &result->value.logical);
613 break;
614
615 case BT_CHARACTER:
616 result->representation.length =
617 gfc_interpret_character (buffer, buffer_size, result);
618 break;
619
620 case BT_CLASS:
621 result->ts = CLASS_DATA (result)result->ts.u.derived->components->ts;
622 /* Fall through. */
623 case BT_DERIVED:
624 result->representation.length =
625 gfc_interpret_derived (buffer, buffer_size, result);
626 gcc_assert (result->representation.length >= 0)((void)(!(result->representation.length >= 0) ? fancy_abort
("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 626, __FUNCTION__), 0 : 0));
627 break;
628
629 case BT_VOID:
630 /* This deals with caf_tokens. */
631 result->representation.length =
632 gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
633 result->value.integer);
634 break;
635
636 default:
637 gfc_internal_error ("Invalid expression in gfc_target_interpret_expr.");
638 break;
639 }
640
641 if (result->ts.type == BT_CHARACTER && convert_widechar)
642 result->representation.string
643 = gfc_widechar_to_char (result->value.character.string,
644 result->value.character.length);
645 else
646 {
647 result->representation.string =
648 XCNEWVEC (char, result->representation.length + 1)((char *) xcalloc ((result->representation.length + 1), sizeof
(char)));
649 memcpy (result->representation.string, buffer,
650 result->representation.length);
651 result->representation.string[result->representation.length] = '\0';
652 }
653
654 return result->representation.length;
655}
656
657
658/* --------------------------------------------------------------- */
659/* Two functions used by trans-common.cc to write overlapping
660 equivalence initializers to a buffer. This is added to the union
661 and the original initializers freed. */
662
663
664/* Writes the values of a constant expression to a char buffer. If another
665 unequal initializer has already been written to the buffer, this is an
666 error. */
667
668static size_t
669expr_to_char (gfc_expr *e, locus *loc,
670 unsigned char *data, unsigned char *chk, size_t len)
671{
672 int i;
673 int ptr;
674 gfc_constructor *c;
675 gfc_component *cmp;
676 unsigned char *buffer;
677
678 if (e
2.1
'e' is not equal to NULL
 == NULL__null)
3
←
Taking false branch
→
679 return 0;
680
681 /* Take a derived type, one component at a time, using the offsets from the backend
682 declaration. */
683 if (e->ts.type == BT_DERIVED)
4
←
Assuming field 'type' is not equal to BT_DERIVED
→
5
←
Taking false branch
→
684 {
685 for (c = gfc_constructor_first (e->value.constructor),
686 cmp = e->ts.u.derived->components;
687 c; c = gfc_constructor_next (c), cmp = cmp->next)
688 {
689 gcc_assert (cmp && cmp->backend_decl)((void)(!(cmp && cmp->backend_decl) ? fancy_abort (
"/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 689, __FUNCTION__), 0 : 0));
690 if (!c->expr)
691 continue;
692 ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp
->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 692, __FUNCTION__, (FIELD_DECL)))->field_decl.offset)), (
0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 692, __FUNCTION__)))
693 + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp
->backend_decl), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 693, __FUNCTION__, (FIELD_DECL)))->field_decl.bit_offset
)), (0), "/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 693, __FUNCTION__)))/8;
694 expr_to_char (c->expr, loc, &data[ptr], &chk[ptr], len);
695 }
696 return len;
697 }
698
699 /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate
700 to the target, in a buffer and check off the initialized part of the buffer. */
701 gfc_target_expr_size (e, &len);
702 buffer = (unsigned char*)alloca (len)__builtin_alloca(len);
703 len = gfc_target_encode_expr (e, buffer, len);
6
←
Calling 'gfc_target_encode_expr'
→
24
←
Returning from 'gfc_target_encode_expr'
→
704
705 for (i = 0; i < (int)len; i++)
25
←
The value 0 is assigned to 'i'
→
26
←
Assuming 'i' is < 'len'
→
706 {
707 if (chk[i] && (buffer[i] != data[i]))
27
←
Assuming the condition is true
→
28
←
The left operand of '!=' is a garbage value due to array index out of bounds
708 {
709 if (loc)
710 gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
711 "at %L", loc);
712 else
713 gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
714 "at %C");
715 return 0;
716 }
717 chk[i] = 0xFF;
718 }
719
720 memcpy (data, buffer, len);
721 return len;
722}
723
724
725/* Writes the values from the equivalence initializers to a char* array
726 that will be written to the constructor to make the initializer for
727 the union declaration. */
728
729size_t
730gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, locus *loc,
731 unsigned char *data,
732 unsigned char *chk, size_t length)
733{
734 size_t len = 0;
735 gfc_constructor * c;
736
737 switch (e->expr_type)
1
Control jumps to 'case EXPR_CONSTANT:' at line 739
→
738 {
739 case EXPR_CONSTANT:
740 case EXPR_STRUCTURE:
741 len = expr_to_char (e, loc, &data[0], &chk[0], length);
2
←
Calling 'expr_to_char'
→
742 break;
743
744 case EXPR_ARRAY:
745 for (c = gfc_constructor_first (e->value.constructor);
746 c; c = gfc_constructor_next (c))
747 {
748 size_t elt_size;
749
750 gfc_target_expr_size (c->expr, &elt_size);
751
752 if (mpz_cmp_si (c->offset, 0)(__builtin_constant_p ((0) >= 0) && (0) >= 0 ? (
__builtin_constant_p ((static_cast<unsigned long> (0)))
&& ((static_cast<unsigned long> (0))) == 0 ? (
(c->offset)->_mp_size < 0 ? -1 : (c->offset)->
_mp_size > 0) : __gmpz_cmp_ui (c->offset,(static_cast<
unsigned long> (0)))) : __gmpz_cmp_si (c->offset,0)) != 0)
753 len = elt_size * (size_t)mpz_get_si__gmpz_get_si (c->offset);
754
755 len = len + gfc_merge_initializers (ts, c->expr, loc, &data[len],
756 &chk[len], length - len);
757 }
758 break;
759
760 default:
761 return 0;
762 }
763
764 return len;
765}
766
767
768/* Transfer the bitpattern of a (integer) BOZ to real or complex variables.
769 When successful, no BOZ or nothing to do, true is returned. */
770
771bool
772gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
773{
774 size_t buffer_size, boz_bit_size, ts_bit_size;
775 int index;
776 unsigned char *buffer;
777
778 if (expr->ts.type != BT_INTEGER)
779 return true;
780
781 /* Don't convert BOZ to logical, character, derived etc. */
782 gcc_assert (ts->type == BT_REAL)((void)(!(ts->type == BT_REAL) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 782, __FUNCTION__), 0 : 0));
783
784 buffer_size = size_float (ts->kind);
785 ts_bit_size = buffer_size * 8;
786
787 /* Convert BOZ to the smallest possible integer kind. */
788 boz_bit_size = mpz_sizeinbase__gmpz_sizeinbase (expr->value.integer, 2);
789
790 gcc_assert (boz_bit_size <= ts_bit_size)((void)(!(boz_bit_size <= ts_bit_size) ? fancy_abort ("/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.cc"
, 790, __FUNCTION__), 0 : 0));
791
792 for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
793 if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
794 break;
795
796 expr->ts.kind = gfc_integer_kinds[index].kind;
797 buffer_size = MAX (buffer_size, size_integer (expr->ts.kind))((buffer_size) > (size_integer (expr->ts.kind)) ? (buffer_size
) : (size_integer (expr->ts.kind)));
798
799 buffer = (unsigned char*)alloca (buffer_size)__builtin_alloca(buffer_size);
800 encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
801 mpz_clear__gmpz_clear (expr->value.integer);
802
803 mpfr_init (expr->value.real);
804 gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
805
806 expr->ts.type = ts->type;
807 expr->ts.kind = ts->kind;
808
809 return true;
810}