File: | build/gcc/fortran/target-memory.c |
Warning: | line 701, column 32 The left operand of '!=' is a garbage value due to array index out of bounds |
Press '?' to see keyboard shortcuts
Keyboard shortcuts:
1 | /* Simulate storage of variables into target memory. | |||
2 | Copyright (C) 2007-2021 Free Software Foundation, Inc. | |||
3 | Contributed by Paul Thomas and Brooks Moses | |||
4 | ||||
5 | This file is part of GCC. | |||
6 | ||||
7 | GCC is free software; you can redistribute it and/or modify it under | |||
8 | the terms of the GNU General Public License as published by the Free | |||
9 | Software Foundation; either version 3, or (at your option) any later | |||
10 | version. | |||
11 | ||||
12 | GCC is distributed in the hope that it will be useful, but WITHOUT ANY | |||
13 | WARRANTY; without even the implied warranty of MERCHANTABILITY or | |||
14 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |||
15 | for more details. | |||
16 | ||||
17 | You should have received a copy of the GNU General Public License | |||
18 | along 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 | ||||
39 | static size_t | |||
40 | size_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), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 42, __FUNCTION__))->type_common.mode))); | |||
43 | } | |||
44 | ||||
45 | ||||
46 | static size_t | |||
47 | size_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), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 49, __FUNCTION__))->type_common.mode))); | |||
50 | } | |||
51 | ||||
52 | ||||
53 | static size_t | |||
54 | size_complex (int kind) | |||
55 | { | |||
56 | return 2 * size_float (kind); | |||
57 | } | |||
58 | ||||
59 | ||||
60 | static size_t | |||
61 | size_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), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 63, __FUNCTION__))->type_common.mode))); | |||
64 | } | |||
65 | ||||
66 | ||||
67 | static size_t | |||
68 | size_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 | ||||
78 | bool | |||
79 | gfc_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 ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 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 | return true; | |||
142 | } | |||
143 | ||||
144 | ||||
145 | /* Return the size of an expression in its target representation. */ | |||
146 | ||||
147 | bool | |||
148 | gfc_target_expr_size (gfc_expr *e, size_t *size) | |||
149 | { | |||
150 | mpz_t tmp; | |||
151 | size_t asz, el_size; | |||
152 | ||||
153 | gcc_assert (e != NULL)((void)(!(e != __null) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 153, __FUNCTION__), 0 : 0)); | |||
154 | ||||
155 | *size = 0; | |||
156 | if (e->rank) | |||
157 | { | |||
158 | if (gfc_array_size (e, &tmp)) | |||
159 | asz = mpz_get_ui__gmpz_get_ui (tmp); | |||
160 | else | |||
161 | return false; | |||
162 | } | |||
163 | else | |||
164 | asz = 1; | |||
165 | ||||
166 | if (!gfc_element_size (e, &el_size)) | |||
167 | return false; | |||
168 | *size = asz * el_size; | |||
169 | return true; | |||
170 | } | |||
171 | ||||
172 | ||||
173 | /* The encode_* functions export a value into a buffer, and | |||
174 | return the number of bytes of the buffer that have been | |||
175 | used. */ | |||
176 | ||||
177 | static unsigned HOST_WIDE_INTlong | |||
178 | encode_array (gfc_expr *expr, unsigned char *buffer, size_t buffer_size) | |||
179 | { | |||
180 | mpz_t array_size; | |||
181 | int i; | |||
182 | int ptr = 0; | |||
183 | ||||
184 | gfc_constructor_base ctor = expr->value.constructor; | |||
185 | ||||
186 | gfc_array_size (expr, &array_size); | |||
187 | for (i = 0; i < (int)mpz_get_ui__gmpz_get_ui (array_size); i++) | |||
188 | { | |||
189 | ptr += gfc_target_encode_expr (gfc_constructor_lookup_expr (ctor, i), | |||
190 | &buffer[ptr], buffer_size - ptr); | |||
191 | } | |||
192 | ||||
193 | mpz_clear__gmpz_clear (array_size); | |||
194 | return ptr; | |||
195 | } | |||
196 | ||||
197 | ||||
198 | static int | |||
199 | encode_integer (int kind, mpz_t integer, unsigned char *buffer, | |||
200 | size_t buffer_size) | |||
201 | { | |||
202 | return native_encode_expr (gfc_conv_mpz_to_tree (integer, kind), | |||
203 | buffer, buffer_size); | |||
204 | } | |||
205 | ||||
206 | ||||
207 | static int | |||
208 | encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size) | |||
209 | { | |||
210 | return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind, 0), buffer, | |||
211 | buffer_size); | |||
212 | } | |||
213 | ||||
214 | ||||
215 | static int | |||
216 | encode_complex (int kind, mpc_t cmplx, | |||
217 | unsigned char *buffer, size_t buffer_size) | |||
218 | { | |||
219 | int size; | |||
220 | size = encode_float (kind, mpc_realref (cmplx)((cmplx)->re), &buffer[0], buffer_size); | |||
221 | size += encode_float (kind, mpc_imagref (cmplx)((cmplx)->im), | |||
222 | &buffer[size], buffer_size - size); | |||
223 | return size; | |||
224 | } | |||
225 | ||||
226 | ||||
227 | static int | |||
228 | encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size) | |||
229 | { | |||
230 | return native_encode_expr (build_int_cst (gfc_get_logical_type (kind), | |||
231 | logical), | |||
232 | buffer, buffer_size); | |||
233 | } | |||
234 | ||||
235 | ||||
236 | size_t | |||
237 | gfc_encode_character (int kind, size_t length, const gfc_char_t *string, | |||
238 | unsigned char *buffer, size_t buffer_size) | |||
239 | { | |||
240 | size_t elsize = size_character (1, kind); | |||
241 | tree type = gfc_get_char_type (kind); | |||
242 | ||||
243 | gcc_assert (buffer_size >= size_character (length, kind))((void)(!(buffer_size >= size_character (length, kind)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 243, __FUNCTION__), 0 : 0)); | |||
244 | ||||
245 | for (size_t i = 0; i < length; i++) | |||
246 | native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize], | |||
247 | elsize); | |||
248 | ||||
249 | return length; | |||
250 | } | |||
251 | ||||
252 | ||||
253 | static unsigned HOST_WIDE_INTlong | |||
254 | encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size) | |||
255 | { | |||
256 | gfc_constructor *c; | |||
257 | gfc_component *cmp; | |||
258 | int ptr; | |||
259 | tree type; | |||
260 | HOST_WIDE_INTlong size; | |||
261 | ||||
262 | type = gfc_typenode_for_spec (&source->ts); | |||
263 | ||||
264 | for (c = gfc_constructor_first (source->value.constructor), | |||
265 | cmp = source->ts.u.derived->components; | |||
266 | c; | |||
267 | c = gfc_constructor_next (c), cmp = cmp->next) | |||
268 | { | |||
269 | gcc_assert (cmp)((void)(!(cmp) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 269, __FUNCTION__), 0 : 0)); | |||
270 | if (!c->expr) | |||
271 | continue; | |||
272 | ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp ->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 272, __FUNCTION__, (FIELD_DECL)))->field_decl.offset)), ( 0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 272, __FUNCTION__))) | |||
273 | + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp ->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 273, __FUNCTION__, (FIELD_DECL)))->field_decl.bit_offset )), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 273, __FUNCTION__)))/8; | |||
274 | ||||
275 | if (c->expr->expr_type == EXPR_NULL) | |||
276 | { | |||
277 | size = int_size_in_bytes (TREE_TYPE (cmp->backend_decl)((contains_struct_check ((cmp->backend_decl), (TS_TYPED), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 277, __FUNCTION__))->typed.type)); | |||
278 | gcc_assert (size >= 0)((void)(!(size >= 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 278, __FUNCTION__), 0 : 0)); | |||
279 | memset (&buffer[ptr], 0, size); | |||
280 | } | |||
281 | else | |||
282 | gfc_target_encode_expr (c->expr, &buffer[ptr], | |||
283 | buffer_size - ptr); | |||
284 | } | |||
285 | ||||
286 | size = int_size_in_bytes (type); | |||
287 | gcc_assert (size >= 0)((void)(!(size >= 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 287, __FUNCTION__), 0 : 0)); | |||
288 | return size; | |||
289 | } | |||
290 | ||||
291 | ||||
292 | /* Write a constant expression in binary form to a buffer. */ | |||
293 | unsigned HOST_WIDE_INTlong | |||
294 | gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, | |||
295 | size_t buffer_size) | |||
296 | { | |||
297 | if (source
| |||
298 | return 0; | |||
299 | ||||
300 | if (source->expr_type == EXPR_ARRAY) | |||
301 | return encode_array (source, buffer, buffer_size); | |||
302 | ||||
303 | 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 ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 305, __FUNCTION__), 0 : 0)) | |||
304 | || source->expr_type == EXPR_STRUCTURE((void)(!(source->expr_type == EXPR_CONSTANT || source-> expr_type == EXPR_STRUCTURE || source->expr_type == EXPR_SUBSTRING ) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 305, __FUNCTION__), 0 : 0)) | |||
305 | || source->expr_type == EXPR_SUBSTRING)((void)(!(source->expr_type == EXPR_CONSTANT || source-> expr_type == EXPR_STRUCTURE || source->expr_type == EXPR_SUBSTRING ) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 305, __FUNCTION__), 0 : 0)); | |||
306 | ||||
307 | /* If we already have a target-memory representation, we use that rather | |||
308 | than recreating one. */ | |||
309 | if (source->representation.string) | |||
310 | { | |||
311 | memcpy (buffer, source->representation.string, | |||
312 | source->representation.length); | |||
313 | return source->representation.length; | |||
314 | } | |||
315 | ||||
316 | switch (source->ts.type) | |||
317 | { | |||
318 | case BT_INTEGER: | |||
319 | return encode_integer (source->ts.kind, source->value.integer, buffer, | |||
320 | buffer_size); | |||
321 | case BT_REAL: | |||
322 | return encode_float (source->ts.kind, source->value.real, buffer, | |||
323 | buffer_size); | |||
324 | case BT_COMPLEX: | |||
325 | return encode_complex (source->ts.kind, source->value.complex, | |||
326 | buffer, buffer_size); | |||
327 | case BT_LOGICAL: | |||
328 | return encode_logical (source->ts.kind, source->value.logical, buffer, | |||
329 | buffer_size); | |||
330 | case BT_CHARACTER: | |||
331 | if (source->expr_type == EXPR_CONSTANT || source->ref == NULL__null) | |||
332 | return gfc_encode_character (source->ts.kind, | |||
333 | source->value.character.length, | |||
334 | source->value.character.string, | |||
335 | buffer, buffer_size); | |||
336 | else | |||
337 | { | |||
338 | HOST_WIDE_INTlong start, end; | |||
339 | ||||
340 | gcc_assert (source->expr_type == EXPR_SUBSTRING)((void)(!(source->expr_type == EXPR_SUBSTRING) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 340, __FUNCTION__), 0 : 0)); | |||
341 | gfc_extract_hwi (source->ref->u.ss.start, &start); | |||
342 | gfc_extract_hwi (source->ref->u.ss.end, &end); | |||
343 | return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0)((end - start + 1) > (0) ? (end - start + 1) : (0)), | |||
344 | &source->value.character.string[start-1], | |||
345 | buffer, buffer_size); | |||
346 | } | |||
347 | ||||
348 | case BT_DERIVED: | |||
349 | if (source->ts.u.derived->ts.f90_type == BT_VOID) | |||
350 | { | |||
351 | gfc_constructor *c; | |||
352 | gcc_assert (source->expr_type == EXPR_STRUCTURE)((void)(!(source->expr_type == EXPR_STRUCTURE) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 352, __FUNCTION__), 0 : 0)); | |||
353 | c = gfc_constructor_first (source->value.constructor); | |||
354 | gcc_assert (c->expr->expr_type == EXPR_CONSTANT((void)(!(c->expr->expr_type == EXPR_CONSTANT && c->expr->ts.type == BT_INTEGER) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 355, __FUNCTION__), 0 : 0)) | |||
355 | && c->expr->ts.type == BT_INTEGER)((void)(!(c->expr->expr_type == EXPR_CONSTANT && c->expr->ts.type == BT_INTEGER) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 355, __FUNCTION__), 0 : 0)); | |||
356 | return encode_integer (gfc_index_integer_kind, c->expr->value.integer, | |||
357 | buffer, buffer_size); | |||
358 | } | |||
359 | ||||
360 | return encode_derived (source, buffer, buffer_size); | |||
361 | default: | |||
362 | gfc_internal_error ("Invalid expression in gfc_target_encode_expr."); | |||
363 | return 0; | |||
364 | } | |||
365 | } | |||
366 | ||||
367 | ||||
368 | static size_t | |||
369 | interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result) | |||
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 ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 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 | true); | |||
395 | } | |||
396 | ||||
397 | result->value.constructor = base; | |||
398 | return ptr; | |||
399 | } | |||
400 | ||||
401 | ||||
402 | int | |||
403 | gfc_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 | ||||
414 | int | |||
415 | gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size, | |||
416 | mpfr_t real) | |||
417 | { | |||
418 | gfc_set_model_kind (kind); | |||
419 | mpfr_init (real); | |||
420 | gfc_conv_tree_to_mpfr (real, | |||
421 | native_interpret_expr (gfc_get_real_type (kind), | |||
422 | buffer, buffer_size)); | |||
423 | ||||
424 | return size_float (kind); | |||
425 | } | |||
426 | ||||
427 | ||||
428 | int | |||
429 | gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size, | |||
430 | mpc_t complex) | |||
431 | { | |||
432 | int size; | |||
433 | size = gfc_interpret_float (kind, &buffer[0], buffer_size, | |||
434 | mpc_realref (complex)((complex)->re)); | |||
435 | size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, | |||
436 | mpc_imagref (complex)((complex)->im)); | |||
437 | return size; | |||
438 | } | |||
439 | ||||
440 | ||||
441 | int | |||
442 | gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size, | |||
443 | int *logical) | |||
444 | { | |||
445 | tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer, | |||
446 | buffer_size); | |||
447 | *logical = wi::to_wide (t) == 0 ? 0 : 1; | |||
448 | return size_logical (kind); | |||
449 | } | |||
450 | ||||
451 | ||||
452 | size_t | |||
453 | gfc_interpret_character (unsigned char *buffer, size_t buffer_size, | |||
454 | gfc_expr *result) | |||
455 | { | |||
456 | if (result->ts.u.cl && result->ts.u.cl->length) | |||
457 | result->value.character.length = | |||
458 | gfc_mpz_get_hwi (result->ts.u.cl->length->value.integer); | |||
459 | ||||
460 | gcc_assert (buffer_size >= size_character (result->value.character.length,((void)(!(buffer_size >= size_character (result->value. character.length, result->ts.kind)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 461, __FUNCTION__), 0 : 0)) | |||
461 | result->ts.kind))((void)(!(buffer_size >= size_character (result->value. character.length, result->ts.kind)) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 461, __FUNCTION__), 0 : 0)); | |||
462 | result->value.character.string = | |||
463 | gfc_get_wide_string (result->value.character.length + 1)((gfc_char_t *) xcalloc ((result->value.character.length + 1), sizeof (gfc_char_t))); | |||
464 | ||||
465 | if (result->ts.kind == gfc_default_character_kind) | |||
466 | for (size_t i = 0; i < (size_t) result->value.character.length; i++) | |||
467 | result->value.character.string[i] = (gfc_char_t) buffer[i]; | |||
468 | else | |||
469 | { | |||
470 | mpz_t integer; | |||
471 | size_t bytes = size_character (1, result->ts.kind); | |||
472 | mpz_init__gmpz_init (integer); | |||
473 | gcc_assert (bytes <= sizeof (unsigned long))((void)(!(bytes <= sizeof (unsigned long)) ? fancy_abort ( "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 473, __FUNCTION__), 0 : 0)); | |||
474 | ||||
475 | for (size_t i = 0; i < (size_t) result->value.character.length; i++) | |||
476 | { | |||
477 | gfc_conv_tree_to_mpz (integer, | |||
478 | native_interpret_expr (gfc_get_char_type (result->ts.kind), | |||
479 | &buffer[bytes*i], buffer_size-bytes*i)); | |||
480 | result->value.character.string[i] | |||
481 | = (gfc_char_t) mpz_get_ui__gmpz_get_ui (integer); | |||
482 | } | |||
483 | ||||
484 | mpz_clear__gmpz_clear (integer); | |||
485 | } | |||
486 | ||||
487 | result->value.character.string[result->value.character.length] = '\0'; | |||
488 | ||||
489 | return result->value.character.length; | |||
490 | } | |||
491 | ||||
492 | ||||
493 | int | |||
494 | gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result) | |||
495 | { | |||
496 | gfc_component *cmp; | |||
497 | int ptr; | |||
498 | tree type; | |||
499 | ||||
500 | /* The attributes of the derived type need to be bolted to the floor. */ | |||
501 | result->expr_type = EXPR_STRUCTURE; | |||
502 | ||||
503 | cmp = result->ts.u.derived->components; | |||
504 | ||||
505 | if (result->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING | |||
506 | && (result->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR | |||
507 | || result->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR)) | |||
508 | { | |||
509 | gfc_constructor *c; | |||
510 | gfc_expr *e; | |||
511 | /* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec | |||
512 | sets this to BT_INTEGER. */ | |||
513 | result->ts.type = BT_DERIVED; | |||
514 | e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where); | |||
515 | c = gfc_constructor_append_expr (&result->value.constructor, e, NULL__null); | |||
516 | c->n.component = cmp; | |||
517 | gfc_target_interpret_expr (buffer, buffer_size, e, true); | |||
518 | e->ts.is_iso_c = 1; | |||
519 | return int_size_in_bytes (ptr_type_nodeglobal_trees[TI_PTR_TYPE]); | |||
520 | } | |||
521 | ||||
522 | type = gfc_typenode_for_spec (&result->ts); | |||
523 | ||||
524 | /* Run through the derived type components. */ | |||
525 | for (;cmp; cmp = cmp->next) | |||
526 | { | |||
527 | gfc_constructor *c; | |||
528 | gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, | |||
529 | &result->where); | |||
530 | e->ts = cmp->ts; | |||
531 | ||||
532 | /* Copy shape, if needed. */ | |||
533 | if (cmp->as && cmp->as->rank) | |||
534 | { | |||
535 | int n; | |||
536 | ||||
537 | e->expr_type = EXPR_ARRAY; | |||
538 | e->rank = cmp->as->rank; | |||
539 | ||||
540 | e->shape = gfc_get_shape (e->rank)(((mpz_t *) xcalloc (((e->rank)), sizeof (mpz_t)))); | |||
541 | for (n = 0; n < e->rank; n++) | |||
542 | { | |||
543 | mpz_init_set_ui__gmpz_init_set_ui (e->shape[n], 1); | |||
544 | mpz_add__gmpz_add (e->shape[n], e->shape[n], | |||
545 | cmp->as->upper[n]->value.integer); | |||
546 | mpz_sub__gmpz_sub (e->shape[n], e->shape[n], | |||
547 | cmp->as->lower[n]->value.integer); | |||
548 | } | |||
549 | } | |||
550 | ||||
551 | c = gfc_constructor_append_expr (&result->value.constructor, e, NULL__null); | |||
552 | ||||
553 | /* The constructor points to the component. */ | |||
554 | c->n.component = cmp; | |||
555 | ||||
556 | /* Calculate the offset, which consists of the FIELD_OFFSET in | |||
557 | bytes, which appears in multiples of DECL_OFFSET_ALIGN-bit-sized, | |||
558 | and additional bits of FIELD_BIT_OFFSET. The code assumes that all | |||
559 | sizes of the components are multiples of BITS_PER_UNIT, | |||
560 | i.e. there are, e.g., no bit fields. */ | |||
561 | ||||
562 | gcc_assert (cmp->backend_decl)((void)(!(cmp->backend_decl) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 562, __FUNCTION__), 0 : 0)); | |||
563 | ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp ->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 563, __FUNCTION__, (FIELD_DECL)))->field_decl.bit_offset )), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 563, __FUNCTION__))); | |||
564 | gcc_assert (ptr % 8 == 0)((void)(!(ptr % 8 == 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 564, __FUNCTION__), 0 : 0)); | |||
565 | 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), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 565, __FUNCTION__, (FIELD_DECL)))->field_decl.offset)), ( 0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 565, __FUNCTION__))); | |||
566 | ||||
567 | gcc_assert (e->ts.type != BT_VOID || cmp->attr.caf_token)((void)(!(e->ts.type != BT_VOID || cmp->attr.caf_token) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 567, __FUNCTION__), 0 : 0)); | |||
568 | gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e, true); | |||
569 | } | |||
570 | ||||
571 | return int_size_in_bytes (type); | |||
572 | } | |||
573 | ||||
574 | ||||
575 | /* Read a binary buffer to a constant expression. */ | |||
576 | size_t | |||
577 | gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, | |||
578 | gfc_expr *result, bool convert_widechar) | |||
579 | { | |||
580 | if (result->expr_type == EXPR_ARRAY) | |||
581 | return interpret_array (buffer, buffer_size, result); | |||
582 | ||||
583 | switch (result->ts.type) | |||
584 | { | |||
585 | case BT_INTEGER: | |||
586 | result->representation.length = | |||
587 | gfc_interpret_integer (result->ts.kind, buffer, buffer_size, | |||
588 | result->value.integer); | |||
589 | break; | |||
590 | ||||
591 | case BT_REAL: | |||
592 | result->representation.length = | |||
593 | gfc_interpret_float (result->ts.kind, buffer, buffer_size, | |||
594 | result->value.real); | |||
595 | break; | |||
596 | ||||
597 | case BT_COMPLEX: | |||
598 | result->representation.length = | |||
599 | gfc_interpret_complex (result->ts.kind, buffer, buffer_size, | |||
600 | result->value.complex); | |||
601 | break; | |||
602 | ||||
603 | case BT_LOGICAL: | |||
604 | result->representation.length = | |||
605 | gfc_interpret_logical (result->ts.kind, buffer, buffer_size, | |||
606 | &result->value.logical); | |||
607 | break; | |||
608 | ||||
609 | case BT_CHARACTER: | |||
610 | result->representation.length = | |||
611 | gfc_interpret_character (buffer, buffer_size, result); | |||
612 | break; | |||
613 | ||||
614 | case BT_CLASS: | |||
615 | result->ts = CLASS_DATA (result)result->ts.u.derived->components->ts; | |||
616 | /* Fall through. */ | |||
617 | case BT_DERIVED: | |||
618 | result->representation.length = | |||
619 | gfc_interpret_derived (buffer, buffer_size, result); | |||
620 | gcc_assert (result->representation.length >= 0)((void)(!(result->representation.length >= 0) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 620, __FUNCTION__), 0 : 0)); | |||
621 | break; | |||
622 | ||||
623 | case BT_VOID: | |||
624 | /* This deals with caf_tokens. */ | |||
625 | result->representation.length = | |||
626 | gfc_interpret_integer (result->ts.kind, buffer, buffer_size, | |||
627 | result->value.integer); | |||
628 | break; | |||
629 | ||||
630 | default: | |||
631 | gfc_internal_error ("Invalid expression in gfc_target_interpret_expr."); | |||
632 | break; | |||
633 | } | |||
634 | ||||
635 | if (result->ts.type == BT_CHARACTER && convert_widechar) | |||
636 | result->representation.string | |||
637 | = gfc_widechar_to_char (result->value.character.string, | |||
638 | result->value.character.length); | |||
639 | else | |||
640 | { | |||
641 | result->representation.string = | |||
642 | XCNEWVEC (char, result->representation.length + 1)((char *) xcalloc ((result->representation.length + 1), sizeof (char))); | |||
643 | memcpy (result->representation.string, buffer, | |||
644 | result->representation.length); | |||
645 | result->representation.string[result->representation.length] = '\0'; | |||
646 | } | |||
647 | ||||
648 | return result->representation.length; | |||
649 | } | |||
650 | ||||
651 | ||||
652 | /* --------------------------------------------------------------- */ | |||
653 | /* Two functions used by trans-common.c to write overlapping | |||
654 | equivalence initializers to a buffer. This is added to the union | |||
655 | and the original initializers freed. */ | |||
656 | ||||
657 | ||||
658 | /* Writes the values of a constant expression to a char buffer. If another | |||
659 | unequal initializer has already been written to the buffer, this is an | |||
660 | error. */ | |||
661 | ||||
662 | static size_t | |||
663 | expr_to_char (gfc_expr *e, locus *loc, | |||
664 | unsigned char *data, unsigned char *chk, size_t len) | |||
665 | { | |||
666 | int i; | |||
667 | int ptr; | |||
668 | gfc_constructor *c; | |||
669 | gfc_component *cmp; | |||
670 | unsigned char *buffer; | |||
671 | ||||
672 | if (e
| |||
673 | return 0; | |||
674 | ||||
675 | /* Take a derived type, one component at a time, using the offsets from the backend | |||
676 | declaration. */ | |||
677 | if (e->ts.type == BT_DERIVED) | |||
678 | { | |||
679 | for (c = gfc_constructor_first (e->value.constructor), | |||
680 | cmp = e->ts.u.derived->components; | |||
681 | c; c = gfc_constructor_next (c), cmp = cmp->next) | |||
682 | { | |||
683 | gcc_assert (cmp && cmp->backend_decl)((void)(!(cmp && cmp->backend_decl) ? fancy_abort ( "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 683, __FUNCTION__), 0 : 0)); | |||
684 | if (!c->expr) | |||
685 | continue; | |||
686 | ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp ->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 686, __FUNCTION__, (FIELD_DECL)))->field_decl.offset)), ( 0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 686, __FUNCTION__))) | |||
687 | + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))((unsigned long) (*tree_int_cst_elt_check ((((tree_check ((cmp ->backend_decl), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 687, __FUNCTION__, (FIELD_DECL)))->field_decl.bit_offset )), (0), "/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 687, __FUNCTION__)))/8; | |||
688 | expr_to_char (c->expr, loc, &data[ptr], &chk[ptr], len); | |||
689 | } | |||
690 | return len; | |||
691 | } | |||
692 | ||||
693 | /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate | |||
694 | to the target, in a buffer and check off the initialized part of the buffer. */ | |||
695 | gfc_target_expr_size (e, &len); | |||
696 | buffer = (unsigned char*)alloca (len)__builtin_alloca(len); | |||
697 | len = gfc_target_encode_expr (e, buffer, len); | |||
698 | ||||
699 | for (i = 0; i < (int)len; i++) | |||
700 | { | |||
701 | if (chk[i] && (buffer[i] != data[i])) | |||
| ||||
702 | { | |||
703 | if (loc) | |||
704 | gfc_error ("Overlapping unequal initializers in EQUIVALENCE " | |||
705 | "at %L", loc); | |||
706 | else | |||
707 | gfc_error ("Overlapping unequal initializers in EQUIVALENCE " | |||
708 | "at %C"); | |||
709 | return 0; | |||
710 | } | |||
711 | chk[i] = 0xFF; | |||
712 | } | |||
713 | ||||
714 | memcpy (data, buffer, len); | |||
715 | return len; | |||
716 | } | |||
717 | ||||
718 | ||||
719 | /* Writes the values from the equivalence initializers to a char* array | |||
720 | that will be written to the constructor to make the initializer for | |||
721 | the union declaration. */ | |||
722 | ||||
723 | size_t | |||
724 | gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, locus *loc, | |||
725 | unsigned char *data, | |||
726 | unsigned char *chk, size_t length) | |||
727 | { | |||
728 | size_t len = 0; | |||
729 | gfc_constructor * c; | |||
730 | ||||
731 | switch (e->expr_type) | |||
| ||||
732 | { | |||
733 | case EXPR_CONSTANT: | |||
734 | case EXPR_STRUCTURE: | |||
735 | len = expr_to_char (e, loc, &data[0], &chk[0], length); | |||
736 | break; | |||
737 | ||||
738 | case EXPR_ARRAY: | |||
739 | for (c = gfc_constructor_first (e->value.constructor); | |||
740 | c; c = gfc_constructor_next (c)) | |||
741 | { | |||
742 | size_t elt_size; | |||
743 | ||||
744 | gfc_target_expr_size (c->expr, &elt_size); | |||
745 | ||||
746 | 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) | |||
747 | len = elt_size * (size_t)mpz_get_si__gmpz_get_si (c->offset); | |||
748 | ||||
749 | len = len + gfc_merge_initializers (ts, c->expr, loc, &data[len], | |||
750 | &chk[len], length - len); | |||
751 | } | |||
752 | break; | |||
753 | ||||
754 | default: | |||
755 | return 0; | |||
756 | } | |||
757 | ||||
758 | return len; | |||
759 | } | |||
760 | ||||
761 | ||||
762 | /* Transfer the bitpattern of a (integer) BOZ to real or complex variables. | |||
763 | When successful, no BOZ or nothing to do, true is returned. */ | |||
764 | ||||
765 | bool | |||
766 | gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts) | |||
767 | { | |||
768 | size_t buffer_size, boz_bit_size, ts_bit_size; | |||
769 | int index; | |||
770 | unsigned char *buffer; | |||
771 | ||||
772 | if (expr->ts.type != BT_INTEGER) | |||
773 | return true; | |||
774 | ||||
775 | /* Don't convert BOZ to logical, character, derived etc. */ | |||
776 | gcc_assert (ts->type == BT_REAL)((void)(!(ts->type == BT_REAL) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 776, __FUNCTION__), 0 : 0)); | |||
777 | ||||
778 | buffer_size = size_float (ts->kind); | |||
779 | ts_bit_size = buffer_size * 8; | |||
780 | ||||
781 | /* Convert BOZ to the smallest possible integer kind. */ | |||
782 | boz_bit_size = mpz_sizeinbase__gmpz_sizeinbase (expr->value.integer, 2); | |||
783 | ||||
784 | gcc_assert (boz_bit_size <= ts_bit_size)((void)(!(boz_bit_size <= ts_bit_size) ? fancy_abort ("/home/marxin/BIG/buildbot/buildworker/marxinbox-gcc-clang-static-analyzer/build/gcc/fortran/target-memory.c" , 784, __FUNCTION__), 0 : 0)); | |||
785 | ||||
786 | for (index = 0; gfc_integer_kinds[index].kind != 0; ++index) | |||
787 | if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size) | |||
788 | break; | |||
789 | ||||
790 | expr->ts.kind = gfc_integer_kinds[index].kind; | |||
791 | buffer_size = MAX (buffer_size, size_integer (expr->ts.kind))((buffer_size) > (size_integer (expr->ts.kind)) ? (buffer_size ) : (size_integer (expr->ts.kind))); | |||
792 | ||||
793 | buffer = (unsigned char*)alloca (buffer_size)__builtin_alloca(buffer_size); | |||
794 | encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size); | |||
795 | mpz_clear__gmpz_clear (expr->value.integer); | |||
796 | ||||
797 | mpfr_init (expr->value.real); | |||
798 | gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real); | |||
799 | ||||
800 | expr->ts.type = ts->type; | |||
801 | expr->ts.kind = ts->kind; | |||
802 | ||||
803 | return true; | |||
804 | } |